C COMMENT SECTION. C C FM108 C C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER C ORIENTED. THE ROUTINE CAN NOT BE USED FOR DISK. BOTH THE READ C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL C INTEGER ARRAY FOR THE DUMP SECTION. C C WITH THE EXCEPTION OF THE RECORD PREAMBLES ON EACH RECORD, C ALL OF THE I, F, AND A-FIELDS HAVE A MINUS SIGN IN THE LEFTMOST C CHARACTER POSITION OF EACH FIELD. C C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS C REWOUND AND READ SEQUENTIALLY FORWARD AND THEN READ SEQUENTIALLY C BACKWARD BY USING THE BACKSPACE COMMAND. THE FORWARD READ IS C USED TO CHECK ALL OF THE ODD RECORDS AND THE READ REVERSE IN C EFFECT CHECKS THE EVEN NUMBERED RECORDS. THE ENDFILE COMMAND IS C ALSO USED AFTER THE WRITE SECTION BUT BECAUSE THE RESULT OF C ATTEMPTING TO READ OR READ BEYOND THE ENDFILE MARK IS NOT POSSIBLE C TO PREDICT FOR ALL MACHINES, THE ENDFILE MARK IS NEVER ACTUALLY C READ. C C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING C OF THE CONTINUATION LINE. C C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 8, SPECIFICATION STATEMENTS C SECTION 9, DATA STATEMENT C SECTION 11.10, DO STATEMENT C SECTION 12, INPUT/OUTPUT STATEMENTS C SECTION 12.8.2, INPUT/OUTPUT LIST C SECTION 12.9.5.2, FORMATTED DATA TRANSFER C SECTION 13, FORMAT STATEMENT C SECTION 13.2.1, EDIT DESCRIPTORS C DIMENSION IDUMP(136) DIMENSION IADN11(5), IADN12(3), IADN13(3) CHARACTER*1 NINE,IADN11,ICON04,IDUMP CHARACTER*2 IADN12,ICON06 CHARACTER*3 IADN13 DATA NINE/'9'/ DATA IADN11/'-', 'W', 'H', 'E', 'E'/, IADN12/'-H', 'EL', 'L'/, 1IADN13/'-', 'HE', 'LL'/ C 77701 FORMAT ( 80A1 ) 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O 1F ,I3,8H RECORDS) 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR 1DS) 77705 FORMAT ( 1X,80A1) 77706 FORMAT (10X,43HFILE I08 CREATED WITH 31 SEQUENTIAL RECORDS) 77751 FORMAT ( I3,2I2,3I3,I4,4X,I6,4X,F6.2,5X,5A1,4X,I6,4X,F6.4,5X,2A2,A 11 ) 77752 FORMAT ( I3,2I2,3I3,I4,I6,4X,F6.2,4X,5A1,5X,I6,4X,F6.4,4X,A1,2A2,5 1X ) 77753 FORMAT (7X,I3,6X,I4,4X,I6,15X,A1,8X,I6,4X,F6.4,9X,A1 ) 77754 FORMAT (7X,I3,6X,I4,I6,14X,A1,9X,I6,4X,F6.4,7X,A2,5X ) C C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) C C DEFAULT ASSIGNMENT FOR FILE 09 IS I08 = 7 I08 = 7 CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 C C WRITE SECTION.... C C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE C ROUTINE FM108 AND FOR PURPOSES OF IDENTIFICATION IS FILE 09. C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE C SET BY ASSIGNMENT STATEMENTS. C IPROG = 108 IFILE = 09 ILUN = I08 ITOTR = 31 IRLGN = 80 IEOF = 0000 ICON01 = -32766 RCON01 = -12.34 ICON02 = -12345 RCON02 = -.9999 IFLIP = 1 DO 1254 IRNUM = 1, 31 IF ( IRNUM .EQ. 31 ) IEOF = 9999 IF ( IFLIP - 1 ) 1252, 1252, 1253 1252 WRITE ( I08, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF 1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12 IFLIP = 2 GO TO 1254 1253 WRITE ( I08, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF 1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13 IFLIP = 1 1254 CONTINUE WRITE (I02,77706) C C ENDFILE SECTION .... ENDFILE I08 C C REWIND SECTION REWIND I08 C C C READ FORWARD SECTION .... C C IVTNUM = 125 C C **** TEST 125 THRU TEST 140 **** C TEST 125 THRU 140 - THESE TESTS CHECK THE ODD NUMBERED RECORDS. C THE FILE 09 IS READ SEQUENTIALLY FORWARD AND THE EVEN NUMBERED C RECORDS ARE SKIPPED BY READING PAST THEM. C DO 1255 IRNUM = 1, 31, 2 IVON01 = 0 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 125-140. READ ( I08,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 C READ AN ODD NUMBERED RECORD.... IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 C IRNO SHOULD BE THE RECORD NUMBER.... IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 C ICON03 SHOULD EQUAL -32766 .... IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 C ICON04 SHOULD EQUAL '-' .... IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 C ICON05 SHOULD EQUAL -12345 .... IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 C RCON03 SHOULD EQUAL -.9999 .... IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1 C ICON06 SHOULD EQUAL 'L' .... IF ( IVON01 - 6 ) 21250, 11250, 21250 11250 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1261 21250 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 6 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1261 CONTINUE IF ( IRNUM .EQ. 31 ) GO TO 1255 C THIS DOES NOT ALLOW READING THE ENDFILE MARK.... READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 C READ PAST THE EVEN NUMBERED RECORD .... IVTNUM = IVTNUM + 1 C INCREMENT THE TEST NUMBER.... 1255 CONTINUE IF ( ICZERO ) 31250, 1411, 31250 31250 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM 1411 CONTINUE IVTNUM = 141 C C **** TEST 141 THRU TEST 155 **** C TEST 141 THRU 155 - THESE TESTS USE THE BACKSPACE COMMAND C TO READ REVERSE AND CHECK THE EVEN NUMBERED RECORDS. AT THE C BEGINNING OF THIS SERIES, THE FILE 09 SHOULD BE SETTING AT THE C ENDFILE MARK PAST RECORD NUMBER 31. C BACKSPACE I08 BACKSPACE I08 IRNUM = 30 C THE FILE SHOULD NOW BE SETTING AT RECORD NUMBER 30.... DO 1552 I = 1, 15 IVON01 = 0 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 141-155. READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 C READ AN EVEN NUMBERED RECORD.... IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 C IRNO SHOULD BE THE RECORD NUMBER.... IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 C ICON03 SHOULD EQUAL -32766 .... IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 C ICON04 SHOULD EQUAL '-' .... IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 C ICON05 SHOULD EQUAL -12345 .... IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 C RCON03 SHOULD EQUAL -.9999 .... IF ( ICON06 .EQ. IADN13(3) ) IVON01 = IVON01 + 1 C ICON06 SHOULD EQUAL 'LL' .... IF ( IVON01 - 6 ) 21410, 11410, 21410 11410 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 1421 21410 IVFAIL = IVFAIL + 1 IVCOMP = IVON01 IVCORR = 6 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 1421 CONTINUE C THIS IS TO NOT ALLOW READING BACKWARDS PAST RECORD NUMBER 1.... IF ( I .EQ. 15 ) GO TO 1552 C BACKSPACE TO THE NEXT EVEN RECORD.... BACKSPACE I08 BACKSPACE I08 BACKSPACE I08 IVTNUM = IVTNUM + 1 C INCREMENT THE TEST NUMBER.... IRNUM = IRNUM - 2 C DECREMENT THE RECORD NUMBER POINTER BY 2 .... 1552 CONTINUE IF ( ICZERO ) 31410, 1561, 31410 31410 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM 1561 CONTINUE C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 09 C TO THE LINE PRINTER. CDB** C ILUN = I08 C ITOTR = 31 C IRLGN = 80 C7777 REWIND ILUN C DO 7778 IRNUM = 1, ITOTR C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 C7778 CONTINUE C GO TO 7782 C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR C GO TO 7784 C7781 WRITE (I02,77703) ILUN,ITOTR C GO TO 7784 C7782 WRITE (I02,77704) ILUN, ITOTR C DO 7783 I = 1, 5 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 C7783 CONTINUE C7784 GO TO 99999 CDE** C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM108) END