C ***** This is the routine in the COMINT Address ***** C ***** Program that gets the filename for and then ***** C ***** opens the COMINT Address Specification File. ***** C ***** The Header of the COMINT Address Specification ***** C ***** File is then read and displayed on the terminal. ***** C ***** ***** C ***** ComAdrs Program Rev. 4-NOV-1991 ***** SUBROUTINE Get_Adrs_Spec_File C ***************************************** C Define all Variables and Arrays C ***************************************** IMPLICIT NONE INCLUDE 'ComAdrs_Common.INC' INTEGER*2 LineLength C ************************************************************** C Get the name of the COMINT Address Specification File. C ************************************************************** 40 WRITE ( 6, 50 ) 50 FORMAT ( /// & ' To QUIT this program enter just a Carriage Return. ', / & ' To Process a COMINT Address Specification File ', / & ' enter the filename of the Address Specification File. ', / & ' DEVC:[DIR]NAME.EXT;VER: ', $ ) READ ( 5, 55 ) COMINT_Adrs_Spec_Filename 55 FORMAT ( A ) IF ( COMINT_Adrs_Spec_Filename .EQ. ' ' ) THEN GOTO 998 END IF IF ( Full_Display .EQ. 0 ) GOTO 70 WRITE ( 6, 60 ) COMINT_Adrs_Spec_Filename 60 FORMAT ( // & ' The COMINT Address Specification ' / & ' filename is: ', A & / ) 70 CONTINUE C ************************************************** C Open the COMINT Address Specification File C and call the routine to read from it. C ************************************************** OPEN ( UNIT=10, FILE= COMINT_Adrs_Spec_Filename, STATUS='OLD', & FORM='FORMATTED', READONLY, ACCESS='SEQUENTIAL', & RecordType='Variable', CarriageControl='List', & ERR=950, IOSTAT=IOSTATUS ) C ********************************************************** C Advertize that the COMINT Address Specification File C has been opened and that the Header Section will C now be read and displayed. C ********************************************************** WRITE ( 6, 80 ) 80 FORMAT ( /, & ' The COMINT Address Specification File has been opened ', & /, ' and the Header will now be read and displayed.', / ) C ************************************************** C Now loop reading records and looking for the C beginning of the Data Section. Display the C records if we are in SHORT display format C mode (otherwise they will be displayed by the C Get_Record_and_Capit routine. C ************************************************** 100 CALL Get_Record_and_Capitalize IF ( IOSTATUS .EQ. -1 ) GOTO 940 IF ( IOSTATUS .NE. 0 ) GOTO 970 C ***** Now test to see if this record is ***** C ***** the Beginning of the Data Section. ***** IF ( ThisLine(1) .EQ. 'B' .AND. & ThisLine(2) .EQ. 'E' .AND. & ThisLine(3) .EQ. 'G' .AND. & ThisLine(4) .EQ. 'I' .AND. & ThisLine(5) .EQ. 'N' .AND. & ThisLine(6) .EQ. 'N' .AND. & ThisLine(7) .EQ. 'I' .AND. & ThisLine(8) .EQ. 'N' .AND. & ThisLine(9) .EQ. 'G' .AND. & ThisLine(10) .EQ. '_' .AND. & ThisLine(11) .EQ. 'O' .AND. & ThisLine(12) .EQ. 'F' .AND. & ThisLine(13) .EQ. '_' .AND. & ThisLine(14) .EQ. 'D' .AND. & ThisLine(15) .EQ. 'A' .AND. & ThisLine(16) .EQ. 'T' .AND. & ThisLine(17) .EQ. 'A' .AND. & ThisLine(18) .EQ. '_' .AND. & ThisLine(19) .EQ. 'S' .AND. & ThisLine(20) .EQ. 'E' .AND. & ThisLine(21) .EQ. 'C' .AND. & ThisLine(22) .EQ. 'T' .AND. & ThisLine(23) .EQ. 'I' .AND. & ThisLine(24) .EQ. 'O' .AND. & ThisLine(25) .EQ. 'N' ) RETURN C ***** This was not the beginning of the Data Section ***** C ***** so if in short format display the header record. ***** IF ( Full_Display .EQ. 1 ) GOTO 235 IF ( OrigNumChr .GT. 77 ) THEN LineLength = 78 ELSE LineLength = OrigNumChr END IF WRITE ( 6, 220 ) & ( OrigThisLine(OrigChrPt), OrigChrPt=1,LineLength ) 220 FORMAT ( ' ', 255A1 ) 235 CONTINUE C ***** Now continue the loop to get the next record. ***** GOTO 100 C ************************************************************ C This is the section for handling IO Errors and all Exits C ***********************************---------*********-----** 940 WRITE ( 6, 941 ) 941 FORMAT ( /, & ' The end of the COMINT Address Specification ', / & ' file was reached before finding a Data ', / & ' Section in the file. ', // & ' The program will prompt again for the ', / & ' COMINT Address Specification filename. ', / ) CLOSE ( UNIT=10 ) GOTO 40 950 WRITE ( 6, 951 ) IOSTATUS 951 FORMAT ( /, & ' There has been an IO System Error trying ', /, & ' to Open the COMINT Address Specification ', //, & ' File. Did you type the filename correctly? ', //, & ' Fortran Open IOSTAT = ', I3, //, & ' The program will prompt again for the ', /, & ' COMINT Address Specification filename. ', / ) GOTO 40 970 WRITE ( 6, 971 ) IOSTATUS 971 FORMAT ( /, & ' There has been an IO System Error trying ', /, & ' to Read from the COMINT Address Specification ', /, & ' file. Is this file of the correct format? ', //, & ' Did you type the filename correctly? ', //, & ' Fortran Read IOSTAT = ', I3, //, & ' You will need to restart the program. ' , // ) CLOSE ( UNIT=10 ) 998 WRITE ( 6, 999 ) 999 FORMAT ( / ' COMINT Address Program will now exit. ', // ) STOP ' ' END