PROGRAM FM102 C COMMENT SECTION. 00010102 C 00020102 C FM102 00030102 C 00040102 C THIS ROUTINE IS A TEST OF THE A FORMAT AND IS TAPE AND PRINTER00050102 C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060102 C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070102 C OUTPUT LISTS ARE ALPHANUMERIC INTEGERS AND ARRAY ELEMENTS OR 00080102 C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090102 C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100102 C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110102 C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120102 C INTEGER ARRAY FOR THE DUMP SECTION. 00130102 C 00140102 C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150102 C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160102 C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO 00170102 C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND 00180102 C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE 00190102 C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS. 00200102 C 00210102 C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00220102 C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00230102 C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00240102 C OF THE CONTINUATION LINE. 00250102 C 00260102 C REFERENCES 00270102 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00280102 C X3.9-1978 00290102 C 00300102 C SECTION 8, SPECIFICATION STATEMENTS 00310102 C SECTION 9, DATA STATEMENT 00320102 C SECTION 11.10, DO STATEMENT 00330102 C SECTION 12, INPUT/OUTPUT STATEMENTS 00340102 C SECTION 12.8.2, INPUT/OUTPUT LIST 00350102 C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00360102 C SECTION 13, FORMAT STATEMENT 00370102 C SECTION 13.2.1, EDIT DESCRIPTORS 00380102 C 00390102 COMMON IACN11(60), IACN12(30) 00400102 C 00410102 DIMENSION ITEST(7) 00420102 DIMENSION IADN11(60), IADN12(30) 00430102 DIMENSION IDUMP(136) 00440102 CHARACTER*1 NINE,IADN11,IACN11,IDUMP 00450102 CHARACTER*2 IADN12,IACN12 00460102 DATA NINE/'9'/ 00470102 DATA IADN11 /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00480102 1'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 00490102 2'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 00500102 3' ', '=', '+', '-', '*', '/', '(', ')', ',', '.','*', '0', '*', 00510102 4'1', '.', '2', ',', '3', ')', '4', '(', '5', '/', '6' / 00520102 DATA IADN12 / 00530102 1'6/', '5(', '4)','3,', '2.', '1*', '0*', '.,', ')(', '/*', '-+', 00540102 2'= ', 'ZY', 'XW', 'VU', 'TS', 'RQ', 'PO', 'NM', 'LK', 'JI', 'HG' 00550102 3,'FE', 'DC', 'BA', '98', '76', '54', '32', '10' / 00560102 77701 FORMAT ( 80A1 ) 00570102 77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00580102 1F ",I3," RECORDS") 00590102 77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00600102 77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00610102 1DS") 00620102 77705 FORMAT ( 1X,80A1) 00630102 77706 FORMAT (10X,"FILE I08 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00640102 77751 FORMAT (I3, 2I2, 3I3, I4, 60A1 ) 00650102 77752 FORMAT ( I3, 2I2, 3I3, I4, 30A2 ) 00660102 C 00670102 C 00680102 C ********************************************************** 00690102 C 00700102 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00710102 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00720102 C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00730102 C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00740102 C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00750102 C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00760102 C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00770102 C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00780102 C OF EXECUTING THESE TESTS. 00790102 C 00800102 C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00810102 C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00820102 C 00830102 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00840102 C 00850102 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00860102 C SOFTWARE STANDARDS VALIDATION GROUP 00870102 C BUILDING 225 RM A266 00880102 C GAITHERSBURG, MD 20899 00890102 C ********************************************************** 00900102 C 00910102 C 00920102 C 00930102 C INITIALIZATION SECTION 00940102 C 00950102 C INITIALIZE CONSTANTS 00960102 C ************** 00970102 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00980102 I01 = 5 00990102 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01000102 I02 = 6 01010102 C SYSTEM ENVIRONMENT SECTION 01020102 C 01030102 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01040102 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01050102 C (UNIT NUMBER FOR CARD READER). 01060102 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01070102 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01080102 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01090102 C 01100102 CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01110102 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01120102 C (UNIT NUMBER FOR PRINTER). 01130102 CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01140102 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01150102 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01160102 C 01170102 IVPASS=0 01180102 IVFAIL=0 01190102 IVDELE=0 01200102 ICZERO=0 01210102 C 01220102 C WRITE PAGE HEADERS 01230102 WRITE (I02,90000) 01240102 WRITE (I02,90001) 01250102 WRITE (I02,90002) 01260102 WRITE (I02, 90002) 01270102 WRITE (I02,90003) 01280102 WRITE (I02,90002) 01290102 WRITE (I02,90004) 01300102 WRITE (I02,90002) 01310102 WRITE (I02,90011) 01320102 WRITE (I02,90002) 01330102 WRITE (I02,90002) 01340102 WRITE (I02,90005) 01350102 WRITE (I02,90006) 01360102 WRITE (I02,90002) 01370102 C 01380102 C DEFAULT ASSIGNMENT FOR FILE 03 IS I08 = 7 01390102 I08 = 7 01400102 CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 01410102 CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01420102 C 01430102 C WRITE SECTION.... 01440102 C 01450102 C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01460102 C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01470102 C INTEGERS AND ALPHANUMERICS ( I AND A FORMAT ). THIS ROUTINE HAS 01480102 C ONLY ONE FILE AND FOR PURPOSES OF IDENTIFICATION IS FILE 03. 01490102 C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01500102 C THE DATA INITIALIZATION STATEMENT. 01510102 IPROG = 102 01520102 IFILE = 03 01530102 ILUN = I08 01540102 ITOTR = 31 01550102 IRLGN = 80 01560102 IEOF = 0000 01570102 IFLIP = 1 01580102 DO 234 IRNUM = 1, 31 01590102 IF ( IRNUM .EQ. 31 ) IEOF = 9999 01600102 IF ( IFLIP - 1 ) 232, 232, 233 01610102 232 WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN01620102 111 01630102 IFLIP = 2 01640102 GO TO 234 01650102 233 WRITE ( I08, 77752 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101660102 12 01670102 IFLIP = 1 01680102 234 CONTINUE 01690102 WRITE (I02,77706) 01700102 C 01710102 C REWIND SECTION 01720102 C 01730102 REWIND I08 01740102 C 01750102 C READ SECTION.... 01760102 C 01770102 IVTNUM = 23 01780102 C 01790102 C **** TEST 23 THRU TEST 38 **** 01800102 C TEST 23 THRU 38 - THESE TESTS READ THE FILE SEQUENTIALLY FORWARD01810102 C AND CHECK THE ODD NUMBERED RECORDS FOR THE RECORD NUMBER AND THE 01820102 C VALUE OF SEVERAL OF THE DATA ITEMS WHICH SHOULD REMAIN CONSTANT 01830102 C FROM RECORD TO RECORD. 01840102 C 01850102 IRTST = 1 01860102 DO 383 I = 1, 16 01870102 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 23 - 38.01880102 IVON01 = 0 01890102 C READ AN ODD NUMBERED RECORD.... 01900102 READ ( I08, 77751 ) ITEST, IACN11 01910102 IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 01920102 C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 01930102 IF ( IACN11(1) .EQ. IADN11(1) ) IVON01 = IVON01 + 1 01940102 C THE ELEMENT (1) SHOULD EQUAL IADN11(1) = '0' .... 01950102 IF ( IACN11(11) .EQ. IADN11(11) ) IVON01 = IVON01 + 1 01960102 C THE ELEMENT (11) SHOULD EQUAL IADN11(11) = 'A' .... 01970102 IF ( IACN11(36) .EQ. IADN11(36) ) IVON01 = IVON01 + 1 01980102 C THE ELEMENT (36) SHOULD EQUAL IADN11(36) = 'Z' .... 01990102 IF ( IACN11(44) .EQ. IADN11(44) ) IVON01 = IVON01 + 1 02000102 C THE ELEMENT (44) SHOULD EQUAL IADN11(44) = ')' .... 02010102 IF ( IACN11(60) .EQ. IADN11(60) ) IVON01 = IVON01 + 1 02020102 C THE ELEMENT (60) SHOULD EQUAL IADN11(60) = '6' .... 02030102 IF ( IVON01 - 6 ) 20230, 10230, 20230 02040102 C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02050102 C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02060102 C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02070102 10230 IVPASS = IVPASS + 1 02080102 WRITE (I02,80001) IVTNUM 02090102 GO TO 382 02100102 20230 IVFAIL = IVFAIL + 1 02110102 IVCOMP = IVON01 02120102 IVCORR = 6 02130102 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02140102 382 CONTINUE 02150102 C DO NOT READ PAST RECORD NUMBER 31 ON THE I = 16 LOOP.... 02160102 IF ( I .EQ. 16 ) GO TO 391 02170102 C SKIP OVER THE EVEN NUMBERED RECORDS BY AN EXTRA READ.... 02180102 READ ( I08, 77752 ) ITEST, IACN12 02190102 IVTNUM = IVTNUM + 1 02200102 C INCREMENT THE TEST NUMBER.... 02210102 IRTST = IRTST + 2 02220102 C INCREMENT THE RECORD NUMBER COUNTER.... 02230102 383 CONTINUE 02240102 IF ( ICZERO ) 30230, 391, 30230 02250102 30230 IVDELE = IVDELE + 1 02260102 WRITE (I02,80003) IVTNUM 02270102 391 CONTINUE 02280102 IVTNUM = 39 02290102 C 02300102 C **** TEST 39 **** 02310102 C TEST 39 - THIS CHECKS FOR THE END OF FILE INDICATOR ON THE 31ST 02320102 C RECORD. THE EOF INDICATOR IS ITEST(7) AND SHOULD EQUAL 9999 02330102 C 02340102 IF (ICZERO) 30390, 390, 30390 02350102 390 CONTINUE 02360102 IVCOMP = ITEST(7) 02370102 GO TO 40390 02380102 30390 IVDELE = IVDELE + 1 02390102 WRITE (I02,80003) IVTNUM 02400102 IF (ICZERO) 40390, 401, 40390 02410102 40390 IF ( IVCOMP - 9999 ) 20390, 10390, 20390 02420102 10390 IVPASS = IVPASS + 1 02430102 WRITE (I02,80001) IVTNUM 02440102 GO TO 401 02450102 20390 IVFAIL = IVFAIL + 1 02460102 IVCORR = 9999 02470102 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02480102 401 CONTINUE 02490102 C REWIND THE FILE AGAIN.... 02500102 REWIND I08 02510102 C READ THE FILE AGAIN 02520102 IVTNUM = 40 02530102 C **** TEST 40 THRU 54 **** 02540102 C TEST 40 THRU 54 - THESE TESTS CHECK THE EVEN NUMBERED RECORDS 02550102 C FOR THE CORRECT RECORD NUMBER AND THE VALUE OF SEVERAL DATA ITEMS 02560102 C WHICH SHOULD REMAIN CONSTANT FOR EACH RECORD. THESE READ CHECKS 02570102 C USE A DIFFERENT FORMAT THAN TESTS 23 THRU 38 BECAUSE THE RECORDS 02580102 C WERE WRITTEN USING A FLIP-FLOP BETWEEN TWO FORMATS. 02590102 C 02600102 IRTST = 2 02610102 C THIS RECORD POINTER IS INITIALIZED TO THE SECOND (EVEN) RECORD 02620102 DO 532 I = 1, 15 02630102 C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 40 - 54 02640102 IVON01 = 0 02650102 C SKIP OVER THE ODD NUMBERED RECORDS.... 02660102 READ ( I08, 77751 ) ITEST, IACN11 02670102 C READ THE EVEN NUMBERED RECORDS.... 02680102 READ ( I08, 77752 ) ITEST, IACN12 02690102 IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02700102 C CHECK THE RECORD NUMBER.... 02710102 IF ( IACN12(1) .EQ. IADN12(1) ) IVON01 = IVON01 + 1 02720102 C ELEMENT (1) SHOULD EQUAL '6/' .... 02730102 IF ( IACN12(11) .EQ. IADN12(11) ) IVON01 = IVON01 + 1 02740102 C ELEMENT (11) SHOULD EQUAL '-+' .... 02750102 IF ( IACN12(16) .EQ. IADN12(16) ) IVON01 = IVON01 + 1 02760102 C ELEMENT (16) SHOULD EQUAL 'TS' .... 02770102 IF ( IACN12(23) .EQ. IADN12(23) ) IVON01 = IVON01 + 1 02780102 C ELEMENT (23) SHOULD EQUAL 'FE' .... (THE SYMBOL FOR IRONY) 02790102 IF ( IACN12(30) .EQ. IADN12(30) ) IVON01 = IVON01 + 1 02800102 C ELEMENT (30) SHOULD EQUAL '10' .... 02810102 IF ( IVON01 - 6 ) 20400, 10400, 20400 02820102 10400 IVPASS = IVPASS + 1 02830102 WRITE (I02,80001) IVTNUM 02840102 GO TO 402 02850102 20400 IVFAIL = IVFAIL + 1 02860102 IVCOMP = IVON01 02870102 IVCORR = 6 02880102 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02890102 402 CONTINUE 02900102 IVTNUM = IVTNUM + 1 02910102 C INCREMENT THE TEST NUMBER.... 02920102 IRTST = IRTST + 2 02930102 C INCREMENT THE RECORD NUMBER COUNTER.... 02940102 532 CONTINUE 02950102 IF ( ICZERO ) 30400, 411, 30400 02960102 30400 IVDELE = IVDELE + 1 02970102 WRITE (I02,80003) IVTNUM 02980102 411 CONTINUE 02990102 C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 03 03000102 C TO THE LINE PRINTER. 03010102 CDB** 03020102 C ILUN = I08 03030102 C ITOTR = 31 03040102 C IRLGN = 80 03050102 C7777 REWIND ILUN 03060102 C DO 7778 IRNUM = 1, ITOTR 03070102 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03080102 C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03090102 C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03100102 C7778 CONTINUE 03110102 C GO TO 7782 03120102 C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03130102 C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03140102 C GO TO 7784 03150102 C7781 WRITE (I02,77703) ILUN,ITOTR 03160102 C GO TO 7784 03170102 C7782 WRITE (I02,77704) ILUN, ITOTR 03180102 C DO 7783 I = 1, 5 03190102 C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03200102 C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03210102 C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03220102 C7783 CONTINUE 03230102 C7784 GO TO 99999 03240102 CDE** 03250102 C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03260102 99999 CONTINUE 03270102 WRITE (I02,90002) 03280102 WRITE (I02,90006) 03290102 WRITE (I02,90002) 03300102 WRITE (I02,90002) 03310102 WRITE (I02,90007) 03320102 WRITE (I02,90002) 03330102 WRITE (I02,90008) IVFAIL 03340102 WRITE (I02,90009) IVPASS 03350102 WRITE (I02,90010) IVDELE 03360102 C 03370102 C 03380102 C TERMINATE ROUTINE EXECUTION 03390102 STOP 03400102 C 03410102 C FORMAT STATEMENTS FOR PAGE HEADERS 03420102 90000 FORMAT ("1") 03430102 90002 FORMAT (" ") 03440102 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03450102 90003 FORMAT (" ",21X,"VERSION 2.1" ) 03460102 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03470102 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03480102 90006 FORMAT (" ",5X,"----------------------------------------------" ) 03490102 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03500102 C 03510102 C FORMAT STATEMENTS FOR RUN SUMMARIES 03520102 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03530102 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03540102 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03550102 C 03560102 C FORMAT STATEMENTS FOR TEST RESULTS 03570102 80001 FORMAT (" ",4X,I5,7X,"PASS") 03580102 80002 FORMAT (" ",4X,I5,7X,"FAIL") 03590102 80003 FORMAT (" ",4X,I5,7X,"DELETED") 03600102 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03610102 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03620102 C 03630102 90007 FORMAT (" ",20X,"END OF PROGRAM FM102" ) 03640102 END 03650102