C ***** This is the routine in the ComAdrs Program ***** C ***** that writes the Function Address binary ***** C ***** output file for the PROM programmer. ***** C ***** This routine prompts for the file name of ***** C ***** the Function Address output file and then ***** C ***** writes it. A "null" file name results ***** C ***** in not writing this binary output file. ***** C ***** ***** C ***** COMINT Address Specification Program ***** C ***** Rev. 28-OCT-1991 ***** SUBROUTINE FA_Binary_File_Output C ***************************************** C Define all Variables and Arrays C ***************************************** IMPLICIT NONE INCLUDE 'ComAdrs_Common.INC' CHARACTER*96 Binary_Output_Filename INTEGER*2 This_Cell INTEGER*4 Pointer BYTE PROM_Data(0:9000) DATA PROM_Data/9001*0/ C ******************************************************************** C Get the name of the Function Address Binary Output file. C ******************************************************************** 40 WRITE ( 6, 50 ) 50 FORMAT ( /// & ' Should a Function Address output file be written for ', / & ' use by the PROM programmer? Enter a file name ', / & ' for this binary output file or else enter just a ', / & ' carridge return to skip writing this output file. ', / & ' DEVC:[DIR]NAME.EXT;VER: ', $ ) READ ( 5, 55 ) Binary_Output_Filename 55 FORMAT ( A ) IF ( Binary_Output_Filename .EQ. ' ' ) THEN WRITE ( 6, 57 ) 57 FORMAT ( /, ' No Function Address output file will ', / & ' be written for the PROM programmer. ', / ) RETURN END IF IF ( Full_Display .EQ. 0 ) GOTO 70 WRITE ( 6, 60 ) Binary_Output_Filename 60 FORMAT ( //, & ' The Function Address output filename ', /, & ' for use by the PROM programmer is: ', /, & ' ', A, / ) 70 CONTINUE C ********************************************************** C Open the Binary Output file for the PROM programmer. C ********************************************************** OPEN ( UNIT=20, FILE=Binary_Output_Filename, STATUS='NEW', & FORM='UNFORMATTED', ACCESS='SEQUENTIAL', & RecordType='Variable', CarriageControl='None', & ERR=950, IOSTAT=IOSTATUS ) C ***************************************************** C Advertize that the Binary Output file for PROM C programmer has been opened without trouble. C ***************************************************** IF ( Full_Display .EQ. 0 ) GOTO 85 WRITE ( 6, 80 ) 80 FORMAT ( /, & ' The Binary Output file for the ', /, & ' PROM programmer has been opened. ', / ) 85 CONTINUE C ******************************************************* C Now loop writing the 8192 bytes of the PROM C data. At the end of the 8192 bytes of PROM data C write two additional bytes of zeros (PROM register C initialization). C Write all of this in 510 byte records i.e. C fill up each 512 byte block. Note the "trick" C to fit all 8 bits of positive data from the Adrs_ C Array into the one byte of PROM_Data. C ******************************************************* DO Pointer=0,8191,1 This_Cell = Function_Adrs_Array(Pointer) IF ( This_Cell .GT. 255 ) GOTO 920 IF ( This_Cell .LT. 0 ) GOTO 920 IF ( This_Cell .LE. 127 ) THEN PROM_Data(Pointer) = This_Cell ELSE IF ( This_Cell .GT. 127 ) THEN PROM_Data(Pointer) = This_Cell - 256 END IF END DO WRITE (Unit=20) (PROM_Data(Pointer), Pointer=0,509) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=510,1019) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=1020,1529) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=1530,2039) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=2040,2549) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=2550,3059) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=3060,3569) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=3570,4079) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=4080,4589) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=4590,5099) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=5100,5609) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=5610,6119) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=6120,6629) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=6630,7139) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=7140,7649) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=7650,8159) IF ( IOSTATUS .NE. 0 ) GOTO 970 WRITE (Unit=20) (PROM_Data(Pointer), Pointer=8160,8193) IF ( IOSTATUS .NE. 0 ) GOTO 970 CLOSE (Unit=20) WRITE ( 6, 250 ) 250 FORMAT ( /, & ' The Function Address binary output ', /, & ' file has been Written and Closed. ', / ) RETURN C ************************************************************ C This is the section for handling IO Errors and all Exits C ***********************************---------*********-----** 920 WRITE ( 6. 925 ) 925 FORMAT ( /, & ' During the write Binary Output file routine ', /, & ' a data record was found that is out of range ', /, & ' i.e. < 0 or > 255. This is a fatal error. ', / ) CLOSE ( UNIT=20 ) GOTO 998 950 WRITE ( 6, 951 ) IOSTATUS 951 FORMAT ( /, & ' There has been an IO System Error trying ', / & ' to Open the Binary Output File. ', // & ' Fortran Open IOSTAT = ', I3, // & ' You will need to restart the program. ', / ) GOTO 998 970 WRITE ( 6, 971 ) IOSTATUS 971 FORMAT ( /, & ' There has been an IO System Error trying ', / & ' to Write to the Binary Output file. ', // & ' Fortran Read IOSTAT = ', I3, // & ' You will need to restart the program. ' , // ) CLOSE ( UNIT=20 ) 998 WRITE ( 6, 999 ) 999 FORMAT ( / ' MTG WaveForm Program will now exit. ', // ) STOP ' ' END