| PROGRAM FM300 00010300 |
| C 00020300 |
| C 00030300 |
| C THIS ROUTINE TESTS THE USE OF THE EQUIVALENCE STATEMENT TO 00040300 |
| C EQUATE STORAGE UNITS OF VARIABLES, ARRAYS AND ARRAY ELEMENTS. 00050300 |
| C ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA TYPES ARE TESTED. 00060300 |
| C NO ATTEMPT IS MADE TO TEST DATA OF DIFFERENT TYPES THAT ARE 00070300 |
| C EQUATED WITH THE EQUIVALENCE STATEMENT. 00080300 |
| C 00090300 |
| C REFERENCES. 00100300 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110300 |
| C X3.9-1978 00120300 |
| C 00130300 |
| C SECTION 8.1, DIMENSION STATEMENT 00140300 |
| C SECTION 8.2, EQUIVALENCE STATEMENT 00150300 |
| C SECTION 9, DATA STATEMENT 00160300 |
| C 00170300 |
| C 00180300 |
| C ******************************************************************00190300 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200300 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210300 |
| C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220300 |
| C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230300 |
| C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240300 |
| C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250300 |
| C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260300 |
| C THE RESULT OF EXECUTING THESE TESTS. 00270300 |
| C 00280300 |
| C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290300 |
| C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300300 |
| C 00310300 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320300 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00330300 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00340300 |
| C BUILDING 225 RM A266 00350300 |
| C GAITHERSBURG, MD 20899 00360300 |
| C ******************************************************************00370300 |
| C 00380300 |
| C 00390300 |
| IMPLICIT LOGICAL (L) 00400300 |
| IMPLICIT CHARACTER*14 (C) 00410300 |
| C 00420300 |
| 00430300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00440300 |
| C 00450300 |
| EQUIVALENCE (IVOE01, IVOE02) 00460300 |
| C 00470300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00480300 |
| C 00490300 |
| EQUIVALENCE (RVOE01, RVOE02) 00500300 |
| C 00510300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00520300 |
| C 00530300 |
| EQUIVALENCE (LVOE01, LVOE02) 00540300 |
| C 00550300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00560300 |
| C 00570300 |
| CHARACTER CVTE01*3, CVTE02*3, CVCOMP*3 00580300 |
| EQUIVALENCE (CVTE01, CVTE02) 00590300 |
| C 00600300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00610300 |
| C 00620300 |
| EQUIVALENCE (IVOE03, IVOE04, IVOE05) 00630300 |
| C 00640300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00650300 |
| C 00660300 |
| EQUIVALENCE (IVOE06, IVOE07, RVOE03) 00670300 |
| C 00680300 |
| C *** SPECIFICATION STATEMENTS FOR TESTS 007 AND 008 *** 00690300 |
| C 00700300 |
| EQUIVALENCE (IVOE08, IVOE09), (IVOE10, IVOE11) 00710300 |
| C 00720300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 009 *** 00730300 |
| C 00740300 |
| EQUIVALENCE (IVOE12, IVOE13), (IVOE13, IVOE14) 00750300 |
| C 00760300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 010 *** 00770300 |
| C 00780300 |
| EQUIVALENCE (IVOE15, IVOE16) 00790300 |
| EQUIVALENCE (IVOE16, IVOE17) 00800300 |
| C 00810300 |
| C *** SPECIFICATION STATEMENTS FOR TESTS 011 AND 012 *** 00820300 |
| C 00830300 |
| DIMENSION IADE11(2), IADE12(3) 00840300 |
| EQUIVALENCE (IADE11, IADE12) 00850300 |
| C 00860300 |
| C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 00870300 |
| C 00880300 |
| DIMENSION RADE11(5), RADE12(5) 00890300 |
| EQUIVALENCE (RADE11(4), RADE12(2)) 00900300 |
| C 00910300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 00920300 |
| C 00930300 |
| DIMENSION IADE13(4), IADE14(4) 00940300 |
| EQUIVALENCE (IADE13, IADE14(3)) 00950300 |
| C 00960300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 00970300 |
| C 00980300 |
| DIMENSION IADE15(3) 00990300 |
| EQUIVALENCE (IADE15(2), IVOE18) 01000300 |
| C 01010300 |
| C *** SPECIFICATION STATEMENTS FOR TESTS 017 AND 018 *** 01020300 |
| C 01030300 |
| DIMENSION IADE21(2,2), IADE16(4) 01040300 |
| EQUIVALENCE (IADE21, IADE16) 01050300 |
| C 01060300 |
| C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01070300 |
| C 01080300 |
| EQUIVALENCE (IVOE19, IVOE20) 01090300 |
| DATA IVOE19/19/ 01100300 |
| C 01110300 |
| C 01120300 |
| C 01130300 |
| C INITIALIZATION SECTION. 01140300 |
| C 01150300 |
| C INITIALIZE CONSTANTS 01160300 |
| C ******************** 01170300 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01180300 |
| I01 = 5 01190300 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01200300 |
| I02 = 6 01210300 |
| C SYSTEM ENVIRONMENT SECTION 01220300 |
| C 01230300 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01240300 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01250300 |
| C (UNIT NUMBER FOR CARD READER). 01260300 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01270300 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01280300 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01290300 |
| C 01300300 |
| CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01310300 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01320300 |
| C (UNIT NUMBER FOR PRINTER). 01330300 |
| CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01340300 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350300 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01360300 |
| C 01370300 |
| IVPASS = 0 01380300 |
| IVFAIL = 0 01390300 |
| IVDELE = 0 01400300 |
| ICZERO = 0 01410300 |
| C 01420300 |
| C WRITE OUT PAGE HEADERS 01430300 |
| C 01440300 |
| WRITE (I02,90002) 01450300 |
| WRITE (I02,90006) 01460300 |
| WRITE (I02,90008) 01470300 |
| WRITE (I02,90004) 01480300 |
| WRITE (I02,90010) 01490300 |
| WRITE (I02,90004) 01500300 |
| WRITE (I02,90016) 01510300 |
| WRITE (I02,90001) 01520300 |
| WRITE (I02,90004) 01530300 |
| WRITE (I02,90012) 01540300 |
| WRITE (I02,90014) 01550300 |
| WRITE (I02,90004) 01560300 |
| C 01570300 |
| C 01580300 |
| C **** FCVS PROGRAM 300 - TEST 001 **** 01590300 |
| C 01600300 |
| C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES. 01610300 |
| C 01620300 |
| C 01630300 |
| IVTNUM = 1 01640300 |
| IF (ICZERO) 30010, 0010, 30010 01650300 |
| 0010 CONTINUE 01660300 |
| IVCOMP = 0 01670300 |
| IVOE01 = 5 01680300 |
| IVOE02 = 7 01690300 |
| IVCORR = 7 01700300 |
| IVCOMP = IVOE01 01710300 |
| 40010 IF (IVCOMP - 7) 20010,10010,20010 01720300 |
| 30010 IVDELE = IVDELE + 1 01730300 |
| WRITE (I02,80000) IVTNUM 01740300 |
| IF (ICZERO) 10010, 0021, 20010 01750300 |
| 10010 IVPASS = IVPASS + 1 01760300 |
| WRITE (I02,80002) IVTNUM 01770300 |
| GO TO 0021 01780300 |
| 20010 IVFAIL = IVFAIL + 1 01790300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800300 |
| 0021 CONTINUE 01810300 |
| C 01820300 |
| C **** FCVS PROGRAM 300 - TEST 002 **** 01830300 |
| C 01840300 |
| C THIS IS A TEST FOR EQUATING TWO REAL VARIABLES. 01850300 |
| C 01860300 |
| C 01870300 |
| IVTNUM = 2 01880300 |
| IF (ICZERO) 30020, 0020, 30020 01890300 |
| 0020 CONTINUE 01900300 |
| RVCOMP = 0.0 01910300 |
| RVOE01 = 4.5 01920300 |
| RVOE02 = 1.2 01930300 |
| RVCORR = 1.2 01940300 |
| RVCOMP = RVOE01 01950300 |
| 40020 IF (RVCOMP - 1.1995) 20020,10020,40021 01960300 |
| 40021 IF (RVCOMP - 1.2005) 10020,10020,20020 01970300 |
| 30020 IVDELE = IVDELE + 1 01980300 |
| WRITE (I02,80000) IVTNUM 01990300 |
| IF (ICZERO) 10020, 0031, 20020 02000300 |
| 10020 IVPASS = IVPASS + 1 02010300 |
| WRITE (I02,80002) IVTNUM 02020300 |
| GO TO 0031 02030300 |
| 20020 IVFAIL = IVFAIL + 1 02040300 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02050300 |
| 0031 CONTINUE 02060300 |
| C 02070300 |
| C **** FCVS PROGRAM 300 - TEST 003 **** 02080300 |
| C 02090300 |
| C THIS IS A TEST FOR EQUATING TWO LOGICAL VARIABLES. 02100300 |
| C 02110300 |
| C 02120300 |
| IVTNUM = 3 02130300 |
| IF (ICZERO) 30030, 0030, 30030 02140300 |
| 0030 CONTINUE 02150300 |
| LVOE01 = .TRUE. 02160300 |
| LVOE02 = .FALSE. 02170300 |
| IVCORR = 0 02180300 |
| IVCOMP = 0 02190300 |
| IF (LVOE01) IVCOMP = 1 02200300 |
| 40030 IF (IVCOMP) 20030,10030,20030 02210300 |
| 30030 IVDELE = IVDELE + 1 02220300 |
| WRITE (I02,80000) IVTNUM 02230300 |
| IF (ICZERO) 10030, 0041, 20030 02240300 |
| 10030 IVPASS = IVPASS + 1 02250300 |
| WRITE (I02,80002) IVTNUM 02260300 |
| GO TO 0041 02270300 |
| 20030 IVFAIL = IVFAIL + 1 02280300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02290300 |
| 0041 CONTINUE 02300300 |
| C 02310300 |
| C **** FCVS PROGRAM 300 - TEST 004 **** 02320300 |
| C 02330300 |
| C THIS IS A TEST FOR EQUATING TWO CHARACTER VARIABLES. 02340300 |
| C 02350300 |
| C 02360300 |
| IVTNUM = 4 02370300 |
| IF (ICZERO) 30040, 0040, 30040 02380300 |
| 0040 CONTINUE 02390300 |
| CVCOMP = ' ' 02400300 |
| CVTE01 = 'ABC' 02410300 |
| CVTE02 = 'DEF' 02420300 |
| CVCORR = 'DEF' 02430300 |
| CVCOMP = CVTE01 02440300 |
| 40040 IF (CVCOMP .EQ. 'DEF') GO TO 10040 02450300 |
| 40041 GO TO 20040 02460300 |
| 30040 IVDELE = IVDELE + 1 02470300 |
| WRITE (I02,80000) IVTNUM 02480300 |
| IF (ICZERO) 10040, 0051, 20040 02490300 |
| 10040 IVPASS = IVPASS + 1 02500300 |
| WRITE (I02,80002) IVTNUM 02510300 |
| GO TO 0051 02520300 |
| 20040 IVFAIL = IVFAIL + 1 02530300 |
| WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02540300 |
| 0051 CONTINUE 02550300 |
| C 02560300 |
| C **** FCVS PROGRAM 300 - TEST 005 **** 02570300 |
| C 02580300 |
| C THIS IS A TEST FOR EQUATING THREE INTEGER VARIABLES. 02590300 |
| C 02600300 |
| C 02610300 |
| IVTNUM = 5 02620300 |
| IF (ICZERO) 30050, 0050, 30050 02630300 |
| 0050 CONTINUE 02640300 |
| IVCOMP = 0 02650300 |
| IVOE03 = 3 02660300 |
| IVOE04 = 4 02670300 |
| IVOE05 = 5 02680300 |
| IVCORR = 5 02690300 |
| IVCOMP = IVOE03 02700300 |
| 40050 IF (IVCOMP - 5) 20050,40051,20050 02710300 |
| 40051 IVCOMP = IVOE04 02720300 |
| 40052 IF (IVCOMP - 5) 20050,10050,20050 02730300 |
| 30050 IVDELE = IVDELE + 1 02740300 |
| WRITE (I02,80000) IVTNUM 02750300 |
| IF (ICZERO) 10050, 0061, 20050 02760300 |
| 10050 IVPASS = IVPASS + 1 02770300 |
| WRITE (I02,80002) IVTNUM 02780300 |
| GO TO 0061 02790300 |
| 20050 IVFAIL = IVFAIL + 1 02800300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02810300 |
| 0061 CONTINUE 02820300 |
| C 02830300 |
| C **** FCVS PROGRAM 300 - TEST 006 **** 02840300 |
| C 02850300 |
| C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES AND ONE 02860300 |
| C REAL VARIABLE WITHIN ONE EQUIVALENCE STATEMENT LIST OF NAMES. THE02870300 |
| C VALUE OF THE REAL VARIABLE IS NOT TESTED. 02880300 |
| C 02890300 |
| C 02900300 |
| IVTNUM = 6 02910300 |
| IF (ICZERO) 30060, 0060, 30060 02920300 |
| 0060 CONTINUE 02930300 |
| IVCOMP = 0 02940300 |
| RVOE03 = 3.445 02950300 |
| IVOE06 = 6 02960300 |
| IVOE07 = 7 02970300 |
| IVCORR = 7 02980300 |
| IVCOMP = IVOE06 02990300 |
| 40060 IF (IVCOMP - 7) 20060,10060,20060 03000300 |
| 30060 IVDELE = IVDELE + 1 03010300 |
| WRITE (I02,80000) IVTNUM 03020300 |
| IF (ICZERO) 10060, 0071, 20060 03030300 |
| 10060 IVPASS = IVPASS + 1 03040300 |
| WRITE (I02,80002) IVTNUM 03050300 |
| GO TO 0071 03060300 |
| 20060 IVFAIL = IVFAIL + 1 03070300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03080300 |
| 0071 CONTINUE 03090300 |
| C 03100300 |
| C **** FCVS PROGRAM 300 - TEST 007 **** 03110300 |
| C 03120300 |
| C THIS IS A TEST FOR EQUATING INTEGER VARIABLES USING TWO LISTS 03130300 |
| C OF NAMES IN ONE EQUIVALENCE STATEMENT. NAMES SPECIFIED IN THE 03140300 |
| C FIRST LIST ARE NOT EQUATED TO NAMES IN THE SECOND LIST. THIS 03150300 |
| C TEST CHECKS THE EQUIVALINCE OF THE VARIABLES IN THE FIRST LIST. 03160300 |
| C 03170300 |
| C 03180300 |
| IVTNUM = 7 03190300 |
| IF (ICZERO) 30070, 0070, 30070 03200300 |
| 0070 CONTINUE 03210300 |
| IVCOMP = 0 03220300 |
| IVOE08 = 8 03230300 |
| IVOE09 = 9 03240300 |
| IVOE10 = 10 03250300 |
| IVOE11 = 11 03260300 |
| IVCORR = 9 03270300 |
| IVCOMP = IVOE08 03280300 |
| 40070 IF (IVCOMP - 9) 20070,10070,20070 03290300 |
| 30070 IVDELE = IVDELE + 1 03300300 |
| WRITE (I02,80000) IVTNUM 03310300 |
| IF (ICZERO) 10070, 0081, 20070 03320300 |
| 10070 IVPASS = IVPASS + 1 03330300 |
| WRITE (I02,80002) IVTNUM 03340300 |
| GO TO 0081 03350300 |
| 20070 IVFAIL = IVFAIL + 1 03360300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03370300 |
| 0081 CONTINUE 03380300 |
| C 03390300 |
| C **** FCVS PROGRAM 300 - TEST 008 **** 03400300 |
| C 03410300 |
| C THIS TEST CHECKS THE EQUIVALENCE OF THE VARIABLES IN THE 03420300 |
| C SECOND LIST. 03430300 |
| C 03440300 |
| C 03450300 |
| IVTNUM = 8 03460300 |
| IF (ICZERO) 30080, 0080, 30080 03470300 |
| 0080 CONTINUE 03480300 |
| IVCOMP = 0 03490300 |
| IVCORR = 11 03500300 |
| IVCOMP = IVOE10 03510300 |
| 40080 IF (IVCOMP - 11) 20080,10080,20080 03520300 |
| 30080 IVDELE = IVDELE + 1 03530300 |
| WRITE (I02,80000) IVTNUM 03540300 |
| IF (ICZERO) 10080, 0091, 20080 03550300 |
| 10080 IVPASS = IVPASS + 1 03560300 |
| WRITE (I02,80002) IVTNUM 03570300 |
| GO TO 0091 03580300 |
| 20080 IVFAIL = IVFAIL + 1 03590300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03600300 |
| 0091 CONTINUE 03610300 |
| C 03620300 |
| C **** FCVS PROGRAM 300 - TEST 009 **** 03630300 |
| C 03640300 |
| C THIS IS A TEST FOR EQUATING INTEGER VARIABLES IN ONE LIST 03650300 |
| C WITH INTEGER VARIABLES IN A SECOND LIST OF THE SAME EQUIVALENCE 03660300 |
| C STATEMENT. ALL VARIABLES SHOULD BE EQUATED AND SHARE THE SAME 03670300 |
| C STORAGE UNIT. 03680300 |
| C 03690300 |
| C 03700300 |
| IVTNUM = 9 03710300 |
| IF (ICZERO) 30090, 0090, 30090 03720300 |
| 0090 CONTINUE 03730300 |
| IVCOMP = 0 03740300 |
| IVOE12 = 12 03750300 |
| IVOE13 = 13 03760300 |
| IVOE14 = 14 03770300 |
| IVCORR = 14 03780300 |
| IVCOMP = IVOE13 03790300 |
| 40090 IF (IVCOMP - 14) 20090,40091,20090 03800300 |
| 40091 IVCOMP = IVOE12 03810300 |
| 40092 IF (IVCOMP - 14) 20090,10090,20090 03820300 |
| 30090 IVDELE = IVDELE + 1 03830300 |
| WRITE (I02,80000) IVTNUM 03840300 |
| IF (ICZERO) 10090, 0101, 20090 03850300 |
| 10090 IVPASS = IVPASS + 1 03860300 |
| WRITE (I02,80002) IVTNUM 03870300 |
| GO TO 0101 03880300 |
| 20090 IVFAIL = IVFAIL + 1 03890300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03900300 |
| 0101 CONTINUE 03910300 |
| C 03920300 |
| C **** FCVS PROGRAM 300 - TEST 010 **** 03930300 |
| C 03940300 |
| C THIS IS A TEST FOR EQUATING INTEGER VARIABLES SPECIFIED IN ONE 03950300 |
| C EQUIVALENCE STATEMENT WITH INTEGER VARIABLES SPECIFIED IN A 03960300 |
| C SECOND EQUIVALENCE STATEMENT. ONE VARIABLE IS SPECIFIED IN BOTH 03970300 |
| C STATEMENTS, THEREFORE ALL VARIABLES SHOULD BE EQUATED AND SHARE 03980300 |
| C THE SAME STORAGE UNIT. 03990300 |
| C 04000300 |
| C 04010300 |
| IVTNUM = 10 04020300 |
| IF (ICZERO) 30100, 0100, 30100 04030300 |
| 0100 CONTINUE 04040300 |
| IVCOMP = 0 04050300 |
| IVOE15 = 15 04060300 |
| IVOE16 = 16 04070300 |
| IVOE17 = 17 04080300 |
| IVCORR = 17 04090300 |
| IVCOMP = IVOE16 04100300 |
| 40100 IF (IVCOMP - 17) 20100,40101,20100 04110300 |
| 40101 IVCOMP = IVOE15 04120300 |
| 40102 IF (IVCOMP - 17) 20100,10100,20100 04130300 |
| 30100 IVDELE = IVDELE + 1 04140300 |
| WRITE (I02,80000) IVTNUM 04150300 |
| IF (ICZERO) 10100, 0111, 20100 04160300 |
| 10100 IVPASS = IVPASS + 1 04170300 |
| WRITE (I02,80002) IVTNUM 04180300 |
| GO TO 0111 04190300 |
| 20100 IVFAIL = IVFAIL + 1 04200300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04210300 |
| 0111 CONTINUE 04220300 |
| C 04230300 |
| C **** FCVS PROGRAM 300 - TEST 011 **** 04240300 |
| C 04250300 |
| C THIS IS A TEST FOR EQUATING TWO INTEGER ARRAYS UNQUALIFIED 04260300 |
| C BY A SUBSCRIPT IN THE EQUIVALENCE STATEMENT. ALL ARRAY ELEMENTS 04270300 |
| C SPECIFIED BY THE SAME SUBSCRIPT VALUE, BEGINNING WITH THE FIRST 04280300 |
| C ARRAY ELEMENT, SHOULD BE EQUATED AND SHARE THE SAME STORAGE UNIT. 04290300 |
| C THIS TEST CHECKS THE EQUIVALENCE OF THE FIRST ARRAY ELEMENTS. 04300300 |
| C 04310300 |
| C 04320300 |
| IVTNUM = 11 04330300 |
| IF (ICZERO) 30110, 0110, 30110 04340300 |
| 0110 CONTINUE 04350300 |
| IVCOMP = 0 04360300 |
| IADE11(1) = 111 04370300 |
| IADE11(2) = 112 04380300 |
| IADE12(1) = 121 04390300 |
| IADE12(2) = 122 04400300 |
| IADE12(3) = 123 04410300 |
| IVCORR = 121 04420300 |
| IVCOMP = IADE11(1) 04430300 |
| 40110 IF (IVCOMP - 121) 20110,10110,20110 04440300 |
| 30110 IVDELE = IVDELE + 1 04450300 |
| WRITE (I02,80000) IVTNUM 04460300 |
| IF (ICZERO) 10110, 0121, 20110 04470300 |
| 10110 IVPASS = IVPASS + 1 04480300 |
| WRITE (I02,80002) IVTNUM 04490300 |
| GO TO 0121 04500300 |
| 20110 IVFAIL = IVFAIL + 1 04510300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04520300 |
| 0121 CONTINUE 04530300 |
| C 04540300 |
| C **** FCVS PROGRAM 300 - TEST 012 **** 04550300 |
| C 04560300 |
| C THIS TEST CHECKS THE EQUIVALENCE OF THE SECOND ARRAY ELEMENTS. 04570300 |
| C 04580300 |
| C 04590300 |
| IVTNUM = 12 04600300 |
| IF (ICZERO) 30120, 0120, 30120 04610300 |
| 0120 CONTINUE 04620300 |
| IVCOMP = 0 04630300 |
| IVCORR = 122 04640300 |
| IVCOMP = IADE11(2) 04650300 |
| 40120 IF (IVCOMP - 122) 20120,10120,20120 04660300 |
| 30120 IVDELE = IVDELE + 1 04670300 |
| WRITE (I02,80000) IVTNUM 04680300 |
| IF (ICZERO) 10120, 0131, 20120 04690300 |
| 10120 IVPASS = IVPASS + 1 04700300 |
| WRITE (I02,80002) IVTNUM 04710300 |
| GO TO 0131 04720300 |
| 20120 IVFAIL = IVFAIL + 1 04730300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04740300 |
| 0131 CONTINUE 04750300 |
| C 04760300 |
| C **** FCVS PROGRAM 300 - TEST 013 **** 04770300 |
| C 04780300 |
| C THIS IS A TEST FOR EQUATING TWO REAL ARRAY ELEMENTS. THIS 04790300 |
| C TEST CHECKS THE EQUIVALENCE OF THE TWO ARRAY ELEMENTS SPECIFIED 04800300 |
| C IN THE EQUIVALENCE STATEMENT. 04810300 |
| C 04820300 |
| C 04830300 |
| IVTNUM = 13 04840300 |
| IF (ICZERO) 30130, 0130, 30130 04850300 |
| 0130 CONTINUE 04860300 |
| RVCOMP = 0.0 04870300 |
| RADE11(4) = 11.4 04880300 |
| RADE12(2) = 1.22 04890300 |
| RVCORR = 1.22 04900300 |
| RVCOMP = RADE11(4) 04910300 |
| 40130 IF (RVCOMP - 1.2195) 20130,10130,40131 04920300 |
| 40131 IF (RVCOMP - 1.2205) 10130,10130,20130 04930300 |
| 30130 IVDELE = IVDELE + 1 04940300 |
| WRITE (I02,80000) IVTNUM 04950300 |
| IF (ICZERO) 10130, 0141, 20130 04960300 |
| 10130 IVPASS = IVPASS + 1 04970300 |
| WRITE (I02,80002) IVTNUM 04980300 |
| GO TO 0141 04990300 |
| 20130 IVFAIL = IVFAIL + 1 05000300 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05010300 |
| 0141 CONTINUE 05020300 |
| C 05030300 |
| C **** FCVS PROGRAM 300 - TEST 014 **** 05040300 |
| C 05050300 |
| C THIS TEST CHECKS THE EQUIVALENCE OF THE ARRAY ELEMENTS 05060300 |
| C WITH A SUBSCRIPT VALUE ONE LESS THAN THOSE TESTED IN THE 05070300 |
| C PREVIOUS TEST. THESE ELEMENTS SHOULD BE EQUATED AND SHARE THE 05080300 |
| C SAME STORAGE UNIT DUE TO THE WAY ARRAY ELEMENTS OCCUPY 05090300 |
| C CONSECUTIVE STORAGE UNITS. 05100300 |
| C 05110300 |
| C 05120300 |
| IVTNUM = 14 05130300 |
| IF (ICZERO) 30140, 0140, 30140 05140300 |
| 0140 CONTINUE 05150300 |
| RVCOMP = 0.0 05160300 |
| RADE11(3) = .113 05170300 |
| RADE12(1) = 122. 05180300 |
| RVCORR = 122. 05190300 |
| RVCOMP = RADE11(3) 05200300 |
| 40140 IF (RVCOMP - 121.95) 20140,10140,40141 05210300 |
| 40141 IF (RVCOMP - 122.05) 10140,10140,20140 05220300 |
| 30140 IVDELE = IVDELE + 1 05230300 |
| WRITE (I02,80000) IVTNUM 05240300 |
| IF (ICZERO) 10140, 0151, 20140 05250300 |
| 10140 IVPASS = IVPASS + 1 05260300 |
| WRITE (I02,80002) IVTNUM 05270300 |
| GO TO 0151 05280300 |
| 20140 IVFAIL = IVFAIL + 1 05290300 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300300 |
| 0151 CONTINUE 05310300 |
| C 05320300 |
| C **** FCVS PROGRAM 300 - TEST 015 **** 05330300 |
| C 05340300 |
| C THIS IS A TEST TO EQUATE AN ARRAY NAME TO AN ARRAY ELEMENT 05350300 |
| C NAME. 05360300 |
| C 05370300 |
| C 05380300 |
| IVTNUM = 15 05390300 |
| IF (ICZERO) 30150, 0150, 30150 05400300 |
| 0150 CONTINUE 05410300 |
| IVCOMP = 0 05420300 |
| IADE13(1) = 131 05430300 |
| IADE14(3) = 143 05440300 |
| IVCORR = 143 05450300 |
| IVCOMP = IADE13(1) 05460300 |
| 40150 IF (IVCOMP - 143) 20150,10150,20150 05470300 |
| 30150 IVDELE = IVDELE + 1 05480300 |
| WRITE (I02,80000) IVTNUM 05490300 |
| IF (ICZERO) 10150, 0161, 20150 05500300 |
| 10150 IVPASS = IVPASS + 1 05510300 |
| WRITE (I02,80002) IVTNUM 05520300 |
| GO TO 0161 05530300 |
| 20150 IVFAIL = IVFAIL + 1 05540300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05550300 |
| 0161 CONTINUE 05560300 |
| C 05570300 |
| C **** FCVS PROGRAM 300 - TEST 016 **** 05580300 |
| C 05590300 |
| C THIS IS A TEST TO EQUATE AN ARRAY ELEMENT TO AN INTEGER 05600300 |
| C VARIABLE. 05610300 |
| C 05620300 |
| C 05630300 |
| IVTNUM = 16 05640300 |
| IF (ICZERO) 30160, 0160, 30160 05650300 |
| 0160 CONTINUE 05660300 |
| IVCOMP = 0 05670300 |
| IADE15(2) = 152 05680300 |
| IVOE18 = 18 05690300 |
| IVCORR = 18 05700300 |
| IVCOMP = IADE15(2) 05710300 |
| 40160 IF (IVCOMP - 18) 20160,10160,20160 05720300 |
| 30160 IVDELE = IVDELE + 1 05730300 |
| WRITE (I02,80000) IVTNUM 05740300 |
| IF (ICZERO) 10160, 0171, 20160 05750300 |
| 10160 IVPASS = IVPASS + 1 05760300 |
| WRITE (I02,80002) IVTNUM 05770300 |
| GO TO 0171 05780300 |
| 20160 IVFAIL = IVFAIL + 1 05790300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800300 |
| 0171 CONTINUE 05810300 |
| C 05820300 |
| C **** FCVS PROGRAM 300 - TEST 017 **** 05830300 |
| C 05840300 |
| C THIS IS A TEST TO EQUATE A ONE DIMENSIONAL ARRAY TO A TWO 05850300 |
| C DIMENSIONAL ARRAY. THIS TEST CHECKS THE SECOND ARRAY ELEMENTS. 05860300 |
| C 05870300 |
| C 05880300 |
| IVTNUM = 17 05890300 |
| IF (ICZERO) 30170, 0170, 30170 05900300 |
| 0170 CONTINUE 05910300 |
| IVCOMP = 0 05920300 |
| IADE21(2,1) = 212 05930300 |
| IADE16(2) = 162 05940300 |
| IVCORR = 162 05950300 |
| IVCOMP = IADE21(2,1) 05960300 |
| 40170 IF (IVCOMP - 162) 20170,10170,20170 05970300 |
| 30170 IVDELE = IVDELE + 1 05980300 |
| WRITE (I02,80000) IVTNUM 05990300 |
| IF (ICZERO) 10170, 0181, 20170 06000300 |
| 10170 IVPASS = IVPASS + 1 06010300 |
| WRITE (I02,80002) IVTNUM 06020300 |
| GO TO 0181 06030300 |
| 20170 IVFAIL = IVFAIL + 1 06040300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050300 |
| 0181 CONTINUE 06060300 |
| C 06070300 |
| C **** FCVS PROGRAM 300 - TEST 018 **** 06080300 |
| C 06090300 |
| C THIS TEST CHECKS THE THIRD ARRAY ELEMENTS FROM THE PREVIOUS 06100300 |
| C TEST. 06110300 |
| C 06120300 |
| C 06130300 |
| IVTNUM = 18 06140300 |
| IF (ICZERO) 30180, 0180, 30180 06150300 |
| 0180 CONTINUE 06160300 |
| IVCOMP = 0 06170300 |
| IADE21(1,2) = 2112 06180300 |
| IADE16(3) = 163 06190300 |
| IVCORR = 163 06200300 |
| IVCOMP = IADE21(1,2) 06210300 |
| 40180 IF (IVCOMP - 163) 20180,10180,20180 06220300 |
| 30180 IVDELE = IVDELE + 1 06230300 |
| WRITE (I02,80000) IVTNUM 06240300 |
| IF (ICZERO) 10180, 0191, 20180 06250300 |
| 10180 IVPASS = IVPASS + 1 06260300 |
| WRITE (I02,80002) IVTNUM 06270300 |
| GO TO 0191 06280300 |
| 20180 IVFAIL = IVFAIL + 1 06290300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06300300 |
| 0191 CONTINUE 06310300 |
| C 06320300 |
| C **** FCVS PROGRAM 300 - TEST 019 **** 06330300 |
| C 06340300 |
| C THIS IS A TEST TO EQUATE TWO INTEGER VARIABLES ONE OF WHICH 06350300 |
| C IS INITIALIZED IN A DATA STATEMENT. 06360300 |
| C 06370300 |
| C 06380300 |
| IVTNUM = 19 06390300 |
| IF (ICZERO) 30190, 0190, 30190 06400300 |
| 0190 CONTINUE 06410300 |
| IVCOMP = 0 06420300 |
| IVCORR = 19 06430300 |
| IVCOMP = IVOE20 06440300 |
| 40190 IF (IVCOMP - 19) 20190,10190,20190 06450300 |
| 30190 IVDELE = IVDELE + 1 06460300 |
| WRITE (I02,80000) IVTNUM 06470300 |
| IF (ICZERO) 10190, 0201, 20190 06480300 |
| 10190 IVPASS = IVPASS + 1 06490300 |
| WRITE (I02,80002) IVTNUM 06500300 |
| GO TO 0201 06510300 |
| 20190 IVFAIL = IVFAIL + 1 06520300 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06530300 |
| 0201 CONTINUE 06540300 |
| C 06550300 |
| C 06560300 |
| C WRITE OUT TEST SUMMARY 06570300 |
| C 06580300 |
| WRITE (I02,90004) 06590300 |
| WRITE (I02,90014) 06600300 |
| WRITE (I02,90004) 06610300 |
| WRITE (I02,90000) 06620300 |
| WRITE (I02,90004) 06630300 |
| WRITE (I02,90020) IVFAIL 06640300 |
| WRITE (I02,90022) IVPASS 06650300 |
| WRITE (I02,90024) IVDELE 06660300 |
| STOP 06670300 |
| 90001 FORMAT (" ",24X,"FM300") 06680300 |
| 90000 FORMAT (" ",20X,"END OF PROGRAM FM300" ) 06690300 |
| C 06700300 |
| C FORMATS FOR TEST DETAIL LINES 06710300 |
| C 06720300 |
| 80000 FORMAT (" ",4X,I5,6X,"DELETED") 06730300 |
| 80002 FORMAT (" ",4X,I5,7X,"PASS") 06740300 |
| 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06750300 |
| 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06760300 |
| 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06770300 |
| C 06780300 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 06790300 |
| C 06800300 |
| 90002 FORMAT ("1") 06810300 |
| 90004 FORMAT (" ") 06820300 |
| 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06830300 |
| 90008 FORMAT (" ",21X,"VERSION 2.1" ) 06840300 |
| 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06850300 |
| 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06860300 |
| 90014 FORMAT (" ",5X,"----------------------------------------------" ) 06870300 |
| 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06880300 |
| C 06890300 |
| C FORMAT STATEMENTS FOR RUN SUMMARY 06900300 |
| C 06910300 |
| 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06920300 |
| 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06930300 |
| 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06940300 |
| END 06950300 |
