C ***** This is the routine in the WaveForm Program ***** C ***** that writes the Binary output file for the ***** C ***** PROM programmer. This routine prompts for ***** C ***** a file name for this output file and then ***** C ***** writes it. A "null" file name results in ***** C ***** not writing a binary output file. ***** C ***** ***** C ***** MTG WaveForm Program Rev. 19-OCT-1991 ***** SUBROUTINE Binary_File_Output C ***************************************** C Define all Variables and Arrays C ***************************************** IMPLICIT NONE INCLUDE 'WaveForm_Common.INC' CHARACTER*96 Binary_Output_Filename INTEGER*4 Cell_Total,Pointer BYTE PROM_Data(0:3000) DATA PROM_Data/3001*0/ C ******************************************************* C Get the name of the Binary Output file. C ******************************************************* 40 WRITE ( 6, 50 ) 50 FORMAT ( /// & ' Should a binary file be written for use by the PROM ', / & ' programmed? To creat such a file enter a file name ', / & ' for this binary output file or else enter just a ', / & ' carridge return to skip writing a binary 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 binary 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 Binary Output file name 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 ***************************************************** WRITE ( 6, 80 ) 80 FORMAT ( /, & ' The Binary Output file for the ', /, & ' PROM programmer has been opened. ', / ) C ******************************************************* C Now loop writing the 2048 bytes of the PROM C data. Each byte of PROM data is made up from C 8 entries in the Pulse_Array. At the end of C the 2048 bytes of PROM data write two additional C bytes of zeros (PROM register 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 Cell_Total C into the one byte of PROM_Data. C ******************************************************* DO Pointer=0,2047,1 Cell_Total = ( Pulse_Array(1,Pointer) * 1 ) + $ ( Pulse_Array(2,Pointer) * 2 ) + $ ( Pulse_Array(3,Pointer) * 4 ) + $ ( Pulse_Array(4,Pointer) * 8 ) + $ ( Pulse_Array(5,Pointer) * 16 ) + $ ( Pulse_Array(6,Pointer) * 32 ) + $ ( Pulse_Array(7,Pointer) * 64 ) + $ ( Pulse_Array(8,Pointer) * 128 ) IF ( Cell_Total .GT. 255 ) GOTO 920 IF ( Cell_Total .LT. 0 ) GOTO 920 IF ( Cell_Total .LE. 127 ) THEN PROM_Data(Pointer) = Cell_Total ELSE IF ( Cell_Total .GT. 127 ) THEN PROM_Data(Pointer) = Cell_Total - 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,2049) IF ( IOSTATUS .NE. 0 ) GOTO 970 CLOSE (Unit=20) WRITE ( 6, 250 ) 250 FORMAT ( /, & ' The 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. ', / ) 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