PROGRAM FM413 C C C C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS C IN FILES CONNECTED FOR DIRECT ACCESS. FOR THE SUBSET LANGUAGE A C FILE CONNECTED FOR DIRECT ACCESS MUST HAVE UNFORMATTED RECORDS C THIS ROUTINE FIRST TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE C READ AND WRITE STATEMENTS USED IN CREATING AND ACCESSING C RECORDS OF THE FILE. THE OPEN STATEMENT IS USED TO CONNECT C THE FILE TO A UNIT AND ESTABLISH ITS CONNECTION FOR DIRECT C ACCESS. THE FIRST SERIES OF TESTS CREATE AND ACCESS THE C RECORDS OF THE FILE IN RECORD NUMBER SEQUENCE AND THE LAST C SERIES OF TESTS CREATE AND ACCESS RECORDS OF THE FILE IN RANDOM C ORDER. C C UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND NONCHARACTER C DATA AND THIS DATA IS TRANSFERRED WITHOUT EDITING BETWEEN THE C CURRENT RECORD AND THE ENTITIES SPECIFIED BY THE INPUT/OUTPUT C LIST. THIS ROUTINE BOTH READS AND WRITES RECORDS CONTAINING C THE DATA TYPES OF INTEGER ,REAL AND LOGICAL WITH I/O LIST ITEMS C REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT NAMES AND ARRAY C NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE CHARACTER. C C ROUTINE FM411 TESTS USE OF UNFORMATTED RECORDS C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. C C THIS ROUTINE TESTS C C (1) THE STATEMENT CONSTRUCTS C C A. WRITE (U,REC=RN) VARIABLE-NAME,... C B. WRITE (U,REC=RN) ARRAY-ELEMENT-NAME,... C C. WRITE (U,REC=RN) ARRAY-NAME,... C D. WRITE (U,REC=RN) - NO OUTPUT LIST C E. WRITE (U,REC=RN) IMPLIED-DO-LIST C F. READ (U,REC=RN) VARIABLE-NAME,... C G. READ (U,REC=RN) ARRAY-ELEMENT-NAME,... C H. READ (U,REC=RN) ARRAY-NAME,... C I. READ (U,REC=RN) - NO INPUT LIST C J. READ (U,REC=RN) 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 (3) USE OF THE STATEMENT C OPEN (U,ACCESS='DIRECT',RECL=RL) C FOR CONNECTING A FILE TO THE UNIT. C C (4) THAT THE RECORDS OF A DIRECT ACCESS FILE NEED NOT BE C BE CREATED AND READ IN ORDER OF THEIR RECORD NUMBERS. C C (5) THAT THE VALUES OF THE RECORD MAY BE CHANGED WHEN C THE RECORD IS REWRITTEN. 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 RECORD C SECTION 12.2.4, FILE ACCESS C SECTION 12.2.4.2, DIRECT 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.1, OPEN 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 - I10 (X-NUMBER 10) C RECORD SIZE - 80 C ACCESS METHOD - DIRECT C RECORD TYPE - UNFORMATTED C DESIGNATED DEVICE - DISK C TYPE OF DATA - INTEGER, REAL AND LOGICAL C RECORDS IN FILE - 214 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 I10 = 9 C I10 CONTAINS THE LOGICAL UNIT NUMBER FOR A DIRECT ACCESS FILE C WITH UNFORMATTED RECORDS CX100 THE CARD IS REPLACED BY CONTENTS OF X-100 CARD CX101 THE CARD IS REPLACED BY CONTENTS OF X-101 CARD IPROG = 413 IFILE = I10 ITOTR = 214 IRLGN = 80 IRECN = 0 IEOF = 0 C C C C TESTS 001 THROUGH 013 OPEN A FILE CONNECTED FOR DIRECT ACCESS C AND WRITE 12 RECORDS INTO THE FILE. THESE TESTS TEST USE OF THE C ALLOWABLE FORMS OF THE OPEN AND WRITE STATEMENTS ON A FILE C CONNECTED FOR DIRECT 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 001 THROUGH 013 IS TO CHECK THE COMPILER'S C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE OPEN C AND WRITE STATEMENTS. LATER TESTS WITHIN THIS ROUTINE READ C AND CHECK THE RECORDS WHICH WERE CREATED. C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD C NUMBER USED TO WRITE THE RECORD. C C C C **** FCVS PROGRAM 413 - TEST 001 **** C C C TEST 001 USES THE OPEN STATEMENT TO CONNECT A FILE FOR DIRECT C ACCESS. THIS IS THE FIRST ROUTINE TO USE AN OPEN STATEMENT. C C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE IVCORR = 1 IVCOMP = 0 OPEN ( I10, ACCESS = 'DIRECT', RECL = 80 ) 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 413 - TEST 002 **** C C C TEST 002 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF INTEGER TYPE. C C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE IRECN = 01 IVCORR = 01 WRITE (I10,REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 IVCOMP = IRECN 40020 IF (IVCOMP - 01) 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 **** FCVS PROGRAM 413 - TEST 003 **** C C C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF REAL TYPE. C C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE IRECN = 02 IVCORR = 02 WRITE (I10,REC=02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 IVCOMP = IRECN 40030 IF (IVCOMP - 02) 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 413 - TEST 004 **** C C C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS A VARIABLE OF LOGICAL TYPE. C C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE IRECN = 03 IVCORR = 03 WRITE (I10,REC=03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF8 IVCOMP = IRECN 40040 IF (IVCOMP - 03) 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 413 - TEST 005 **** C C C TEST 005 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 = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE IRECN = 04 IVCORR = 04 WRITE (I10,REC=04) 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 40050 IF (IVCOMP - 04) 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 413 - TEST 006 **** C C C TEST 006 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 = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE IRECN = 05 IVCORR = 05 WRITE (I10,REC=05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 2 RAON31(2,1,2), RAON11(7), RAON11(8) IVCOMP = IRECN 40060 IF (IVCOMP - 05) 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 413 - TEST 007 **** C C C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO AND THREE C DIMENSION ARRAYS ARE USED. C C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE IRECN = 06 IVCORR = 06 WRITE (I10,REC=06) 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 40070 IF (IVCOMP - 06) 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 413 - TEST 008 **** C C C TEST 008 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF INTEGER TYPE. C C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE IRECN = 07 IVCORR = 07 WRITE (I10,REC=07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IAON31 IVCOMP = IRECN 40080 IF (IVCOMP - 07) 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 413 - TEST 009 **** C C C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF REAL TYPE. C C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE IRECN = 08 IVCORR = 08 WRITE (I10,REC=08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 RAON31 IVCOMP = IRECN 40090 IF (IVCOMP - 08) 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 413 - TEST 010 **** C C C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM C IS AN ARRAY OF LOGICAL TYPE. C C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE IRECN = 09 IVCORR = 09 WRITE (I10,REC=09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 LAON31 IVCOMP = IRECN 40100 IF (IVCOMP - 09) 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 413 - TEST 011 **** C C C TEST 011 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 = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE IRECN = 10 IVCORR = 10 WRITE (I10,REC=10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) IVCOMP = IRECN 40110 IF (IVCOMP - 10) 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 413 - 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 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 = 12 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE IRECN = 11 IVCORR = 11 WRITE (I10,REC=11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) IVCOMP = IRECN 40120 IF (IVCOMP - 11) 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 413 - 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 LOGICAL TYPE. C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER 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 = 13 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE IRECN = 12 IVCORR = 12 WRITE (I10,REC=12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) IVCOMP = IRECN 40130 IF (IVCOMP - 12) 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 C TESTS 14 AND 15 TEST THE WRITE WITHOUT OUTPUT LIST ITEMS. C C C C C **** FCVS PROGRAM 413 - TEST 014 **** C C C TEST 014 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. C THE OUTPUT LIST ITEMS ARE OPTIONAL AND THIS TEST USES THIS FORM C TO ESTABLISH A RECORD NUMBER FOR A RECORD IN THE FILE. C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. C C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS C 12.2.4.2 (5) AND (6), DIRECT ACCESS C 12.8, READ, WRITE AND PRINT STATEMENTS C C IVTNUM = 14 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE IRECN = 13 IVCORR = 13 WRITE (I10,REC=13) IVCOMP = IRECN 40140 IF (IVCOMP - 13) 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 413 - TEST 015 **** C C C TEST 015 IS SIMILAR TO TEST 014 ABOVE EXCEPT THE RN OF THE C RECORD SPECIFIER (REC = RN) IS AN INTEGER VARIABLE. C C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE IRECN = 14 IVCORR = 14 IREC = 14 WRITE (I10,REC = IREC) IVCOMP = IRECN 40150 IF (IVCOMP - 14) 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 C TESTS 16 AND 17 VERIFY THAT RECORDS MAY BE CREATED IN C OTHER THAN SEQUENTIAL ORDER. ALSO THAT A VARIABLE MAY BY USED C AS THE OPERAND OF THE REC SPECIFIER FOR A WRITE STATEMENT. C C C C **** FCVS PROGRAM 413 - TEST 016 **** C C C TEST 016 TESTS USE OF THE REC SPECIFIER WHERE THE OPERAND C IS A VARIABLE. THIS TEST IS SIMILAR TO TEST 15 EXCEPT THE WRITE C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE C WRITTEN BY INCREMENTING THE VARIABLE BY 2 FOR EACH WRITE. TEST C 032 READS THE RECORDS WRITTEN BY THIS METHOD. C C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE IRECN = 13 IREC = 13 DO 4132 I = 1,100 IREC = IREC + 2 IRECN = IRECN + 2 WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 4132 CONTINUE IVCORR = 100 IVCOMP = IREC - 113 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 **** FCVS PROGRAM 413 - TEST 017 **** C C C TEST 17 IS SIMILAR TO TEST 16 EXCEPT THE RECORD IS C WRITTEN IN REVERSE ORDER OF RECORD NUMBER. ONE HUNDERD RECORDS C ARE WRITTEN AND THE VARIABLE OF THE REC SPECIFIER IS DECREMENTED C BY TWO FOR EACH WRITE. C C IVTNUM = 17 IF (ICZERO) 30170, 0170, 30170 0170 CONTINUE IRECN = 216 IREC = 216 IVCOMP = 0 DO 4133 I=1,100 IREC = IREC - 2 IRECN = IRECN - 2 WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 IVCOMP = IVCOMP + 1 4133 CONTINUE IVCORR = 100 40170 IF (IVCOMP - 100) 20170, 10170, 20170 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 C TESTS 018 THROUGH 030 READ AND CHECK THE RECORDS CREATED IN C TESTS 002 THROUGH 014. 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 002 C THROUGH 013 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. C THE READ STATEMENT IS USED WITH THE I/O LIST ITEM AS A VARIABLE, C AN ARRAY ELEMENT AND AN ARRAY. C C C C **** FCVS PROGRAM 413 - TEST 018 **** C C C TEST 018 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF INTEGER TYPE. C C IVTNUM = 18 IF (ICZERO) 30180, 0180, 30180 0180 CONTINUE IVON22 = 0 IVON56 = 0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 01) 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 40180 IF (IVCOMP - 30) 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 413 - TEST 019 **** C C C TEST 019 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF REAL TYPE. C C IVTNUM = 19 IF (ICZERO) 30190, 0190, 30190 0190 CONTINUE RVON22 = 0.0 RVON31 = 0.0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 02) 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 40190 IF (IVCOMP - 30) 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 **** FCVS PROGRAM 413 - TEST 020 **** C C C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C VARIABLE OF LOGICAL TYPE. C C IVTNUM = 20 IF (ICZERO) 30200, 0200, 30200 0200 CONTINUE LVONT1 = .FALSE. LVONF6 = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I10, REC = 03) 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 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 413 - TEST 021 **** C C C TEST 021 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 = 21 IF (ICZERO) 30210, 0210, 30210 0210 CONTINUE IAON12(2) = 0 IAON12(8) = 0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 04) 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 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 413 - TEST 022 **** C C C TEST 022 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 = 22 IF (ICZERO) 30220, 0220, 30220 0220 CONTINUE RAON22(2,2) = 0.0 RAON32(1,1,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 05) 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 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 413 - TEST 023 **** C C C TEST 023 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 IVTNUM = 23 IF (ICZERO) 30230, 0230, 30230 0230 CONTINUE LAON12(1) = .FALSE. LAON32(2,1,2) = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I10, REC = 06) 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 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 413 - TEST 024 **** C C C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF INTEGER TYPE. C C IVTNUM = 24 IF (ICZERO) 30240, 0240, 30240 0240 CONTINUE IAON32(2,1,1) = 0 IAON32(2,2,2) = 0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 07) 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 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 413 - TEST 025 **** C C C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF REAL TYPE. C C IVTNUM = 25 IF (ICZERO) 30250, 0250, 30250 0250 CONTINUE RAON32(2,1,1) = 0.0 RAON32(2,2,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 08) 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 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 413 - TEST 026 **** C C C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A C ARRAY OF LOGICAL TYPE. C C IVTNUM = 26 IF (ICZERO) 30260, 0260, 30260 0260 CONTINUE LAON32(1,1,1) = .FALSE. LAON32(2,2,2) = .TRUE. IVCORR = 30 IVCOMP = 1 READ (I10, REC = 09) 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 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 413 - TEST 027 **** C C C TEST 027 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 = 27 IF (ICZERO) 30270, 0270, 30270 0270 CONTINUE IAON32(2,1,1) = 0 IAON32(2,2,1) = 0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 10) 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 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 413 - TEST 028 **** C C C TEST 028 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 = 28 IF (ICZERO) 30280, 0280, 30280 0280 CONTINUE RAON32(1,2,1) = 0.0 RAON32(1,2,2) = 0.0 IVCORR = 30 IVCOMP = 1 READ (I10, REC = 11) 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 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 413 - 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 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 = 29 IF (ICZERO) 30290, 0290, 30290 0290 CONTINUE LAON32(1,2,1) = .TRUE. LAON32(2,1,1) = .FALSE. IVCORR = 30 IVCOMP = 1 READ (I10, REC = 12) 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 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 413 - TEST 030 **** C C C TEST 030 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 14 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 = 30 IF (ICZERO) 30300, 0300, 30300 0300 CONTINUE IRECN = 13 IVCORR = 13 READ (I10, REC = 13) IVCOMP = IRECN 40300 IF (IVCOMP - 13) 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 413 - TEST 031 **** C C C TEST 031 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. C C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER C C IVTNUM = 31 IF (ICZERO) 30310, 0310, 30310 0310 CONTINUE IVON21 = 0 IVON22 = 0 IVON31 = 0 IVCORR = 0 IVCOMP = 1 READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON21, IVON22, IVON31 IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 IF (IVON22 .EQ. -11) 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 C TEST 032 AND 033 VERIFIES THAT RECORDS MAY BE READ IN ANY ORDER C ALSO THAT A VARIABLE MAY BE USED AS THE OPERAND OF THE REC SPEC- C IFIER FOR A READ STATEMENT. C C SEE SECTION 2.2.4.2(1) , DIRECT ACCESS C C C C **** FCVS PROGRAM 413 - TEST 032 **** C C C TEST 032 READS THE RECORDS WRITTEN IN TEST 16. EVERY OTHER C RECORD IS READ FOR A TOTAL OF 100 RECORDS (THE REC SPECIFIER C VARIABLE IS INCREMENTED BY 2). C C IVTNUM = 32 IF (ICZERO) 30320, 0320, 30320 0320 CONTINUE IRECCK = 13 IRECN = 0 IREC = 13 IVCOMP = 0 DO 4134 I = 1,100 IREC = IREC + 2 IRECCK = IRECCK + 2 READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 4134 CONTINUE IVCORR = 100 40320 IF (IVCOMP - 100) 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 413 - TEST 033 **** C C C TEST 033 READS THE RECORDS WRITTEN IN TEST 17. THIS TEST IS C SIMILAR TO TEST 32 ABOVE EXCEPT THE FILE IS READ IN REVERSE C RECORD NUMBER ORDER. C C IVTNUM = 33 IF (ICZERO) 30330, 0330, 30330 0330 CONTINUE IRECCK = 216 IRECN = 0 IVCOMP = 0 IREC = 216 DO 4135 I = 1,100 IREC = IREC - 2 IRECCK = IRECCK - 2 READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 4135 CONTINUE IVCORR = 100 40330 IF (IVCOMP - 100) 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 **** FCVS PROGRAM 413 - TEST 034 **** C C C TEST 034 VERIFIES THAT THE VALUES OF A RECORD MAY BE CHANGED C WHEN THE RECORD IS REWRITTEN. RECORD NUMBER 01 IS USED FOR C TESTING. THE RECORD WAS WRITTEN IN TEST 02 AND READ IN TEST 18. C A RECORD CANNOT BE DELETED FROM THE FILE BUT IT CAN BE REWRITTEN. C C SEE SECTION 12.2.4.2 (5), DIRECT ACCESS C C IVTNUM = 34 IF (ICZERO) 30340, 0340, 30340 0340 CONTINUE IRECN = 01 WRITE (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 ICON31, ICON32, ICON21, ICON22, ICON55, ICON56, ICON33, ICON34 READ (I10, REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 IVON61, IVON62, IVON63, IVON64, IVON65,IVON66, IVON67, IVON68 IVCORR = 210 IVCOMP = 1 IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 IF (IVON61 .EQ. 777) IVCOMP = IVCOMP * 3 IF (IVON62 .EQ. -777) IVCOMP = IVCOMP * 5 IF (IVON66 .EQ. 32767) IVCOMP = IVCOMP * 7 40340 IF (IVCOMP - 210) 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 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. C CDB** BEGIN FILE DUMP CODE C ITOTR = 214 C ILUN = I10 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, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN) C WRITE (I02, 7702) (IDUMP(ICH), ICH = 1, IRLGN) C7771 CONTINUE CDE** END OF DUMP CODE C TEST 034 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD C HAVE MADE 34 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR C DIRECT 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,5HFM413) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM413) 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