PROGRAM FM411 C C C C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. UNFORMATTED RECORDS C MAY BE READ OR WRITTEN ONLY BY UNFORMATTED INPUT/OUTPUT STATE- C MENTS. THIS ROUTINE TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE C UNFORMATTED READ AND WRITE STATEMENTS AS WELL AS THE FILE C POSITIONING STATEMENTS BACKSPACE, ENDFILE AND REWIND. IN C ADDITION UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND C NONCHARACTER DATA. THIS DATA IS TRANSFERRED WITHOUT EDITING C BETWEEN THE CURRENT RECORD AND ENTITIES SPECIFIED BY THE INPUT/ C OUTPUT LIST ITEMS. THIS ROUTINE BOTH READS AND WRITES C RECORDS CONTAINING DATA OF LOGICAL, REAL AND INTEGER TYPE WITH C I/O LIST ITEMS REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT C NAMES AND ARRAY NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE C CHARACTER. C ROUTINE FM413 TESTS USE OF UNFORMATTED RECORDS WITH A FILE C CONNECTED FOR DIRECT ACCESS. C C THIS ROUTINE TESTS C C (1) THE STATEMENT CONSTRUCTS C C A. WRITE (U) VARIABLE-NAME,... C B. WRITE (U) ARRAY-ELEMENT-NAME,... C C. WRITE (U) ARRAY-NAME,... C D. WRITE (U) - NO OUTPUT LIST C E. WRITE (U) IMPLIED-DO-LIST C F. READ (U) VARIABLE-NAME,... C G. READ (U) ARRAY-ELEMENT-NAME,... C H. READ (U) ARRAY-NAME,... C I. READ (U,END=S) - NO INPUT LIST C J. READ (U,END=S) VARIABLE-NAME C K. READ (U) IMPLIED-DO-LIST C C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE C NUMBER OF VALUES IN THE RECORD. C C (3) USE OF THE BACKSPACE, REWIND AND ENDFILE STATEMENT C ON A FILE CONTAINING UNFORMATTED RECORDS. C C (4) USE OF A REWIND STATEMENT ON A FILE THAT IS CONNECTED C BUT DOES NOT EXIST. C C (5) USE OF AN ENDFILE STATEMENT TO CREATE A FILE THAT C DOES NOT EXIST C C REFERENCES - C C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1977 C C SECTION 4.1, DATA TYPES C SECTION 12.1.2, UNFORMATTED RECORDS C SECTION 12.2.1, FILE EXISTENCE C SECTION 12.2.4, FILE ACCESS C SECTION 12.2.4.1, SEQUENTIAL ACCESS C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER C SECTION 12.7.2, END-OF-FILE SPECIFIER C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS C SECTION 12.8.1, CONTROL INFORMATION LIST C SECTION 12.8.2, INPUT/OUTPUT LIST C SECTION 12.8.2.1, INPUT LIST ITEMS C SECTION 12.8.2.2, OUTPUT LIST ITEMS C SECTION 12.8.2.3, IMPLIED-DO LIST C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER C SECTION 12.10.4, FILE POSITIONING STATEMENTS C SECTION 12.10.4.1 BACKSPACE STATEMENT C SECTION 12.10.4.2, ENDFILE STATEMENT C SECTION 12.10.4.3, REWIND STATEMENT C C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (C) C LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2 LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4 LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7 LOGICAL LVONF8 DIMENSION IDUMP(80) DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2) DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2) DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2) DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2) DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2) DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2) DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/ DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/ DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/ DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 1 .TRUE., .FALSE./ DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 1 .TRUE., .FALSE./ DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 1 .TRUE., .FALSE./ DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./ DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./ DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./ ICON21 = 11 ICON22 = -11 ICON31 = +777 ICON32 = -777 ICON33 = 512 ICON34 = -512 ICON55 = -32767 ICON56 = 32767 RCON21 = 11. RCON22 = -11. RCON31 = +7.77 RCON32 = -7.77 RCON33 = .512 RCON34 = -.512 RCON55 = -32767. RCON56 = 32767. LCONT1 = .TRUE. LCONF2 = .FALSE. LCONT3 = .TRUE. LCONF4 = .FALSE. LCONT5 = .TRUE. LCONF6 = .FALSE. LCONT7 = .TRUE. LCONF8 = .FALSE. C C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES C C FILE IDENTIFIER - I04 (X-NUMBER 04) C RECORD SIZE - 80 C ACCESS METHOD - SEQUENTIAL C RECORD TYPE - UNFORMATTED C DESIGNATED DEVICE - DISK C TYPE OF DATA - INTEGER, REAL AND LOGICAL C RECORDS IN FILE - 142 PLUS ENDFILE RECORD C C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT- C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD C OF THE PREAMBLE FOLLOWS. C C VARIABLE NAME IN PROGRAM FIELD NUMBER C ------------------------ ------------ C C IPROG (ROUTINE NAME) - 1 C IFILE (LOGICAL/X-NUMBER) - 2 C ITOTR (RECORDS IN FILE) - 3 C IRLGN (LENGTH OF RECORD) - 4 C IRECN (RECORD NUMBER) - 5 C IEOF (9999 IF LAST RECORD) - 6 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 PEPLACED 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 PEPLACED 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 OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C I04 = 8 C I04 CONTAINS THE LOGICAL UNIT NUMBER FOR A SEQUENTIAL ACCESS FILE CX040 THIS CARD IS REPLACED BY CONTENTS OF X-040 CARD CX041 THIS CARD IS REPLACED BY CONTENTS OF X-041 CARD IPROG = 411 IFILE = I04 ITOTR = 142 IRLGN = 80 IRECN = 0 IEOF = 0 C C **** FCVS PROGRAM 411 - TEST 001 **** C C C TEST 001 USES THE REWIND STATEMENT ON A FILE THAT IS CONNECTED C BUT DOES NOT EXIST. THERE SHOULD BE NO EFFECT ON THE FILE WHEN C THIS STATEMENT IS EXECUTED. CONNECTION OF THE FILE TO A UNIT C IS ASSUMED TO BE DONE BY PRECONNECTION. C C SEE SECTION 12.10.4.3, REWIND STATEMENT C C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE IVCORR = 1 IVCOMP = 0 REWIND I04 IVCOMP = 1 40010 IF (IVCOMP - 1) 20010, 10010, 20010 30010 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10010, 0021, 20010 10010 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0021 20010 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0021 CONTINUE C C **** FCVS PROGRAM 411 - TEST 002 **** C C C TEST 002 USES THE ENDFILE STATEMENT TO CREATE A FILE THAT IS C CONNECTED BUT DOES NOT EXIST. NO RECORDS HAVE BEEN WRITTEN TO C THE FILE BEFORE THE ENDFILE STATEMENT IS EXECUTED. AS IN THE C PRECEDING TEST, IT IS ASSUMED THAT CONNECTION OF THE FILE TO A C UNIT IS DONE BY PRECONNECTION. C C SEE SECTIONS 12.2.1, FILE EXISTENCE C 12.10.4.2, ENDFILE STATEMENT C C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE IVCORR = 1 IVCOMP = 0 ENDFILE I04 REWIND I04 READ (I04, END = 0023) IVON01 C C TO TEST CREATION OF A FILE VIA A ENDFILE STATEMENT THE FILE C IS REWOUND AND READ. AN END-OF-FILE CONDITION IS EXPECTED TO C OCCUR ON THE FIRST READ SINCE THE ONLY RECORD WRITTEN TO THE C FILE WAS THE ENDFILE RECORD. C IVCOMP = 0 GO TO 40020 0023 IVCOMP = 1 40020 IF (IVCOMP - 1) 20020, 10020, 20020 30020 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10020, 0031, 20020 10020 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0031 20020 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0031 CONTINUE C C C TESTS 003 THROUGH 019 USE A PRECONNECTED FILE FOR SEQUENTIAL C ACCESS TO WRITE 141 RECORDS TO THE FILE. THESE TESTS TEST USE OF C THE ALLOWABLE FORMS OF THE WRITE STATEMENT ON A FILE CONNECTED C FOR SEQUENTIAL ACCESS. THE WRITE STATEMENT IS USED WITH C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY. C THE PURPOSE OF TESTS 003 THROUGH 019 IS TO CHECK THE COMPILER'S C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE C WRITE STATEMENT. LATER TESTS WITHIN THIS ROUINE READ AND C CHECK THE RECORDS WHICH ARE CREATED. C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD C NUMBER FOR THE RECORD. C C C C **** FCVS PROGRAM 411 - TEST 003 **** C C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE REWIND I04 C REPOSITION TO BEGINNING OF FILE C C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF INTEGER TYPE. C IRECN = 01 IVCORR = 01 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 IVCOMP = IRECN 40030 IF (IVCOMP - 01) 20030, 10030, 20030 30030 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10030, 0041, 20030 10030 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0041 20030 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0041 CONTINUE C C **** FCVS PROGRAM 411 - TEST 004 **** C C C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF REAL TYPE. C C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE IRECN = 02 IVCORR = 02 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 IVCOMP = IRECN 40040 IF (IVCOMP - 02) 20040, 10040, 20040 30040 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10040, 0051, 20040 10040 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0051 20040 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0051 CONTINUE C C **** FCVS PROGRAM 411 - TEST 005 **** C C C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF LOGICAL TYPE. C C IVTNUM = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE IRECN = 03 IVCORR = 03 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF8 IVCOMP = IRECN 40050 IF (IVCOMP - 03) 20050, 10050, 20050 30050 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10050, 0061, 20050 10050 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0061 20050 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0061 CONTINUE C C **** FCVS PROGRAM 411 - TEST 006 **** C C C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE C DIMENSION ARRAYS ARE USED. C C IVTNUM = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE IRECN = 04 IVCORR = 04 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2), 2 IAON31(2,1,2), IAON11(7), IAON11(8) IVCOMP = IRECN 40060 IF (IVCOMP - 04) 20060, 10060, 20060 30060 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10060, 0071, 20060 10060 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0071 20060 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0071 CONTINUE C C **** FCVS PROGRAM 411 - TEST 007 **** C C C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE C DIMENSION ARRAYS ARE USED. C C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE IRECN = 05 IVCORR = 05 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 2RAON31(2,1,2), RAON11(7), RAON11 (8) IVCOMP = IRECN 40070 IF (IVCOMP - 05) 20070, 10070, 20070 30070 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10070, 0081, 20070 10070 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0081 20070 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0081 CONTINUE C C **** FCVS PROGRAM 411 - TEST 008 **** C C C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE IRECN = 06 IVCORR = 06 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2), 2 LAON31(2,1,2), LAON11(7), LAON11(8) IVCOMP = IRECN 40080 IF (IVCOMP - 06) 20080, 10080, 20080 30080 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10080, 0091, 20080 10080 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0091 20080 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0091 CONTINUE C C **** FCVS PROGRAM 411 - TEST 009 **** C C C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF INTEGER TYPE. C C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE IRECN = 07 IVCORR = 07 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IAON31 IVCOMP = IRECN 40090 IF (IVCOMP - 07) 20090, 10090, 20090 30090 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10090, 0101, 20090 10090 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0101 20090 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0101 CONTINUE C C **** FCVS PROGRAM 411 - TEST 010 **** C C C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF REAL TYPE. C C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE IRECN = 08 IVCORR = 08 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON31 IVCOMP = IRECN 40100 IF (IVCOMP - 08) 20100, 10100, 20100 30100 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10100, 0111, 20100 10100 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0111 20100 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0111 CONTINUE C C **** FCVS PROGRAM 411 - TEST 011 **** C C C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF LOGICAL TYPE. C C IVTNUM = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE IRECN = 09 IVCORR = 09 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LAON31 IVCOMP = IRECN 40110 IF (IVCOMP - 09) 20110, 10110, 20110 30110 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10110, 0121, 20110 10110 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0121 20110 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0121 CONTINUE C C **** FCVS PROGRAM 411 - TEST 012 **** C C C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767. C C IVTNUM = 12 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE IRECN = 10 IVCORR = 10 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) IVCOMP = IRECN 40120 IF (IVCOMP - 10) 20120, 10120, 20120 30120 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10120, 0131, 20120 10120 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0131 20120 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0131 CONTINUE C C **** FCVS PROGRAM 411 - TEST 013 **** C C C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11., C 7.77, -7.77, .512, -.512, -32767., 32767. C C IVTNUM = 13 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE IRECN = 11 IVCORR = 11 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) IVCOMP = IRECN 40130 IF (IVCOMP - 11) 20130, 10130, 20130 30130 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10130, 0141, 20130 10130 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0141 20130 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0141 CONTINUE C C **** FCVS PROGRAM 411 - TEST 014 **** C C C TEST 014 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER (AN ORDER C DIFFERENT THAN TEST 012 ABOVE) VIS-A-VIS THE C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE. C .FALSE, .FALSE. C C IVTNUM = 14 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE IRECN = 12 IVCORR = 12 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) IVCOMP = IRECN 40140 IF (IVCOMP - 12) 20140, 10140, 20140 30140 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10140, 0151, 20140 10140 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0151 20140 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0151 CONTINUE C C **** FCVS PROGRAM 411 - TEST 015 **** C C C TEST 015 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. C THE OUTPUT LIST ITEMS ARE OPTIONAL. C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. C C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS C 12.8, READ, WRITE AND PRINT STATEMENTS C C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE IRECN = 13 IVCORR = 13 WRITE (I04) IVCOMP = IRECN 40150 IF (IVCOMP - 13) 20150, 10150, 20150 30150 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10150, 0161, 20150 10150 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0161 20150 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0161 CONTINUE C C **** FCVS PROGRAM 411 - TEST 016 **** C C C TEST 016 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THE WRITE C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE C WRITTEN. C C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE IRECN = 13 DO 4132 I = 1,100 IRECN = IRECN + 1 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 4132 CONTINUE IVCORR = 100 IVCOMP = IRECN - 13 40160 IF (IVCOMP - 100) 20160, 10160, 20160 30160 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10160, 0171, 20160 10160 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0171 20160 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0171 CONTINUE C C C THE NEXT THREE TESTS TEST USE OF THE BACKSPACE AND ENDFILE C STATEMENTS C C C C **** FCVS PROGRAM 411 - TEST 017 **** C C TEST 017 USES AN ENDFILE STATEMENT TO WRITE AN ENDFILE C RECORD TO A FILE WITH UNFORMATTED RECORDS. AFTER EXECUTION C OF THIS STATEMENT THE FILE SHOULD BE POSITION AFTER THE ENDFILE C RECORD. C C IVTNUM = 17 IF (ICZERO) 30170, 0170, 30170 0170 CONTINUE IVCORR = 1 IVCOMP = 0 0172 ENDFILE I04 IVCOMP = 1 40170 IF (IVCOMP - 1) 20170, 10170, 20170 C 30170 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10170, 0181, 20170 10170 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0181 20170 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0181 CONTINUE C C **** FCVS PROGRAM 411 - TEST 018 **** C C C TEST 018 USES THE BACKSPACE STATEMENT TO REPOSITION THE FILE C BEFORE THE ENDFILE RECORD. C C SEE SECTIONS 12.10.4.1, BACKSPACE STATEMENT C 12.10.4.2, ENDFILE STATEMENT C C IVTNUM = 18 IF (ICZERO) 30180, 0180, 30180 0180 CONTINUE IVCORR = 1 IVCOMP = 0 BACKSPACE I04 IVCOMP = 1 40180 IF (IVCOMP - 1) 20180, 10180, 20180 30180 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10180, 0191, 20180 10180 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0191 20180 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0191 CONTINUE C C **** FCVS PROGRAM 411 - TEST 019 **** C C C TEST 019 IS A CONTINUATION OF THE ENDFILE AND BACKSPACE TESTS C (TWO PREVIOUS TESTS). THIS TEST CONTINUES WRITTING RECORDS TO THE C FILE OVER THE ENDFILE RECORD PREVIOUSLY WRITTEN IN TEST 017. C TWENTY EIGHT RECORDS ARE WRITTEN TO THE FILE FOLLOWED BY AN C ENDFILE. C C IVTNUM = 19 IF (ICZERO) 30190, 0190, 30190 0190 CONTINUE IVCOMP = 0 IRECN = 113 DO 4112 I = 1,28 IRECN = IRECN + 1 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 IVCOMP = IVCOMP + 1 4112 CONTINUE IVCORR = 29 IEOF = 9999 IRECN = IRECN + 1 WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF IVCOMP = IVCOMP + 1 ENDFILE I04 C C THERE SHOULD BE A TOTAL OF 142 RECORDS PLUS AN ENDFILE RECORD C IN THE FILE AFTER EXECUTION OF THIS TEST. C 40190 IF (IVCOMP - 29) 20190, 10190, 20190 30190 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10190, 0201, 20190 10190 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0201 20190 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0201 CONTINUE C C C THE NEXT SERIES OF TESTS READ AND CHECK THE RECORDS CREATED IN C TESTS 03 THROUGH 019. EACH OF THE TESTS IN THIS SET IS CHECKING C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 003 C THROUGH 019 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. C THE READ STATEMENT IS USED WITH THE I/O LIST ITEMS AS A VARIABLE, C AN ARRAY ELEMENT AND AN ARRAY. C C C C **** FCVS PROGRAM 411 - TEST 020 **** C C C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF INTEGER TYPE. C C IVTNUM = 20 IF (ICZERO) 30200, 0200, 30200 0200 CONTINUE REWIND I04 C REPOSITION THE FILE TO THE FIRST RECORD IVON22 = 0 IVON56 = 0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3 IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5 40200 IF (IVCOMP - 30) 20200, 10200, 20200 30200 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10200, 0211, 20200 10200 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0211 20200 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0211 CONTINUE C C **** FCVS PROGRAM 411 - TEST 021 **** C C C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF REAL TYPE. C C IVTNUM = 21 IF (ICZERO) 30210, 0210, 30210 0210 CONTINUE RVON22 = 0.0 RVON31 = 0.0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56 IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2 IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3 IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5 40210 IF (IVCOMP - 30) 20210, 10210, 20210 30210 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10210, 0221, 20210 10210 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0221 20210 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0221 CONTINUE C C **** FCVS PROGRAM 411 - TEST 022 **** C C C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF LOGICAL TYPE. C C IVTNUM = 22 IF (ICZERO) 30220, 0220, 30220 0220 CONTINUE LVONT1 = .FALSE. LVONF6 = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF8 IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2 IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3 IF (LVONT1) IVCOMP = IVCOMP * 5 40220 IF (IVCOMP - 30) 20220, 10220, 20220 30220 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10220, 0231, 20220 10220 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0231 20220 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0231 CONTINUE C C **** FCVS PROGRAM 411 - TEST 023 **** C C C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE C DIMENSION ARRAYS ARE USED. C C IVTNUM = 23 IF (ICZERO) 30230, 0230, 30230 0230 CONTINUE IAON12(2) = 0 IAON12(8) = 0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2), 2 IAON32(2,1,2), IAON12(7), IAON12(8) IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2 IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3 IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40230 IF (IVCOMP - 30) 20230, 10230, 20230 30230 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10230, 0241, 20230 10230 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0241 20230 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0241 CONTINUE C C **** FCVS PROGRAM 411 - TEST 024 **** C C C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE C DIMENSION ARRAYS ARE USED. C C IVTNUM = 24 IF (ICZERO) 30240, 0240, 30240 0240 CONTINUE RAON22(2,2) = 0.0 RAON32(1,1,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2), 2 RAON32(2,1,2), RAON12(7), RAON12(8) IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2 IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3 IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40240 IF (IVCOMP - 30) 20240, 10240, 20240 30240 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10240, 0251, 20240 10240 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0251 20240 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0251 CONTINUE C C **** FCVS PROGRAM 411 - TEST 025 **** C C C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE C DIMENSION ARRAYS ARE USED. C C C IVTNUM = 25 IF (ICZERO) 30250, 0250, 30250 0250 CONTINUE LAON12(1) = .FALSE. LAON32(2,1,2) = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2), 2 LAON32(2,1,2), LAON12(7), LAON12(8) IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2 IF (LAON12(1)) IVCOMP = IVCOMP * 3 IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5 40250 IF (IVCOMP - 30) 20250, 10250, 20250 30250 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10250, 0261, 20250 10250 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0261 20250 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0261 CONTINUE C C **** FCVS PROGRAM 411 - TEST 026 **** C C C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF INTEGER TYPE. C C IVTNUM = 26 IF (ICZERO) 30260, 0260, 30260 0260 CONTINUE IAON32(2,1,1) = 0 IAON32(2,2,2) = 0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IAON32 IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2 IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3 IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40260 IF (IVCOMP - 30) 20260, 10260, 20260 30260 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10260, 0271, 20260 10260 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0271 20260 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0271 CONTINUE C C **** FCVS PROGRAM 411 - TEST 027 **** C C C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF REAL TYPE. C C IVTNUM = 27 IF (ICZERO) 30270, 0270, 30270 0270 CONTINUE RAON32(2,1,1) = 0.0 RAON32(2,2,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON32 IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2 IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3 IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40270 IF (IVCOMP - 30) 20270, 10270, 20270 30270 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10270, 0281, 20270 10270 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0281 20270 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0281 CONTINUE C C **** FCVS PROGRAM 411 - TEST 028 **** C C C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF LOGICAL TYPE. C C IVTNUM = 28 IF (ICZERO) 30280, 0280, 30280 0280 CONTINUE LAON32(1,1,1) = .FALSE. LAON32(2,2,2) = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LAON32 IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2 IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3 IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5 40280 IF (IVCOMP - 30) 20280, 10280, 20280 30280 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10280, 0291, 20280 10280 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0291 20280 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0291 CONTINUE C C **** FCVS PROGRAM 411 - TEST 029 **** C C C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS C C VALUE 11 777 512 -32767 -11 -777 -512 32767 C FIELD POS 1 3 2 4 5 7 6 8 C IAON32 1 2 3 4 5 6 7 8 C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2 C C IVTNUM = 29 IF (ICZERO) 30290, 0290, 30290 0290 CONTINUE IAON32(2,1,1) = 0 IAON32(2,2,1) = 0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2) IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2 IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3 IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40290 IF (IVCOMP - 30) 20290, 10290, 20290 30290 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10290, 0301, 20290 10290 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0301 20290 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0301 CONTINUE C C **** FCVS PROGRAM 411 - TEST 030 **** C C C TEST 030 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC- C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE. C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND C SUBSCRIPT VALUE AFTER THE THE READ IS C C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767. C FIELD POS 1 2 3 4 5 6 7 8 C RAON32 1 2 3 4 5 6 7 8 C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2 C C IVTNUM = 30 IF (ICZERO) 30300, 0300, 30300 0300 CONTINUE RAON32(1,2,1) = 0.0 RAON32(1,2,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2) IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2 IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3 IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5 C C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE C FIELD VALUE AND A POSITIVE FIELD VALUE. C 40300 IF (IVCOMP - 30) 20300, 10300, 20300 30300 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10300, 0311, 20300 10300 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0311 20300 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0311 CONTINUE C C **** FCVS PROGRAM 411 - TEST 031 **** C C C TEST 031 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS C C VALUE T T F F T T F F C FIELD POS 1 5 3 7 2 6 4 8 C LAON32 1 2 3 4 5 6 7 8 C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2 C C IVTNUM = 31 IF (ICZERO) 30310, 0310, 30310 0310 CONTINUE LAON32(1,2,1) = .TRUE. LAON32(2,1,1) = .FALSE. IVCORR = 30 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2) IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2 IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3 IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5 40310 IF (IVCOMP - 30) 20310, 10310, 20310 30310 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10310, 0321, 20310 10310 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0321 20310 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0321 CONTINUE C C **** FCVS PROGRAM 411 - TEST 032 **** C C C TEST 032 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS C RECORD WAS WRITTEN IN TEST 15 AND SHOULD BE RECORD NUMBER 13. C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT C IS ACCEPTABLE TO THE COMPILER. C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. C C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS C 12.8, READ, WRITE AND PRINT STATEMENTS C C IVTNUM = 32 IF (ICZERO) 30320, 0320, 30320 0320 CONTINUE IRECN = 13 IVCORR = 13 READ (I04) IVCOMP = IRECN 40320 IF (IVCOMP - 13) 20320, 10320, 20320 30320 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10320, 0331, 20320 10320 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0331 20320 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0331 CONTINUE C C **** FCVS PROGRAM 411 - TEST 033 **** C C C TEST 033 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN C THE RECORD. THIS TEST READS RECORD NUMBER 14 WHICH WAS CREATED C IN TEST 016. C C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER C C IVTNUM = 33 IF (ICZERO) 30330, 0330, 30330 0330 CONTINUE IVON21 = 0 IVON22 = 0 IVON31 = 0 IVCORR = 0 IVCOMP = 1 READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON21, IVON22, IVON31 IF (IRECN .EQ. 14) IVCOMP = IVCOMP * 2 IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5 40330 IF (IVCOMP - 30) 20330, 10330, 20330 30330 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10330, 0341, 20330 10330 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0341 20330 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0341 CONTINUE C C C THE FOLLOWING TWO TESTS USE THE READ STATEMENT WITH THE C END SPECIFIER. C C C C **** FCVS PROGRAM 411 - TEST 034 **** C C C TEST 034 USES THE READ STATEMENT WITHOUT ANY I/O LIST ITEMS. C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS. C IVTNUM = 34 IF (ICZERO) 30340, 0340, 30340 0340 CONTINUE REWIND I04 C IVCOMP = 1 IVON01 = 0 IVCORR = 6 DO 0342 I=1,150 READ (I04, END = 0343) IVON01 = IVON01 + 1 IF (IVON01 .GT. 150) GO TO 40340 0342 CONTINUE GO TO 40340 0343 IVCOMP = IVCOMP * 2 IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3 40340 IF (IVCOMP - 6) 20340, 10340, 20340 30340 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10340, 0351, 20340 10340 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0351 20340 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0351 CONTINUE C C **** FCVS PROGRAM 411 - TEST 035 **** C C C TEST 035 USES THE READ STATEMENT WITH INPUT LIST ITEMS. C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS. C C IVTNUM = 35 IF (ICZERO) 30350, 0350, 30350 0350 CONTINUE REWIND I04 IVCOMP = 1 IVCORR = 6 IVON01 = 0 IRECCK = 0 DO 0352 I = 1,150 IRECCK = IRECCK + 1 IF (IRECCK .EQ. 13) GO TO 0353 C TEST 015 WROTE A RECORD WITHOUT ANY I/O LIST ITEMS THEREFORE C THE RECORD IS READ WITHOUT ANY I/O LIST ITEMS. READ (I04, END = 0354) IPROG, IFILE, ITOTR, IRLGN, IRECN,IEOF GO TO 0355 0353 READ (I04) IVON01 = IVON01 + 1 0355 IF (IRECN .EQ. IRECCK) IVON01 = IVON01 + 1 0352 CONTINUE GO TO 40350 0354 IVCOMP = IVCOMP * 2 IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3 40350 IF (IVCOMP - 6) 20350, 10350, 20350 30350 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10350, 0361, 20350 10350 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0361 20350 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0361 CONTINUE C C C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST C REPORT AND BEFORE THE TEST REPORT SUMMARY. CDB** BEGIN FILE DUMP CODE C REWIND I04 C ITOTR = 142 C ILUN = I04 C IRLGN = 80 C IRNUM = 1 C7701 FORMAT (80A1) C7702 FORMAT (1X,80A1) C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK) C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,I C 13,9H RECORDS.) C DO 7771 IRNUM = 1, ITOTR C READ (ILUN, END = 7772) (IDUMP(ICH), ICH = 1, IRLGN) C WRITE (I02,7702) (IDUMP(ICH), ICH = 1, IRLGN) C7771 CONTINUE C7772 CONTINUE CDE** END OF DUMP CODE C TEST 035 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD C HAVE MADE 35 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR C SEQUENTIAL ACCESS C C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM411) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM411) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END