| PROGRAM FM413 00010413 |
| C 00020413 |
| C 00030413 |
| C 00040413 |
| C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS00050413 |
| C IN FILES CONNECTED FOR DIRECT ACCESS. FOR THE SUBSET LANGUAGE A 00060413 |
| C FILE CONNECTED FOR DIRECT ACCESS MUST HAVE UNFORMATTED RECORDS 00070413 |
| C THIS ROUTINE FIRST TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE 00080413 |
| C READ AND WRITE STATEMENTS USED IN CREATING AND ACCESSING 00090413 |
| C RECORDS OF THE FILE. THE OPEN STATEMENT IS USED TO CONNECT 00100413 |
| C THE FILE TO A UNIT AND ESTABLISH ITS CONNECTION FOR DIRECT 00110413 |
| C ACCESS. THE FIRST SERIES OF TESTS CREATE AND ACCESS THE 00120413 |
| C RECORDS OF THE FILE IN RECORD NUMBER SEQUENCE AND THE LAST 00130413 |
| C SERIES OF TESTS CREATE AND ACCESS RECORDS OF THE FILE IN RANDOM 00140413 |
| C ORDER. 00150413 |
| C 00160413 |
| C UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND NONCHARACTER 00170413 |
| C DATA AND THIS DATA IS TRANSFERRED WITHOUT EDITING BETWEEN THE 00180413 |
| C CURRENT RECORD AND THE ENTITIES SPECIFIED BY THE INPUT/OUTPUT 00190413 |
| C LIST. THIS ROUTINE BOTH READS AND WRITES RECORDS CONTAINING 00200413 |
| C THE DATA TYPES OF INTEGER ,REAL AND LOGICAL WITH I/O LIST ITEMS 00210413 |
| C REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT NAMES AND ARRAY 00220413 |
| C NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE CHARACTER. 00230413 |
| C 00240413 |
| C ROUTINE FM411 TESTS USE OF UNFORMATTED RECORDS 00250413 |
| C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. 00260413 |
| C 00270413 |
| C THIS ROUTINE TESTS 00280413 |
| C 00290413 |
| C (1) THE STATEMENT CONSTRUCTS 00300413 |
| C 00310413 |
| C A. WRITE (U,REC=RN) VARIABLE-NAME,... 00320413 |
| C B. WRITE (U,REC=RN) ARRAY-ELEMENT-NAME,... 00330413 |
| C C. WRITE (U,REC=RN) ARRAY-NAME,... 00340413 |
| C D. WRITE (U,REC=RN) - NO OUTPUT LIST 00350413 |
| C E. WRITE (U,REC=RN) IMPLIED-DO-LIST 00360413 |
| C F. READ (U,REC=RN) VARIABLE-NAME,... 00370413 |
| C G. READ (U,REC=RN) ARRAY-ELEMENT-NAME,... 00380413 |
| C H. READ (U,REC=RN) ARRAY-NAME,... 00390413 |
| C I. READ (U,REC=RN) - NO INPUT LIST 00400413 |
| C J. READ (U,REC=RN) IMPLIED-DO-LIST 00410413 |
| C 00420413 |
| C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES 00430413 |
| C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE 00440413 |
| C NUMBER OF VALUES IN THE RECORD. 00450413 |
| C (3) USE OF THE STATEMENT 00460413 |
| C OPEN (U,ACCESS='DIRECT',RECL=RL) 00470413 |
| C FOR CONNECTING A FILE TO THE UNIT. 00480413 |
| C 00490413 |
| C (4) THAT THE RECORDS OF A DIRECT ACCESS FILE NEED NOT BE 00500413 |
| C BE CREATED AND READ IN ORDER OF THEIR RECORD NUMBERS. 00510413 |
| C 00520413 |
| C (5) THAT THE VALUES OF THE RECORD MAY BE CHANGED WHEN 00530413 |
| C THE RECORD IS REWRITTEN. 00540413 |
| C REFERENCES - 00550413 |
| C 00560413 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00570413 |
| C X3.9-1977 00580413 |
| C 00590413 |
| C SECTION 4.1, DATA TYPES 00600413 |
| C SECTION 12.1.2, UNFORMATTED RECORD 00610413 |
| C SECTION 12.2.4, FILE ACCESS 00620413 |
| C SECTION 12.2.4.2, DIRECT ACCESS 00630413 |
| C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER 00640413 |
| C SECTION 12.7.2, END-OF-FILE SPECIFIER 00650413 |
| C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS 00660413 |
| C SECTION 12.8.1, CONTROL INFORMATION LIST 00670413 |
| C SECTION 12.8.2, INPUT/OUTPUT LIST 00680413 |
| C SECTION 12.8.2.1, INPUT LIST ITEMS 00690413 |
| C SECTION 12.8.2.2, OUTPUT LIST ITEMS 00700413 |
| C SECTION 12.8.2.3, IMPLIED-DO LIST 00710413 |
| C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER 00720413 |
| C SECTION 12.10.1, OPEN STATEMENT 00730413 |
| C 00740413 |
| C 00750413 |
| C 00760413 |
| C ******************************************************************00770413 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00780413 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00790413 |
| C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00800413 |
| C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00810413 |
| C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00820413 |
| C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00830413 |
| C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00840413 |
| C THE RESULT OF EXECUTING THESE TESTS. 00850413 |
| C 00860413 |
| C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00870413 |
| C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00880413 |
| C 00890413 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00900413 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00910413 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00920413 |
| C BUILDING 225 RM A266 00930413 |
| C GAITHERSBURG, MD 20899 00940413 |
| C ******************************************************************00950413 |
| C 00960413 |
| C 00970413 |
| IMPLICIT LOGICAL (L) 00980413 |
| IMPLICIT CHARACTER*14 (C) 00990413 |
| C 01000413 |
| LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2 01010413 |
| LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4 01020413 |
| LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7 01030413 |
| LOGICAL LVONF8 01040413 |
| DIMENSION IDUMP(80) 01050413 |
| DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2) 01060413 |
| DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2) 01070413 |
| DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2) 01080413 |
| DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2) 01090413 |
| DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2) 01100413 |
| DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2) 01110413 |
| DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01120413 |
| DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01130413 |
| DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01140413 |
| DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01150413 |
| 1 .TRUE., .FALSE./ 01160413 |
| DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01170413 |
| 1 .TRUE., .FALSE./ 01180413 |
| DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01190413 |
| 1 .TRUE., .FALSE./ 01200413 |
| DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01210413 |
| DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01220413 |
| DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01230413 |
| ICON21 = 11 01240413 |
| ICON22 = -11 01250413 |
| ICON31 = +777 01260413 |
| ICON32 = -777 01270413 |
| ICON33 = 512 01280413 |
| ICON34 = -512 01290413 |
| ICON55 = -32767 01300413 |
| ICON56 = 32767 01310413 |
| RCON21 = 11. 01320413 |
| RCON22 = -11. 01330413 |
| RCON31 = +7.77 01340413 |
| RCON32 = -7.77 01350413 |
| RCON33 = .512 01360413 |
| RCON34 = -.512 01370413 |
| RCON55 = -32767. 01380413 |
| RCON56 = 32767. 01390413 |
| LCONT1 = .TRUE. 01400413 |
| LCONF2 = .FALSE. 01410413 |
| LCONT3 = .TRUE. 01420413 |
| LCONF4 = .FALSE. 01430413 |
| LCONT5 = .TRUE. 01440413 |
| LCONF6 = .FALSE. 01450413 |
| LCONT7 = .TRUE. 01460413 |
| LCONF8 = .FALSE. 01470413 |
| C 01480413 |
| C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES 01490413 |
| C 01500413 |
| C FILE IDENTIFIER - I10 (X-NUMBER 10) 01510413 |
| C RECORD SIZE - 80 01520413 |
| C ACCESS METHOD - DIRECT 01530413 |
| C RECORD TYPE - UNFORMATTED 01540413 |
| C DESIGNATED DEVICE - DISK 01550413 |
| C TYPE OF DATA - INTEGER, REAL AND LOGICAL 01560413 |
| C RECORDS IN FILE - 214 01570413 |
| C 01580413 |
| C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-01590413 |
| C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN 01600413 |
| C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD 01610413 |
| C OF THE PREAMBLE FOLLOWS. 01620413 |
| C 01630413 |
| C VARIABLE NAME IN PROGRAM FIELD NUMBER 01640413 |
| C ------------------------ ------------ 01650413 |
| C 01660413 |
| C IPROG (ROUTINE NAME) - 1 01670413 |
| C IFILE (LOGICAL/X-NUMBER) - 2 01680413 |
| C ITOTR (RECORDS IN FILE) - 3 01690413 |
| C IRLGN (LENGTH OF RECORD) - 4 01700413 |
| C IRECN (RECORD NUMBER) - 5 01710413 |
| C IEOF (9999 IF LAST RECORD) - 6 01720413 |
| C 01730413 |
| C 01740413 |
| C 01750413 |
| C 01760413 |
| C INITIALIZATION SECTION. 01770413 |
| C 01780413 |
| C INITIALIZE CONSTANTS 01790413 |
| C ******************** 01800413 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01810413 |
| I01 = 5 01820413 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01830413 |
| I02 = 6 01840413 |
| C SYSTEM ENVIRONMENT SECTION 01850413 |
| C 01860413 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01870413 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01880413 |
| C (UNIT NUMBER FOR CARD READER). 01890413 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01900413 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01910413 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01920413 |
| C 01930413 |
| CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01940413 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01950413 |
| C (UNIT NUMBER FOR PRINTER). 01960413 |
| CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01970413 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01980413 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01990413 |
| C 02000413 |
| IVPASS = 0 02010413 |
| IVFAIL = 0 02020413 |
| IVDELE = 0 02030413 |
| ICZERO = 0 02040413 |
| C 02050413 |
| C WRITE OUT PAGE HEADERS 02060413 |
| C 02070413 |
| WRITE (I02,90002) 02080413 |
| WRITE (I02,90006) 02090413 |
| WRITE (I02,90008) 02100413 |
| WRITE (I02,90004) 02110413 |
| WRITE (I02,90010) 02120413 |
| WRITE (I02,90004) 02130413 |
| WRITE (I02,90016) 02140413 |
| WRITE (I02,90001) 02150413 |
| WRITE (I02,90004) 02160413 |
| WRITE (I02,90012) 02170413 |
| WRITE (I02,90014) 02180413 |
| WRITE (I02,90004) 02190413 |
| C 02200413 |
| I10 = 422 02210413 |
| C I10 CONTAINS THE LOGICAL UNIT NUMBER FOR A DIRECT ACCESS FILE 02220413 |
| C WITH UNFORMATTED RECORDS 02230413 |
| CX100 THE CARD IS REPLACED BY CONTENTS OF X-100 CARD 02240413 |
| CX101 THE CARD IS REPLACED BY CONTENTS OF X-101 CARD 02250413 |
| IPROG = 413 02260413 |
| IFILE = I10 02270413 |
| ITOTR = 214 02280413 |
| IRLGN = 80 02290413 |
| IRECN = 0 02300413 |
| IEOF = 0 02310413 |
| C 02320413 |
| C 02330413 |
| C 02340413 |
| C TESTS 001 THROUGH 013 OPEN A FILE CONNECTED FOR DIRECT ACCESS 02350413 |
| C AND WRITE 12 RECORDS INTO THE FILE. THESE TESTS TEST USE OF THE 02360413 |
| C ALLOWABLE FORMS OF THE OPEN AND WRITE STATEMENTS ON A FILE 02370413 |
| C CONNECTED FOR DIRECT ACCESS. THE WRITE STATEMENT IS USED WITH 02380413 |
| C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY. 02390413 |
| C THE PURPOSE OF TESTS 001 THROUGH 013 IS TO CHECK THE COMPILER'S02400413 |
| C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE OPEN 02410413 |
| C AND WRITE STATEMENTS. LATER TESTS WITHIN THIS ROUTINE READ 02420413 |
| C AND CHECK THE RECORDS WHICH WERE CREATED. 02430413 |
| C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD 02440413 |
| C NUMBER USED TO WRITE THE RECORD. 02450413 |
| C 02460413 |
| C 02470413 |
| C 02480413 |
| C **** FCVS PROGRAM 413 - TEST 001 **** 02490413 |
| C 02500413 |
| C 02510413 |
| C TEST 001 USES THE OPEN STATEMENT TO CONNECT A FILE FOR DIRECT 02520413 |
| C ACCESS. THIS IS THE FIRST ROUTINE TO USE AN OPEN STATEMENT. 02530413 |
| C 02540413 |
| C 02550413 |
| IVTNUM = 1 02560413 |
| IF (ICZERO) 30010, 0010, 30010 02570413 |
| 0010 CONTINUE 02580413 |
| IVCORR = 1 02590413 |
| IVCOMP = 0 02600413 |
| OPEN ( I10, ACCESS = 'DIRECT', RECL = 80 ) 02610413 |
| IVCOMP = 1 02620413 |
| 40010 IF (IVCOMP - 1) 20010, 10010, 20010 02630413 |
| 30010 IVDELE = IVDELE + 1 02640413 |
| WRITE (I02,80000) IVTNUM 02650413 |
| IF (ICZERO) 10010, 0021, 20010 02660413 |
| 10010 IVPASS = IVPASS + 1 02670413 |
| WRITE (I02,80002) IVTNUM 02680413 |
| GO TO 0021 02690413 |
| 20010 IVFAIL = IVFAIL + 1 02700413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02710413 |
| 0021 CONTINUE 02720413 |
| C 02730413 |
| C **** FCVS PROGRAM 413 - TEST 002 **** 02740413 |
| C 02750413 |
| C 02760413 |
| C TEST 002 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 02770413 |
| C IS A VARIABLE OF INTEGER TYPE. 02780413 |
| C 02790413 |
| C 02800413 |
| IVTNUM = 2 02810413 |
| IF (ICZERO) 30020, 0020, 30020 02820413 |
| 0020 CONTINUE 02830413 |
| IRECN = 01 02840413 |
| IVCORR = 01 02850413 |
| WRITE (I10,REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 02860413 |
| 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 02870413 |
| IVCOMP = IRECN 02880413 |
| 40020 IF (IVCOMP - 01) 20020, 10020, 20020 02890413 |
| 30020 IVDELE = IVDELE + 1 02900413 |
| WRITE (I02,80000) IVTNUM 02910413 |
| IF (ICZERO) 10020, 0031, 20020 02920413 |
| 10020 IVPASS = IVPASS + 1 02930413 |
| WRITE (I02,80002) IVTNUM 02940413 |
| GO TO 0031 02950413 |
| 20020 IVFAIL = IVFAIL + 1 02960413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970413 |
| 0031 CONTINUE 02980413 |
| C 02990413 |
| C **** FCVS PROGRAM 413 - TEST 003 **** 03000413 |
| C 03010413 |
| C 03020413 |
| C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03030413 |
| C IS A VARIABLE OF REAL TYPE. 03040413 |
| C 03050413 |
| C 03060413 |
| IVTNUM = 3 03070413 |
| IF (ICZERO) 30030, 0030, 30030 03080413 |
| 0030 CONTINUE 03090413 |
| IRECN = 02 03100413 |
| IVCORR = 02 03110413 |
| WRITE (I10,REC=02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03120413 |
| 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 03130413 |
| IVCOMP = IRECN 03140413 |
| 40030 IF (IVCOMP - 02) 20030, 10030, 20030 03150413 |
| 30030 IVDELE = IVDELE + 1 03160413 |
| WRITE (I02,80000) IVTNUM 03170413 |
| IF (ICZERO) 10030, 0041, 20030 03180413 |
| 10030 IVPASS = IVPASS + 1 03190413 |
| WRITE (I02,80002) IVTNUM 03200413 |
| GO TO 0041 03210413 |
| 20030 IVFAIL = IVFAIL + 1 03220413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230413 |
| 0041 CONTINUE 03240413 |
| C 03250413 |
| C **** FCVS PROGRAM 413 - TEST 004 **** 03260413 |
| C 03270413 |
| C 03280413 |
| C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03290413 |
| C IS A VARIABLE OF LOGICAL TYPE. 03300413 |
| C 03310413 |
| C 03320413 |
| IVTNUM = 4 03330413 |
| IF (ICZERO) 30040, 0040, 30040 03340413 |
| 0040 CONTINUE 03350413 |
| IRECN = 03 03360413 |
| IVCORR = 03 03370413 |
| WRITE (I10,REC=03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03380413 |
| 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF803390413 |
| IVCOMP = IRECN 03400413 |
| 40040 IF (IVCOMP - 03) 20040, 10040, 20040 03410413 |
| 30040 IVDELE = IVDELE + 1 03420413 |
| WRITE (I02,80000) IVTNUM 03430413 |
| IF (ICZERO) 10040, 0051, 20040 03440413 |
| 10040 IVPASS = IVPASS + 1 03450413 |
| WRITE (I02,80002) IVTNUM 03460413 |
| GO TO 0051 03470413 |
| 20040 IVFAIL = IVFAIL + 1 03480413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03490413 |
| 0051 CONTINUE 03500413 |
| C 03510413 |
| C **** FCVS PROGRAM 413 - TEST 005 **** 03520413 |
| C 03530413 |
| C 03540413 |
| C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03550413 |
| C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE 03560413 |
| C DIMENSION ARRAYS ARE USED. 03570413 |
| C 03580413 |
| C 03590413 |
| IVTNUM = 5 03600413 |
| IF (ICZERO) 30050, 0050, 30050 03610413 |
| 0050 CONTINUE 03620413 |
| IRECN = 04 03630413 |
| IVCORR = 04 03640413 |
| WRITE (I10,REC=04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03650413 |
| 1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2), 03660413 |
| 2 IAON31(2,1,2), IAON11(7), IAON11(8) 03670413 |
| IVCOMP = IRECN 03680413 |
| 40050 IF (IVCOMP - 04) 20050, 10050, 20050 03690413 |
| 30050 IVDELE = IVDELE + 1 03700413 |
| WRITE (I02,80000) IVTNUM 03710413 |
| IF (ICZERO) 10050, 0061, 20050 03720413 |
| 10050 IVPASS = IVPASS + 1 03730413 |
| WRITE (I02,80002) IVTNUM 03740413 |
| GO TO 0061 03750413 |
| 20050 IVFAIL = IVFAIL + 1 03760413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770413 |
| 0061 CONTINUE 03780413 |
| C 03790413 |
| C **** FCVS PROGRAM 413 - TEST 006 **** 03800413 |
| C 03810413 |
| C 03820413 |
| C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03830413 |
| C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE 03840413 |
| C DIMENSION ARRAYS ARE USED. 03850413 |
| C 03860413 |
| C 03870413 |
| IVTNUM = 6 03880413 |
| IF (ICZERO) 30060, 0060, 30060 03890413 |
| 0060 CONTINUE 03900413 |
| IRECN = 05 03910413 |
| IVCORR = 05 03920413 |
| WRITE (I10,REC=05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03930413 |
| 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 03940413 |
| 2 RAON31(2,1,2), RAON11(7), RAON11(8) 03950413 |
| IVCOMP = IRECN 03960413 |
| 40060 IF (IVCOMP - 05) 20060, 10060, 20060 03970413 |
| 30060 IVDELE = IVDELE + 1 03980413 |
| WRITE (I02,80000) IVTNUM 03990413 |
| IF (ICZERO) 10060, 0071, 20060 04000413 |
| 10060 IVPASS = IVPASS + 1 04010413 |
| WRITE (I02,80002) IVTNUM 04020413 |
| GO TO 0071 04030413 |
| 20060 IVFAIL = IVFAIL + 1 04040413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04050413 |
| 0071 CONTINUE 04060413 |
| C 04070413 |
| C **** FCVS PROGRAM 413 - TEST 007 **** 04080413 |
| C 04090413 |
| C 04100413 |
| C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04110413 |
| C IS AN ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO AND THREE 04120413 |
| C DIMENSION ARRAYS ARE USED. 04130413 |
| C 04140413 |
| C 04150413 |
| IVTNUM = 7 04160413 |
| IF (ICZERO) 30070, 0070, 30070 04170413 |
| 0070 CONTINUE 04180413 |
| IRECN = 06 04190413 |
| IVCORR = 06 04200413 |
| WRITE (I10,REC=06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04210413 |
| 1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2), 04220413 |
| 2 LAON31(2,1,2), LAON11(7), LAON11(8) 04230413 |
| IVCOMP = IRECN 04240413 |
| 40070 IF (IVCOMP - 06) 20070, 10070, 20070 04250413 |
| 30070 IVDELE = IVDELE + 1 04260413 |
| WRITE (I02,80000) IVTNUM 04270413 |
| IF (ICZERO) 10070, 0081, 20070 04280413 |
| 10070 IVPASS = IVPASS + 1 04290413 |
| WRITE (I02,80002) IVTNUM 04300413 |
| GO TO 0081 04310413 |
| 20070 IVFAIL = IVFAIL + 1 04320413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04330413 |
| 0081 CONTINUE 04340413 |
| C 04350413 |
| C **** FCVS PROGRAM 413 - TEST 008 **** 04360413 |
| C 04370413 |
| C 04380413 |
| C TEST 008 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04390413 |
| C IS AN ARRAY OF INTEGER TYPE. 04400413 |
| C 04410413 |
| C 04420413 |
| IVTNUM = 8 04430413 |
| IF (ICZERO) 30080, 0080, 30080 04440413 |
| 0080 CONTINUE 04450413 |
| IRECN = 07 04460413 |
| IVCORR = 07 04470413 |
| WRITE (I10,REC=07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04480413 |
| 1 IAON31 04490413 |
| IVCOMP = IRECN 04500413 |
| 40080 IF (IVCOMP - 07) 20080, 10080, 20080 04510413 |
| 30080 IVDELE = IVDELE + 1 04520413 |
| WRITE (I02,80000) IVTNUM 04530413 |
| IF (ICZERO) 10080, 0091, 20080 04540413 |
| 10080 IVPASS = IVPASS + 1 04550413 |
| WRITE (I02,80002) IVTNUM 04560413 |
| GO TO 0091 04570413 |
| 20080 IVFAIL = IVFAIL + 1 04580413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04590413 |
| 0091 CONTINUE 04600413 |
| C 04610413 |
| C **** FCVS PROGRAM 413 - TEST 009 **** 04620413 |
| C 04630413 |
| C 04640413 |
| C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04650413 |
| C IS AN ARRAY OF REAL TYPE. 04660413 |
| C 04670413 |
| C 04680413 |
| IVTNUM = 9 04690413 |
| IF (ICZERO) 30090, 0090, 30090 04700413 |
| 0090 CONTINUE 04710413 |
| IRECN = 08 04720413 |
| IVCORR = 08 04730413 |
| WRITE (I10,REC=08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04740413 |
| 1 RAON31 04750413 |
| IVCOMP = IRECN 04760413 |
| 40090 IF (IVCOMP - 08) 20090, 10090, 20090 04770413 |
| 30090 IVDELE = IVDELE + 1 04780413 |
| WRITE (I02,80000) IVTNUM 04790413 |
| IF (ICZERO) 10090, 0101, 20090 04800413 |
| 10090 IVPASS = IVPASS + 1 04810413 |
| WRITE (I02,80002) IVTNUM 04820413 |
| GO TO 0101 04830413 |
| 20090 IVFAIL = IVFAIL + 1 04840413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850413 |
| 0101 CONTINUE 04860413 |
| C 04870413 |
| C **** FCVS PROGRAM 413 - TEST 010 **** 04880413 |
| C 04890413 |
| C 04900413 |
| C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04910413 |
| C IS AN ARRAY OF LOGICAL TYPE. 04920413 |
| C 04930413 |
| C 04940413 |
| IVTNUM = 10 04950413 |
| IF (ICZERO) 30100, 0100, 30100 04960413 |
| 0100 CONTINUE 04970413 |
| IRECN = 09 04980413 |
| IVCORR = 09 04990413 |
| WRITE (I10,REC=09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05000413 |
| 1 LAON31 05010413 |
| IVCOMP = IRECN 05020413 |
| 40100 IF (IVCOMP - 09) 20100, 10100, 20100 05030413 |
| 30100 IVDELE = IVDELE + 1 05040413 |
| WRITE (I02,80000) IVTNUM 05050413 |
| IF (ICZERO) 10100, 0111, 20100 05060413 |
| 10100 IVPASS = IVPASS + 1 05070413 |
| WRITE (I02,80002) IVTNUM 05080413 |
| GO TO 0111 05090413 |
| 20100 IVFAIL = IVFAIL + 1 05100413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05110413 |
| 0111 CONTINUE 05120413 |
| C 05130413 |
| C **** FCVS PROGRAM 413 - TEST 011 **** 05140413 |
| C 05150413 |
| C 05160413 |
| C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05170413 |
| C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. 05180413 |
| C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05190413 |
| C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN 05200413 |
| C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767. 05210413 |
| C 05220413 |
| C 05230413 |
| IVTNUM = 11 05240413 |
| IF (ICZERO) 30110, 0110, 30110 05250413 |
| 0110 CONTINUE 05260413 |
| IRECN = 10 05270413 |
| IVCORR = 10 05280413 |
| WRITE (I10,REC=10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290413 |
| 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) 05300413 |
| IVCOMP = IRECN 05310413 |
| 40110 IF (IVCOMP - 10) 20110, 10110, 20110 05320413 |
| 30110 IVDELE = IVDELE + 1 05330413 |
| WRITE (I02,80000) IVTNUM 05340413 |
| IF (ICZERO) 10110, 0121, 20110 05350413 |
| 10110 IVPASS = IVPASS + 1 05360413 |
| WRITE (I02,80002) IVTNUM 05370413 |
| GO TO 0121 05380413 |
| 20110 IVFAIL = IVFAIL + 1 05390413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05400413 |
| 0121 CONTINUE 05410413 |
| C 05420413 |
| C **** FCVS PROGRAM 413 - TEST 012 **** 05430413 |
| C 05440413 |
| C 05450413 |
| C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05460413 |
| C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES 05470413 |
| C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11., 05480413 |
| C 7.77, -7.77, .512, -.512, -32767., 32767. 05490413 |
| C 05500413 |
| C 05510413 |
| IVTNUM = 12 05520413 |
| IF (ICZERO) 30120, 0120, 30120 05530413 |
| 0120 CONTINUE 05540413 |
| IRECN = 11 05550413 |
| IVCORR = 11 05560413 |
| WRITE (I10,REC=11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05570413 |
| 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) 05580413 |
| IVCOMP = IRECN 05590413 |
| 40120 IF (IVCOMP - 11) 20120, 10120, 20120 05600413 |
| 30120 IVDELE = IVDELE + 1 05610413 |
| WRITE (I02,80000) IVTNUM 05620413 |
| IF (ICZERO) 10120, 0131, 20120 05630413 |
| 10120 IVPASS = IVPASS + 1 05640413 |
| WRITE (I02,80002) IVTNUM 05650413 |
| GO TO 0131 05660413 |
| 20120 IVFAIL = IVFAIL + 1 05670413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05680413 |
| 0131 CONTINUE 05690413 |
| C 05700413 |
| C **** FCVS PROGRAM 413 - TEST 013 **** 05710413 |
| C 05720413 |
| C 05730413 |
| C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05740413 |
| C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. 05750413 |
| C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05760413 |
| C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN 05770413 |
| C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.05780413 |
| C .FALSE, .FALSE. 05790413 |
| C 05800413 |
| C 05810413 |
| IVTNUM = 13 05820413 |
| IF (ICZERO) 30130, 0130, 30130 05830413 |
| 0130 CONTINUE 05840413 |
| IRECN = 12 05850413 |
| IVCORR = 12 05860413 |
| WRITE (I10,REC=12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05870413 |
| 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) 05880413 |
| IVCOMP = IRECN 05890413 |
| 40130 IF (IVCOMP - 12) 20130, 10130, 20130 05900413 |
| 30130 IVDELE = IVDELE + 1 05910413 |
| WRITE (I02,80000) IVTNUM 05920413 |
| IF (ICZERO) 10130, 0141, 20130 05930413 |
| 10130 IVPASS = IVPASS + 1 05940413 |
| WRITE (I02,80002) IVTNUM 05950413 |
| GO TO 0141 05960413 |
| 20130 IVFAIL = IVFAIL + 1 05970413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980413 |
| 0141 CONTINUE 05990413 |
| C 06000413 |
| C 06010413 |
| C TESTS 14 AND 15 TEST THE WRITE WITHOUT OUTPUT LIST ITEMS. 06020413 |
| C 06030413 |
| C 06040413 |
| C 06050413 |
| C 06060413 |
| C **** FCVS PROGRAM 413 - TEST 014 **** 06070413 |
| C 06080413 |
| C 06090413 |
| C TEST 014 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. 06100413 |
| C THE OUTPUT LIST ITEMS ARE OPTIONAL AND THIS TEST USES THIS FORM 06110413 |
| C TO ESTABLISH A RECORD NUMBER FOR A RECORD IN THE FILE. 06120413 |
| C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 06130413 |
| C 06140413 |
| C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 06150413 |
| C 12.2.4.2 (5) AND (6), DIRECT ACCESS 06160413 |
| C 12.8, READ, WRITE AND PRINT STATEMENTS 06170413 |
| C 06180413 |
| C 06190413 |
| IVTNUM = 14 06200413 |
| IF (ICZERO) 30140, 0140, 30140 06210413 |
| 0140 CONTINUE 06220413 |
| IRECN = 13 06230413 |
| IVCORR = 13 06240413 |
| WRITE (I10,REC=13) 06250413 |
| IVCOMP = IRECN 06260413 |
| 40140 IF (IVCOMP - 13) 20140, 10140, 20140 06270413 |
| 30140 IVDELE = IVDELE + 1 06280413 |
| WRITE (I02,80000) IVTNUM 06290413 |
| IF (ICZERO) 10140, 0151, 20140 06300413 |
| 10140 IVPASS = IVPASS + 1 06310413 |
| WRITE (I02,80002) IVTNUM 06320413 |
| GO TO 0151 06330413 |
| 20140 IVFAIL = IVFAIL + 1 06340413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06350413 |
| 0151 CONTINUE 06360413 |
| C 06370413 |
| C **** FCVS PROGRAM 413 - TEST 015 **** 06380413 |
| C 06390413 |
| C 06400413 |
| C TEST 015 IS SIMILAR TO TEST 014 ABOVE EXCEPT THE RN OF THE 06410413 |
| C RECORD SPECIFIER (REC = RN) IS AN INTEGER VARIABLE. 06420413 |
| C 06430413 |
| C 06440413 |
| IVTNUM = 15 06450413 |
| IF (ICZERO) 30150, 0150, 30150 06460413 |
| 0150 CONTINUE 06470413 |
| IRECN = 14 06480413 |
| IVCORR = 14 06490413 |
| IREC = 14 06500413 |
| WRITE (I10,REC = IREC) 06510413 |
| IVCOMP = IRECN 06520413 |
| 40150 IF (IVCOMP - 14) 20150, 10150, 20150 06530413 |
| 30150 IVDELE = IVDELE + 1 06540413 |
| WRITE (I02,80000) IVTNUM 06550413 |
| IF (ICZERO) 10150, 0161, 20150 06560413 |
| 10150 IVPASS = IVPASS + 1 06570413 |
| WRITE (I02,80002) IVTNUM 06580413 |
| GO TO 0161 06590413 |
| 20150 IVFAIL = IVFAIL + 1 06600413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06610413 |
| 0161 CONTINUE 06620413 |
| C 06630413 |
| C 06640413 |
| C TESTS 16 AND 17 VERIFY THAT RECORDS MAY BE CREATED IN 06650413 |
| C OTHER THAN SEQUENTIAL ORDER. ALSO THAT A VARIABLE MAY BY USED 06660413 |
| C AS THE OPERAND OF THE REC SPECIFIER FOR A WRITE STATEMENT. 06670413 |
| C 06680413 |
| C 06690413 |
| C 06700413 |
| C **** FCVS PROGRAM 413 - TEST 016 **** 06710413 |
| C 06720413 |
| C 06730413 |
| C TEST 016 TESTS USE OF THE REC SPECIFIER WHERE THE OPERAND 06740413 |
| C IS A VARIABLE. THIS TEST IS SIMILAR TO TEST 15 EXCEPT THE WRITE 06750413 |
| C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE 06760413 |
| C WRITTEN BY INCREMENTING THE VARIABLE BY 2 FOR EACH WRITE. TEST 06770413 |
| C 032 READS THE RECORDS WRITTEN BY THIS METHOD. 06780413 |
| C 06790413 |
| C 06800413 |
| IVTNUM = 16 06810413 |
| IF (ICZERO) 30160, 0160, 30160 06820413 |
| 0160 CONTINUE 06830413 |
| IRECN = 13 06840413 |
| IREC = 13 06850413 |
| DO 4132 I = 1,100 06860413 |
| IREC = IREC + 2 06870413 |
| IRECN = IRECN + 2 06880413 |
| WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 06890413 |
| 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 06900413 |
| 4132 CONTINUE 06910413 |
| IVCORR = 100 06920413 |
| IVCOMP = IREC - 113 06930413 |
| 40160 IF (IVCOMP - 100) 20160, 10160, 20160 06940413 |
| 30160 IVDELE = IVDELE + 1 06950413 |
| WRITE (I02,80000) IVTNUM 06960413 |
| IF (ICZERO) 10160, 0171, 20160 06970413 |
| 10160 IVPASS = IVPASS + 1 06980413 |
| WRITE (I02,80002) IVTNUM 06990413 |
| GO TO 0171 07000413 |
| 20160 IVFAIL = IVFAIL + 1 07010413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07020413 |
| 0171 CONTINUE 07030413 |
| C 07040413 |
| C **** FCVS PROGRAM 413 - TEST 017 **** 07050413 |
| C 07060413 |
| C 07070413 |
| C TEST 17 IS SIMILAR TO TEST 16 EXCEPT THE RECORD IS 07080413 |
| C WRITTEN IN REVERSE ORDER OF RECORD NUMBER. ONE HUNDERD RECORDS 07090413 |
| C ARE WRITTEN AND THE VARIABLE OF THE REC SPECIFIER IS DECREMENTED 07100413 |
| C BY TWO FOR EACH WRITE. 07110413 |
| C 07120413 |
| C 07130413 |
| IVTNUM = 17 07140413 |
| IF (ICZERO) 30170, 0170, 30170 07150413 |
| 0170 CONTINUE 07160413 |
| IRECN = 216 07170413 |
| IREC = 216 07180413 |
| IVCOMP = 0 07190413 |
| DO 4133 I=1,100 07200413 |
| IREC = IREC - 2 07210413 |
| IRECN = IRECN - 2 07220413 |
| WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07230413 |
| 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 07240413 |
| IVCOMP = IVCOMP + 1 07250413 |
| 4133 CONTINUE 07260413 |
| IVCORR = 100 07270413 |
| 40170 IF (IVCOMP - 100) 20170, 10170, 20170 07280413 |
| 30170 IVDELE = IVDELE + 1 07290413 |
| WRITE (I02,80000) IVTNUM 07300413 |
| IF (ICZERO) 10170, 0181, 20170 07310413 |
| 10170 IVPASS = IVPASS + 1 07320413 |
| WRITE (I02,80002) IVTNUM 07330413 |
| GO TO 0181 07340413 |
| 20170 IVFAIL = IVFAIL + 1 07350413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07360413 |
| 0181 CONTINUE 07370413 |
| C 07380413 |
| C 07390413 |
| C TESTS 018 THROUGH 030 READ AND CHECK THE RECORDS CREATED IN 07400413 |
| C TESTS 002 THROUGH 014. EACH OF THE TESTS IN THIS SET IS CHECKING 07410413 |
| C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED 07420413 |
| C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 002 07430413 |
| C THROUGH 013 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. 07440413 |
| C THE READ STATEMENT IS USED WITH THE I/O LIST ITEM AS A VARIABLE, 07450413 |
| C AN ARRAY ELEMENT AND AN ARRAY. 07460413 |
| C 07470413 |
| C 07480413 |
| C 07490413 |
| C **** FCVS PROGRAM 413 - TEST 018 **** 07500413 |
| C 07510413 |
| C 07520413 |
| C TEST 018 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07530413 |
| C VARIABLE OF INTEGER TYPE. 07540413 |
| C 07550413 |
| C 07560413 |
| IVTNUM = 18 07570413 |
| IF (ICZERO) 30180, 0180, 30180 07580413 |
| 0180 CONTINUE 07590413 |
| IVON22 = 0 07600413 |
| IVON56 = 0 07610413 |
| IVCORR = 30 07620413 |
| IVCOMP = 1 07630413 |
| READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07640413 |
| 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 07650413 |
| IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 07660413 |
| IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3 07670413 |
| IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5 07680413 |
| 40180 IF (IVCOMP - 30) 20180, 10180, 20180 07690413 |
| 30180 IVDELE = IVDELE + 1 07700413 |
| WRITE (I02,80000) IVTNUM 07710413 |
| IF (ICZERO) 10180, 0191, 20180 07720413 |
| 10180 IVPASS = IVPASS + 1 07730413 |
| WRITE (I02,80002) IVTNUM 07740413 |
| GO TO 0191 07750413 |
| 20180 IVFAIL = IVFAIL + 1 07760413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07770413 |
| 0191 CONTINUE 07780413 |
| C 07790413 |
| C **** FCVS PROGRAM 413 - TEST 019 **** 07800413 |
| C 07810413 |
| C 07820413 |
| C TEST 019 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07830413 |
| C VARIABLE OF REAL TYPE. 07840413 |
| C 07850413 |
| C 07860413 |
| IVTNUM = 19 07870413 |
| IF (ICZERO) 30190, 0190, 30190 07880413 |
| 0190 CONTINUE 07890413 |
| RVON22 = 0.0 07900413 |
| RVON31 = 0.0 07910413 |
| IVCORR = 30 07920413 |
| IVCOMP = 1 07930413 |
| READ (I10, REC = 02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07940413 |
| 1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56 07950413 |
| IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2 07960413 |
| IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3 07970413 |
| IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5 07980413 |
| 40190 IF (IVCOMP - 30) 20190, 10190, 20190 07990413 |
| 30190 IVDELE = IVDELE + 1 08000413 |
| WRITE (I02,80000) IVTNUM 08010413 |
| IF (ICZERO) 10190, 0201, 20190 08020413 |
| 10190 IVPASS = IVPASS + 1 08030413 |
| WRITE (I02,80002) IVTNUM 08040413 |
| GO TO 0201 08050413 |
| 20190 IVFAIL = IVFAIL + 1 08060413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08070413 |
| 0201 CONTINUE 08080413 |
| C 08090413 |
| C **** FCVS PROGRAM 413 - TEST 020 **** 08100413 |
| C 08110413 |
| C 08120413 |
| C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08130413 |
| C VARIABLE OF LOGICAL TYPE. 08140413 |
| C 08150413 |
| C 08160413 |
| IVTNUM = 20 08170413 |
| IF (ICZERO) 30200, 0200, 30200 08180413 |
| 0200 CONTINUE 08190413 |
| LVONT1 = .FALSE. 08200413 |
| LVONF6 = .TRUE. 08210413 |
| IVCORR = 30 08220413 |
| IVCOMP = 1 08230413 |
| READ (I10, REC = 03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08240413 |
| 1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF808250413 |
| IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2 08260413 |
| IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3 08270413 |
| IF (LVONT1) IVCOMP = IVCOMP * 5 08280413 |
| 40200 IF (IVCOMP - 30) 20200, 10200, 20200 08290413 |
| 30200 IVDELE = IVDELE + 1 08300413 |
| WRITE (I02,80000) IVTNUM 08310413 |
| IF (ICZERO) 10200, 0211, 20200 08320413 |
| 10200 IVPASS = IVPASS + 1 08330413 |
| WRITE (I02,80002) IVTNUM 08340413 |
| GO TO 0211 08350413 |
| 20200 IVFAIL = IVFAIL + 1 08360413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08370413 |
| 0211 CONTINUE 08380413 |
| C 08390413 |
| C **** FCVS PROGRAM 413 - TEST 021 **** 08400413 |
| C 08410413 |
| C 08420413 |
| C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08430413 |
| C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE 08440413 |
| C DIMENSION ARRAYS ARE USED. 08450413 |
| C 08460413 |
| C 08470413 |
| IVTNUM = 21 08480413 |
| IF (ICZERO) 30210, 0210, 30210 08490413 |
| 0210 CONTINUE 08500413 |
| IAON12(2) = 0 08510413 |
| IAON12(8) = 0 08520413 |
| IVCORR = 30 08530413 |
| IVCOMP = 1 08540413 |
| READ (I10, REC = 04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08550413 |
| 1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2), 08560413 |
| 2 IAON32(2,1,2), IAON12(7), IAON12(8) 08570413 |
| IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2 08580413 |
| IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3 08590413 |
| IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5 08600413 |
| C 08610413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08620413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 08630413 |
| C 08640413 |
| 40210 IF (IVCOMP - 30) 20210, 10210, 20210 08650413 |
| 30210 IVDELE = IVDELE + 1 08660413 |
| WRITE (I02,80000) IVTNUM 08670413 |
| IF (ICZERO) 10210, 0221, 20210 08680413 |
| 10210 IVPASS = IVPASS + 1 08690413 |
| WRITE (I02,80002) IVTNUM 08700413 |
| GO TO 0221 08710413 |
| 20210 IVFAIL = IVFAIL + 1 08720413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08730413 |
| 0221 CONTINUE 08740413 |
| C 08750413 |
| C **** FCVS PROGRAM 413 - TEST 022 **** 08760413 |
| C 08770413 |
| C 08780413 |
| C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08790413 |
| C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE 08800413 |
| C DIMENSION ARRAYS ARE USED. 08810413 |
| C 08820413 |
| C 08830413 |
| IVTNUM = 22 08840413 |
| IF (ICZERO) 30220, 0220, 30220 08850413 |
| 0220 CONTINUE 08860413 |
| RAON22(2,2) = 0.0 08870413 |
| RAON32(1,1,2) = 0.0 08880413 |
| IVCORR = 30 08890413 |
| IVCOMP = 1 08900413 |
| READ (I10, REC = 05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08910413 |
| 1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2), 08920413 |
| 2 RAON32(2,1,2), RAON12(7), RAON12(8) 08930413 |
| IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2 08940413 |
| IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3 08950413 |
| IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5 08960413 |
| C 08970413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08980413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 08990413 |
| C 09000413 |
| 40220 IF (IVCOMP - 30) 20220, 10220, 20220 09010413 |
| 30220 IVDELE = IVDELE + 1 09020413 |
| WRITE (I02,80000) IVTNUM 09030413 |
| IF (ICZERO) 10220, 0231, 20220 09040413 |
| 10220 IVPASS = IVPASS + 1 09050413 |
| WRITE (I02,80002) IVTNUM 09060413 |
| GO TO 0231 09070413 |
| 20220 IVFAIL = IVFAIL + 1 09080413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09090413 |
| 0231 CONTINUE 09100413 |
| C 09110413 |
| C **** FCVS PROGRAM 413 - TEST 023 **** 09120413 |
| C 09130413 |
| C 09140413 |
| C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09150413 |
| C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE 09160413 |
| C DIMENSION ARRAYS ARE USED. 09170413 |
| C 09180413 |
| C 09190413 |
| IVTNUM = 23 09200413 |
| IF (ICZERO) 30230, 0230, 30230 09210413 |
| 0230 CONTINUE 09220413 |
| LAON12(1) = .FALSE. 09230413 |
| LAON32(2,1,2) = .TRUE. 09240413 |
| IVCORR = 30 09250413 |
| IVCOMP = 1 09260413 |
| READ (I10, REC = 06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09270413 |
| 1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2), 09280413 |
| 2 LAON32(2,1,2), LAON12(7), LAON12(8) 09290413 |
| IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2 09300413 |
| IF (LAON12(1)) IVCOMP = IVCOMP * 3 09310413 |
| IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5 09320413 |
| 40230 IF (IVCOMP - 30) 20230, 10230, 20230 09330413 |
| 30230 IVDELE = IVDELE + 1 09340413 |
| WRITE (I02,80000) IVTNUM 09350413 |
| IF (ICZERO) 10230, 0241, 20230 09360413 |
| 10230 IVPASS = IVPASS + 1 09370413 |
| WRITE (I02,80002) IVTNUM 09380413 |
| GO TO 0241 09390413 |
| 20230 IVFAIL = IVFAIL + 1 09400413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09410413 |
| 0241 CONTINUE 09420413 |
| C 09430413 |
| C **** FCVS PROGRAM 413 - TEST 024 **** 09440413 |
| C 09450413 |
| C 09460413 |
| C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09470413 |
| C ARRAY OF INTEGER TYPE. 09480413 |
| C 09490413 |
| C 09500413 |
| IVTNUM = 24 09510413 |
| IF (ICZERO) 30240, 0240, 30240 09520413 |
| 0240 CONTINUE 09530413 |
| IAON32(2,1,1) = 0 09540413 |
| IAON32(2,2,2) = 0 09550413 |
| IVCORR = 30 09560413 |
| IVCOMP = 1 09570413 |
| READ (I10, REC = 07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09580413 |
| 1 IAON32 09590413 |
| IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2 09600413 |
| IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3 09610413 |
| IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5 09620413 |
| C 09630413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09640413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 09650413 |
| C 09660413 |
| 40240 IF (IVCOMP - 30) 20240, 10240, 20240 09670413 |
| 30240 IVDELE = IVDELE + 1 09680413 |
| WRITE (I02,80000) IVTNUM 09690413 |
| IF (ICZERO) 10240, 0251, 20240 09700413 |
| 10240 IVPASS = IVPASS + 1 09710413 |
| WRITE (I02,80002) IVTNUM 09720413 |
| GO TO 0251 09730413 |
| 20240 IVFAIL = IVFAIL + 1 09740413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09750413 |
| 0251 CONTINUE 09760413 |
| C 09770413 |
| C **** FCVS PROGRAM 413 - TEST 025 **** 09780413 |
| C 09790413 |
| C 09800413 |
| C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09810413 |
| C ARRAY OF REAL TYPE. 09820413 |
| C 09830413 |
| C 09840413 |
| IVTNUM = 25 09850413 |
| IF (ICZERO) 30250, 0250, 30250 09860413 |
| 0250 CONTINUE 09870413 |
| RAON32(2,1,1) = 0.0 09880413 |
| RAON32(2,2,2) = 0.0 09890413 |
| IVCORR = 30 09900413 |
| IVCOMP = 1 09910413 |
| READ (I10, REC = 08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09920413 |
| 1 RAON32 09930413 |
| IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2 09940413 |
| IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3 09950413 |
| IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5 09960413 |
| C 09970413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09980413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 09990413 |
| C 10000413 |
| 40250 IF (IVCOMP - 30) 20250, 10250, 20250 10010413 |
| 30250 IVDELE = IVDELE + 1 10020413 |
| WRITE (I02,80000) IVTNUM 10030413 |
| IF (ICZERO) 10250, 0261, 20250 10040413 |
| 10250 IVPASS = IVPASS + 1 10050413 |
| WRITE (I02,80002) IVTNUM 10060413 |
| GO TO 0261 10070413 |
| 20250 IVFAIL = IVFAIL + 1 10080413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10090413 |
| 0261 CONTINUE 10100413 |
| C 10110413 |
| C **** FCVS PROGRAM 413 - TEST 026 **** 10120413 |
| C 10130413 |
| C 10140413 |
| C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10150413 |
| C ARRAY OF LOGICAL TYPE. 10160413 |
| C 10170413 |
| C 10180413 |
| IVTNUM = 26 10190413 |
| IF (ICZERO) 30260, 0260, 30260 10200413 |
| 0260 CONTINUE 10210413 |
| LAON32(1,1,1) = .FALSE. 10220413 |
| LAON32(2,2,2) = .TRUE. 10230413 |
| IVCORR = 30 10240413 |
| IVCOMP = 1 10250413 |
| READ (I10, REC = 09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10260413 |
| 1 LAON32 10270413 |
| IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2 10280413 |
| IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3 10290413 |
| IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5 10300413 |
| 40260 IF (IVCOMP - 30) 20260, 10260, 20260 10310413 |
| 30260 IVDELE = IVDELE + 1 10320413 |
| WRITE (I02,80000) IVTNUM 10330413 |
| IF (ICZERO) 10260, 0271, 20260 10340413 |
| 10260 IVPASS = IVPASS + 1 10350413 |
| WRITE (I02,80002) IVTNUM 10360413 |
| GO TO 0271 10370413 |
| 20260 IVFAIL = IVFAIL + 1 10380413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10390413 |
| 0271 CONTINUE 10400413 |
| C 10410413 |
| C **** FCVS PROGRAM 413 - TEST 027 **** 10420413 |
| C 10430413 |
| C 10440413 |
| C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10450413 |
| C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN 10460413 |
| C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10470413 |
| C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 10480413 |
| C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN 10490413 |
| C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 10500413 |
| C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 10510413 |
| C 10520413 |
| C VALUE 11 777 512 -32767 -11 -777 -512 32767 10530413 |
| C FIELD POS 1 3 2 4 5 7 6 8 10540413 |
| C IAON32 1 2 3 4 5 6 7 8 10550413 |
| 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,210560413 |
| C 10570413 |
| C 10580413 |
| IVTNUM = 27 10590413 |
| IF (ICZERO) 30270, 0270, 30270 10600413 |
| 0270 CONTINUE 10610413 |
| IAON32(2,1,1) = 0 10620413 |
| IAON32(2,2,1) = 0 10630413 |
| IVCORR = 30 10640413 |
| IVCOMP = 1 10650413 |
| READ (I10, REC = 10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10660413 |
| 1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2) 10670413 |
| IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2 10680413 |
| IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3 10690413 |
| IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5 10700413 |
| C 10710413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 10720413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 10730413 |
| C 10740413 |
| 40270 IF (IVCOMP - 30) 20270, 10270, 20270 10750413 |
| 30270 IVDELE = IVDELE + 1 10760413 |
| WRITE (I02,80000) IVTNUM 10770413 |
| IF (ICZERO) 10270, 0281, 20270 10780413 |
| 10270 IVPASS = IVPASS + 1 10790413 |
| WRITE (I02,80002) IVTNUM 10800413 |
| GO TO 0281 10810413 |
| 20270 IVFAIL = IVFAIL + 1 10820413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10830413 |
| 0281 CONTINUE 10840413 |
| C 10850413 |
| C **** FCVS PROGRAM 413 - TEST 028 **** 10860413 |
| C 10870413 |
| C 10880413 |
| C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10890413 |
| C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN 10900413 |
| C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10910413 |
| C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC- 10920413 |
| C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE. 10930413 |
| C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND10940413 |
| C SUBSCRIPT VALUE AFTER THE THE READ IS 10950413 |
| C 10960413 |
| C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.10970413 |
| C FIELD POS 1 2 3 4 5 6 7 8 10980413 |
| C RAON32 1 2 3 4 5 6 7 8 10990413 |
| 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,211000413 |
| C 11010413 |
| C 11020413 |
| IVTNUM = 28 11030413 |
| IF (ICZERO) 30280, 0280, 30280 11040413 |
| 0280 CONTINUE 11050413 |
| RAON32(1,2,1) = 0.0 11060413 |
| RAON32(1,2,2) = 0.0 11070413 |
| IVCORR = 30 11080413 |
| IVCOMP = 1 11090413 |
| READ (I10, REC = 11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11100413 |
| 1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2) 11110413 |
| IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2 11120413 |
| IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3 11130413 |
| IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5 11140413 |
| C 11150413 |
| C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 11160413 |
| C FIELD VALUE AND A POSITIVE FIELD VALUE. 11170413 |
| C 11180413 |
| 40280 IF (IVCOMP - 30) 20280, 10280, 20280 11190413 |
| 30280 IVDELE = IVDELE + 1 11200413 |
| WRITE (I02,80000) IVTNUM 11210413 |
| IF (ICZERO) 10280, 0291, 20280 11220413 |
| 10280 IVPASS = IVPASS + 1 11230413 |
| WRITE (I02,80002) IVTNUM 11240413 |
| GO TO 0291 11250413 |
| 20280 IVFAIL = IVFAIL + 1 11260413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11270413 |
| 0291 CONTINUE 11280413 |
| C 11290413 |
| C **** FCVS PROGRAM 413 - TEST 029 **** 11300413 |
| C 11310413 |
| C 11320413 |
| C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 11330413 |
| C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN 11340413 |
| C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 11350413 |
| C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 11360413 |
| C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN 11370413 |
| C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 11380413 |
| C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 11390413 |
| C 11400413 |
| C VALUE T T F F T T F F 11410413 |
| C FIELD POS 1 5 3 7 2 6 4 8 11420413 |
| C LAON32 1 2 3 4 5 6 7 8 11430413 |
| 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,211440413 |
| C 11450413 |
| C 11460413 |
| IVTNUM = 29 11470413 |
| IF (ICZERO) 30290, 0290, 30290 11480413 |
| 0290 CONTINUE 11490413 |
| LAON32(1,2,1) = .TRUE. 11500413 |
| LAON32(2,1,1) = .FALSE. 11510413 |
| IVCORR = 30 11520413 |
| IVCOMP = 1 11530413 |
| READ (I10, REC = 12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11540413 |
| 1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2) 11550413 |
| IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2 11560413 |
| IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3 11570413 |
| IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5 11580413 |
| 40290 IF (IVCOMP - 30) 20290, 10290, 20290 11590413 |
| 30290 IVDELE = IVDELE + 1 11600413 |
| WRITE (I02,80000) IVTNUM 11610413 |
| IF (ICZERO) 10290, 0301, 20290 11620413 |
| 10290 IVPASS = IVPASS + 1 11630413 |
| WRITE (I02,80002) IVTNUM 11640413 |
| GO TO 0301 11650413 |
| 20290 IVFAIL = IVFAIL + 1 11660413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11670413 |
| 0301 CONTINUE 11680413 |
| C 11690413 |
| C **** FCVS PROGRAM 413 - TEST 030 **** 11700413 |
| C 11710413 |
| C 11720413 |
| C TEST 030 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS 11730413 |
| C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS 11740413 |
| C RECORD WAS WRITTEN IN TEST 14 AND SHOULD BE RECORD NUMBER 13. 11750413 |
| C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT 11760413 |
| C IS ACCEPTABLE TO THE COMPILER. 11770413 |
| C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 11780413 |
| C 11790413 |
| C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 11800413 |
| C 12.8, READ, WRITE AND PRINT STATEMENTS11810413 |
| C 11820413 |
| C 11830413 |
| IVTNUM = 30 11840413 |
| IF (ICZERO) 30300, 0300, 30300 11850413 |
| 0300 CONTINUE 11860413 |
| IRECN = 13 11870413 |
| IVCORR = 13 11880413 |
| READ (I10, REC = 13) 11890413 |
| IVCOMP = IRECN 11900413 |
| 40300 IF (IVCOMP - 13) 20300, 10300, 20300 11910413 |
| 30300 IVDELE = IVDELE + 1 11920413 |
| WRITE (I02,80000) IVTNUM 11930413 |
| IF (ICZERO) 10300, 0311, 20300 11940413 |
| 10300 IVPASS = IVPASS + 1 11950413 |
| WRITE (I02,80002) IVTNUM 11960413 |
| GO TO 0311 11970413 |
| 20300 IVFAIL = IVFAIL + 1 11980413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11990413 |
| 0311 CONTINUE 12000413 |
| C 12010413 |
| C **** FCVS PROGRAM 413 - TEST 031 **** 12020413 |
| C 12030413 |
| C 12040413 |
| C TEST 031 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES 12050413 |
| C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN 12060413 |
| C THE RECORD. 12070413 |
| C 12080413 |
| C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER 12090413 |
| C 12100413 |
| C 12110413 |
| IVTNUM = 31 12120413 |
| IF (ICZERO) 30310, 0310, 30310 12130413 |
| 0310 CONTINUE 12140413 |
| IVON21 = 0 12150413 |
| IVON22 = 0 12160413 |
| IVON31 = 0 12170413 |
| IVCORR = 0 12180413 |
| IVCOMP = 1 12190413 |
| READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12200413 |
| 1 IVON21, IVON22, IVON31 12210413 |
| IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 12220413 |
| IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 12230413 |
| IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5 12240413 |
| 40310 IF (IVCOMP - 30) 20310, 10310, 20310 12250413 |
| 30310 IVDELE = IVDELE + 1 12260413 |
| WRITE (I02,80000) IVTNUM 12270413 |
| IF (ICZERO) 10310, 0321, 20310 12280413 |
| 10310 IVPASS = IVPASS + 1 12290413 |
| WRITE (I02,80002) IVTNUM 12300413 |
| GO TO 0321 12310413 |
| 20310 IVFAIL = IVFAIL + 1 12320413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12330413 |
| 0321 CONTINUE 12340413 |
| C 12350413 |
| C 12360413 |
| C TEST 032 AND 033 VERIFIES THAT RECORDS MAY BE READ IN ANY ORDER12370413 |
| C ALSO THAT A VARIABLE MAY BE USED AS THE OPERAND OF THE REC SPEC- 12380413 |
| C IFIER FOR A READ STATEMENT. 12390413 |
| C 12400413 |
| C SEE SECTION 2.2.4.2(1) , DIRECT ACCESS 12410413 |
| C 12420413 |
| C 12430413 |
| C 12440413 |
| C **** FCVS PROGRAM 413 - TEST 032 **** 12450413 |
| C 12460413 |
| C 12470413 |
| C TEST 032 READS THE RECORDS WRITTEN IN TEST 16. EVERY OTHER 12480413 |
| C RECORD IS READ FOR A TOTAL OF 100 RECORDS (THE REC SPECIFIER 12490413 |
| C VARIABLE IS INCREMENTED BY 2). 12500413 |
| C 12510413 |
| C 12520413 |
| IVTNUM = 32 12530413 |
| IF (ICZERO) 30320, 0320, 30320 12540413 |
| 0320 CONTINUE 12550413 |
| IRECCK = 13 12560413 |
| IRECN = 0 12570413 |
| IREC = 13 12580413 |
| IVCOMP = 0 12590413 |
| DO 4134 I = 1,100 12600413 |
| IREC = IREC + 2 12610413 |
| IRECCK = IRECCK + 2 12620413 |
| READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12630413 |
| 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12640413 |
| IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12650413 |
| 4134 CONTINUE 12660413 |
| IVCORR = 100 12670413 |
| 40320 IF (IVCOMP - 100) 20320, 10320, 20320 12680413 |
| 30320 IVDELE = IVDELE + 1 12690413 |
| WRITE (I02,80000) IVTNUM 12700413 |
| IF (ICZERO) 10320, 0331, 20320 12710413 |
| 10320 IVPASS = IVPASS + 1 12720413 |
| WRITE (I02,80002) IVTNUM 12730413 |
| GO TO 0331 12740413 |
| 20320 IVFAIL = IVFAIL + 1 12750413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12760413 |
| 0331 CONTINUE 12770413 |
| C 12780413 |
| C **** FCVS PROGRAM 413 - TEST 033 **** 12790413 |
| C 12800413 |
| C 12810413 |
| C TEST 033 READS THE RECORDS WRITTEN IN TEST 17. THIS TEST IS 12820413 |
| C SIMILAR TO TEST 32 ABOVE EXCEPT THE FILE IS READ IN REVERSE 12830413 |
| C RECORD NUMBER ORDER. 12840413 |
| C 12850413 |
| C 12860413 |
| IVTNUM = 33 12870413 |
| IF (ICZERO) 30330, 0330, 30330 12880413 |
| 0330 CONTINUE 12890413 |
| IRECCK = 216 12900413 |
| IRECN = 0 12910413 |
| IVCOMP = 0 12920413 |
| IREC = 216 12930413 |
| DO 4135 I = 1,100 12940413 |
| IREC = IREC - 2 12950413 |
| IRECCK = IRECCK - 2 12960413 |
| READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12970413 |
| 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12980413 |
| IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12990413 |
| 4135 CONTINUE 13000413 |
| IVCORR = 100 13010413 |
| 40330 IF (IVCOMP - 100) 20330, 10330, 20330 13020413 |
| 30330 IVDELE = IVDELE + 1 13030413 |
| WRITE (I02,80000) IVTNUM 13040413 |
| IF (ICZERO) 10330, 0341, 20330 13050413 |
| 10330 IVPASS = IVPASS + 1 13060413 |
| WRITE (I02,80002) IVTNUM 13070413 |
| GO TO 0341 13080413 |
| 20330 IVFAIL = IVFAIL + 1 13090413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13100413 |
| 0341 CONTINUE 13110413 |
| C 13120413 |
| C **** FCVS PROGRAM 413 - TEST 034 **** 13130413 |
| C 13140413 |
| C 13150413 |
| C TEST 034 VERIFIES THAT THE VALUES OF A RECORD MAY BE CHANGED 13160413 |
| C WHEN THE RECORD IS REWRITTEN. RECORD NUMBER 01 IS USED FOR 13170413 |
| C TESTING. THE RECORD WAS WRITTEN IN TEST 02 AND READ IN TEST 18. 13180413 |
| C A RECORD CANNOT BE DELETED FROM THE FILE BUT IT CAN BE REWRITTEN. 13190413 |
| C 13200413 |
| C SEE SECTION 12.2.4.2 (5), DIRECT ACCESS 13210413 |
| C 13220413 |
| C 13230413 |
| IVTNUM = 34 13240413 |
| IF (ICZERO) 30340, 0340, 30340 13250413 |
| 0340 CONTINUE 13260413 |
| IRECN = 01 13270413 |
| WRITE (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13280413 |
| 1 ICON31, ICON32, ICON21, ICON22, ICON55, ICON56, ICON33, ICON3413290413 |
| READ (I10, REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13300413 |
| 1 IVON61, IVON62, IVON63, IVON64, IVON65,IVON66, IVON67, IVON68 13310413 |
| IVCORR = 210 13320413 |
| IVCOMP = 1 13330413 |
| IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 13340413 |
| IF (IVON61 .EQ. 777) IVCOMP = IVCOMP * 3 13350413 |
| IF (IVON62 .EQ. -777) IVCOMP = IVCOMP * 5 13360413 |
| IF (IVON66 .EQ. 32767) IVCOMP = IVCOMP * 7 13370413 |
| 40340 IF (IVCOMP - 210) 20340, 10340, 20340 13380413 |
| 30340 IVDELE = IVDELE + 1 13390413 |
| WRITE (I02,80000) IVTNUM 13400413 |
| IF (ICZERO) 10340, 0351, 20340 13410413 |
| 10340 IVPASS = IVPASS + 1 13420413 |
| WRITE (I02,80002) IVTNUM 13430413 |
| GO TO 0351 13440413 |
| 20340 IVFAIL = IVFAIL + 1 13450413 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13460413 |
| 0351 CONTINUE 13470413 |
| C 13480413 |
| C 13490413 |
| C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 13500413 |
| C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 13510413 |
| C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 13520413 |
| C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED13530413 |
| C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 13540413 |
| C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 13550413 |
| C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 13560413 |
| C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 13570413 |
| C REPORT AND BEFORE THE TEST REPORT SUMMARY. 13580413 |
| C 13590413 |
| CDB** BEGIN FILE DUMP CODE 13600413 |
| C ITOTR = 214 13610413 |
| C ILUN = I10 13620413 |
| C IRLGN = 80 13630413 |
| C IRNUM = 1 13640413 |
| C7701 FORMAT (80A1) 13650413 |
| C7702 FORMAT (1X,80A1) 13660413 |
| C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 13670413 |
| C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " ,I13680413 |
| C 13,9H RECORDS.) 13690413 |
| C DO 7771 IRNUM = 1, ITOTR 13700413 |
| C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN) 13710413 |
| C WRITE (I02, 7702) (IDUMP(ICH), ICH = 1, IRLGN) 13720413 |
| C7771 CONTINUE 13730413 |
| CDE** END OF DUMP CODE 13740413 |
| C TEST 034 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD13750413 |
| C HAVE MADE 34 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR 13760413 |
| C DIRECT ACCESS 13770413 |
| C 13780413 |
| C 13790413 |
| C 13800413 |
| C WRITE OUT TEST SUMMARY 13810413 |
| C 13820413 |
| WRITE (I02,90004) 13830413 |
| WRITE (I02,90014) 13840413 |
| WRITE (I02,90004) 13850413 |
| WRITE (I02,90000) 13860413 |
| WRITE (I02,90004) 13870413 |
| WRITE (I02,90020) IVFAIL 13880413 |
| WRITE (I02,90022) IVPASS 13890413 |
| WRITE (I02,90024) IVDELE 13900413 |
| STOP 13910413 |
| 90001 FORMAT (" ",24X,"FM413") 13920413 |
| 90000 FORMAT (" ",20X,"END OF PROGRAM FM413" ) 13930413 |
| C 13940413 |
| C FORMATS FOR TEST DETAIL LINES 13950413 |
| C 13960413 |
| 80000 FORMAT (" ",4X,I5,6X,"DELETED") 13970413 |
| 80002 FORMAT (" ",4X,I5,7X,"PASS") 13980413 |
| 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 13990413 |
| 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 14000413 |
| 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 14010413 |
| C 14020413 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 14030413 |
| C 14040413 |
| 90002 FORMAT ("1") 14050413 |
| 90004 FORMAT (" ") 14060413 |
| 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 14070413 |
| 90008 FORMAT (" ",21X,"VERSION 2.1" ) 14080413 |
| 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 14090413 |
| 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 14100413 |
| 90014 FORMAT (" ",5X,"----------------------------------------------" ) 14110413 |
| 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 14120413 |
| C 14130413 |
| C FORMAT STATEMENTS FOR RUN SUMMARY 14140413 |
| C 14150413 |
| 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 14160413 |
| 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 14170413 |
| 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 14180413 |
| END 14190413 |
