| PROGRAM FM025 |
| |
| C COMMENT SECTION. 00010025 |
| C 00020025 |
| C FM025 00030025 |
| C 00040025 |
| C THIS ROUTINE TESTS ARRAYS WITH IF STATEMENTS, DO LOOPS, 00050025 |
| C ASSIGNED AND COMPUTED GO TO STATEMENTS IN CONJUNCTION WITH ARRAY 00060025 |
| C ELEMENTS IN COMMON OR DIMENSIONED. ONE, TWO, AND THREE 00070025 |
| C DIMENSIONED ARRAYS ARE USED. THE SUBSCRIPTS ARE INTEGER CONSTANTS00080025 |
| C OR SOMETIMES INTEGER VARIABLES WHEN THE ELEMENTS ARE IN LOOPS 00090025 |
| C AND ALL ARRAYS HAVE FIXED SIZE LIMITS. INTEGER, REAL, AND LOGICAL00100025 |
| C ARRAYS ARE USED WITH THE TYPE SOMETIMES SPECIFIED WITH THE 00110025 |
| C EXPLICIT TYPE STATEMENT. 00120025 |
| C 00130025 |
| C REFERENCES 00140025 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150025 |
| C X3.9-1978 00160025 |
| C 00170025 |
| C SECTION 8, SPECIFICATION STATEMENTS 00180025 |
| C SECTION 8.1, DIMENSION STATEMENT 00190025 |
| C SECTION 8.3, COMMON STATEMENT 00200025 |
| C SECTION 8.4, TYPE-STATEMENTS 00210025 |
| C SECTION 9, DATA STATEMENT 00220025 |
| C SECTION 11.2, COMPUTED GO TO STATEMENT 00230025 |
| C SECTION 11.3, ASSIGNED GO TO STATEMENT 00240025 |
| C SECTION 11.10, DO STATEMENT 00250025 |
| C 00260025 |
| COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00270025 |
| C 00280025 |
| DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00290025 |
| C 00300025 |
| LOGICAL LADN31 00310025 |
| INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00320025 |
| REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00330025 |
| C 00340025 |
| C 00350025 |
| C ********************************************************** 00360025 |
| C 00370025 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00380025 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00390025 |
| C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00400025 |
| C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00410025 |
| C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00420025 |
| C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00430025 |
| C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00440025 |
| C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00450025 |
| C OF EXECUTING THESE TESTS. 00460025 |
| C 00470025 |
| C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00480025 |
| C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00490025 |
| C 00500025 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00510025 |
| C 00520025 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00530025 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00540025 |
| C BUILDING 225 RM A266 00550025 |
| C GAITHERSBURG, MD 20899 00560025 |
| C ********************************************************** 00570025 |
| C 00580025 |
| C 00590025 |
| C 00600025 |
| C INITIALIZATION SECTION 00610025 |
| C 00620025 |
| C INITIALIZE CONSTANTS 00630025 |
| C ************** 00640025 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650025 |
| I01 = 5 00660025 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670025 |
| I02 = 6 00680025 |
| C SYSTEM ENVIRONMENT SECTION 00690025 |
| C 00700025 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00710025 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720025 |
| C (UNIT NUMBER FOR CARD READER). 00730025 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00740025 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750025 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00760025 |
| C 00770025 |
| CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00780025 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00790025 |
| C (UNIT NUMBER FOR PRINTER). 00800025 |
| CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00810025 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820025 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00830025 |
| C 00840025 |
| IVPASS=0 00850025 |
| IVFAIL=0 00860025 |
| IVDELE=0 00870025 |
| ICZERO=0 00880025 |
| C 00890025 |
| C WRITE PAGE HEADERS 00900025 |
| WRITE (I02,90000) 00910025 |
| WRITE (I02,90001) 00920025 |
| WRITE (I02,90002) 00930025 |
| WRITE (I02, 90002) 00940025 |
| WRITE (I02,90003) 00950025 |
| WRITE (I02,90002) 00960025 |
| WRITE (I02,90004) 00970025 |
| WRITE (I02,90002) 00980025 |
| WRITE (I02,90011) 00990025 |
| WRITE (I02,90002) 01000025 |
| WRITE (I02,90002) 01010025 |
| WRITE (I02,90005) 01020025 |
| WRITE (I02,90006) 01030025 |
| WRITE (I02,90002) 01040025 |
| IVTNUM = 653 01050025 |
| C 01060025 |
| C **** TEST 653 **** 01070025 |
| C TEST 653 - TEST OF SETTING ALL VALUES OF AN INTEGER ARRAY 01080025 |
| C BY THE INTEGER INDEX OF A DO LOOP. THE ARRAY HAS ONE DIMENSION. 01090025 |
| C 01100025 |
| IF (ICZERO) 36530, 6530, 36530 01110025 |
| 6530 CONTINUE 01120025 |
| DO 6532 I = 1,2,1 01130025 |
| IADN11(I) = I 01140025 |
| 6532 CONTINUE 01150025 |
| IVCOMP = IADN11(1) 01160025 |
| GO TO 46530 01170025 |
| 36530 IVDELE = IVDELE + 1 01180025 |
| WRITE (I02,80003) IVTNUM 01190025 |
| IF (ICZERO) 46530, 6541, 46530 01200025 |
| 46530 IF ( IVCOMP - 1 ) 26530, 16530, 26530 01210025 |
| 16530 IVPASS = IVPASS + 1 01220025 |
| WRITE (I02,80001) IVTNUM 01230025 |
| GO TO 6541 01240025 |
| 26530 IVFAIL = IVFAIL + 1 01250025 |
| IVCORR = 1 01260025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01270025 |
| 6541 CONTINUE 01280025 |
| IVTNUM = 654 01290025 |
| C 01300025 |
| C **** TEST 654 **** 01310025 |
| C TEST 654 - SEE TEST 653. THIS TEST CHECKS THE SECOND ELEMENT OF01320025 |
| C THE INTEGER ARRAY IADN11(2). 01330025 |
| C 01340025 |
| IF (ICZERO) 36540, 6540, 36540 01350025 |
| 6540 CONTINUE 01360025 |
| IVCOMP = IADN11(2) 01370025 |
| GO TO 46540 01380025 |
| 36540 IVDELE = IVDELE + 1 01390025 |
| WRITE (I02,80003) IVTNUM 01400025 |
| IF (ICZERO) 46540, 6551, 46540 01410025 |
| 46540 IF ( IVCOMP - 2 ) 26540, 16540, 26540 01420025 |
| 16540 IVPASS = IVPASS + 1 01430025 |
| WRITE (I02,80001) IVTNUM 01440025 |
| GO TO 6551 01450025 |
| 26540 IVFAIL = IVFAIL + 1 01460025 |
| IVCORR = 2 01470025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480025 |
| 6551 CONTINUE 01490025 |
| IVTNUM = 655 01500025 |
| C 01510025 |
| C **** TEST 655 **** 01520025 |
| C TEST 655 - TEST OF SETTING THE VALUES OF THE COLUMN OF A TWO 01530025 |
| C DIMENSION INTEGER ARRAY BY A DO LOOP. THE VALUES FOR THE ELEMENTS01540025 |
| C IN A COLUMN IS THE NUMBER OF THE COLUMN AS SET BY THE DO LOOP 01550025 |
| C INDEX. ROW NUMBERS ARE INTEGER CONSTANTS. 01560025 |
| C THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 01570025 |
| C 1 2 01580025 |
| C 1 2 01590025 |
| C 01600025 |
| IF (ICZERO) 36550, 6550, 36550 01610025 |
| 6550 CONTINUE 01620025 |
| DO 6552 J = 1, 2 01630025 |
| IADN21(1,J) = J 01640025 |
| IADN21(2,J) = J 01650025 |
| 6552 CONTINUE 01660025 |
| IVCOMP = IADN21(1,1) 01670025 |
| GO TO 46550 01680025 |
| 36550 IVDELE = IVDELE + 1 01690025 |
| WRITE (I02,80003) IVTNUM 01700025 |
| IF (ICZERO) 46550, 6561, 46550 01710025 |
| 46550 IF ( IVCOMP - 1 ) 26550, 16550, 26550 01720025 |
| 16550 IVPASS = IVPASS + 1 01730025 |
| WRITE (I02,80001) IVTNUM 01740025 |
| GO TO 6561 01750025 |
| 26550 IVFAIL = IVFAIL + 1 01760025 |
| IVCORR = 1 01770025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780025 |
| 6561 CONTINUE 01790025 |
| IVTNUM = 656 01800025 |
| C 01810025 |
| C **** TEST 656 **** 01820025 |
| C TEST 656 - SEE TEST 655. THIS TEST CHECKS THE VALUE OF THE 01830025 |
| C INTEGER ARRAY IADN21(2,2) 01840025 |
| C 01850025 |
| IF (ICZERO) 36560, 6560, 36560 01860025 |
| 6560 CONTINUE 01870025 |
| IVCOMP = IADN21(2,2) 01880025 |
| GO TO 46560 01890025 |
| 36560 IVDELE = IVDELE + 1 01900025 |
| WRITE (I02,80003) IVTNUM 01910025 |
| IF (ICZERO) 46560, 6571, 46560 01920025 |
| 46560 IF ( IVCOMP - 2 ) 26560, 16560, 26560 01930025 |
| 16560 IVPASS = IVPASS + 1 01940025 |
| WRITE (I02,80001) IVTNUM 01950025 |
| GO TO 6571 01960025 |
| 26560 IVFAIL = IVFAIL + 1 01970025 |
| IVCORR = 2 01980025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01990025 |
| 6571 CONTINUE 02000025 |
| IVTNUM = 657 02010025 |
| C 02020025 |
| C **** TEST 657 **** 02030025 |
| C TEST 657 - THIS TESTS SETTING BOTH THE ROW AND COLUMN SUBSCRIPTS02040025 |
| C IN A TWO DIMENSION INTEGER ARRAY WITH A DOUBLE NESTED DO LOOP. 02050025 |
| C THE ELEMENT VALUES ARE SET BY AN INTEGER COUNTER. ELEMENT VALUES 02060025 |
| C ARE AS FOLLOWS 1 2 02070025 |
| C 3 4 02080025 |
| C 02090025 |
| IF (ICZERO) 36570, 6570, 36570 02100025 |
| 6570 CONTINUE 02110025 |
| ICON01 = 0 02120025 |
| DO 6573 I = 1, 2 02130025 |
| DO 6572 J = 1, 2 02140025 |
| ICON01 = ICON01 + 1 02150025 |
| IADN21(I,J) = ICON01 02160025 |
| 6572 CONTINUE 02170025 |
| 6573 CONTINUE 02180025 |
| IVCOMP = IADN21(1,2) 02190025 |
| GO TO 46570 02200025 |
| 36570 IVDELE = IVDELE + 1 02210025 |
| WRITE (I02,80003) IVTNUM 02220025 |
| IF (ICZERO) 46570, 6581, 46570 02230025 |
| 46570 IF ( IVCOMP - 2 ) 26570, 16570, 26570 02240025 |
| 16570 IVPASS = IVPASS + 1 02250025 |
| WRITE (I02,80001) IVTNUM 02260025 |
| GO TO 6581 02270025 |
| 26570 IVFAIL = IVFAIL + 1 02280025 |
| IVCORR = 2 02290025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300025 |
| 6581 CONTINUE 02310025 |
| IVTNUM = 658 02320025 |
| C 02330025 |
| C **** TEST 658 **** 02340025 |
| C TEST 658 - SEE TEST 657. THIS TEST CHECKS THE VALUE OF ARRAY 02350025 |
| C ELEMENT IADN21(2,1) = 3 02360025 |
| C 02370025 |
| IF (ICZERO) 36580, 6580, 36580 02380025 |
| 6580 CONTINUE 02390025 |
| IVCOMP = IADN21(2,1) 02400025 |
| GO TO 46580 02410025 |
| 36580 IVDELE = IVDELE + 1 02420025 |
| WRITE (I02,80003) IVTNUM 02430025 |
| IF (ICZERO) 46580, 6591, 46580 02440025 |
| 46580 IF ( IVCOMP - 3 ) 26580, 16580, 26580 02450025 |
| 16580 IVPASS = IVPASS + 1 02460025 |
| WRITE (I02,80001) IVTNUM 02470025 |
| GO TO 6591 02480025 |
| 26580 IVFAIL = IVFAIL + 1 02490025 |
| IVCORR = 3 02500025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510025 |
| 6591 CONTINUE 02520025 |
| IVTNUM = 659 02530025 |
| C 02540025 |
| C **** TEST 659 **** 02550025 |
| C TEST 659 - THIS TEST USES A TRIPLE NESTED DO LOOP TO SET THE 02560025 |
| C ELEMENTS IN ALL THREE DIMENSIONS OF AN INTEGER ARRAY THAT IS 02570025 |
| C DIMENSIONED. THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 02580025 |
| C FOR ELEMENT (I,J,K) = I + J + K 02590025 |
| C SO FOR ELEMENT (1,1,2) = 1 + 1 + 2 = 4 02600025 |
| C 02610025 |
| IF (ICZERO) 36590, 6590, 36590 02620025 |
| 6590 CONTINUE 02630025 |
| DO 6594 I = 1, 2 02640025 |
| DO 6593 J = 1, 2 02650025 |
| DO 6592 K = 1, 2 02660025 |
| IADN32( I, J, K ) = I + J + K 02670025 |
| 6592 CONTINUE 02680025 |
| 6593 CONTINUE 02690025 |
| 6594 CONTINUE 02700025 |
| IVCOMP = IADN32(1,1,2) 02710025 |
| GO TO 46590 02720025 |
| 36590 IVDELE = IVDELE + 1 02730025 |
| WRITE (I02,80003) IVTNUM 02740025 |
| IF (ICZERO) 46590, 6601, 46590 02750025 |
| 46590 IF ( IVCOMP - 4 ) 26590, 16590, 26590 02760025 |
| 16590 IVPASS = IVPASS + 1 02770025 |
| WRITE (I02,80001) IVTNUM 02780025 |
| GO TO 6601 02790025 |
| 26590 IVFAIL = IVFAIL + 1 02800025 |
| IVCORR = 4 02810025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02820025 |
| 6601 CONTINUE 02830025 |
| IVTNUM = 660 02840025 |
| C 02850025 |
| C **** TEST 660 **** 02860025 |
| C TEST 660 - SEE TEST 659. THIS CHECKS FOR IADN32(2,2,2) = 6 02870025 |
| C 02880025 |
| IF (ICZERO) 36600, 6600, 36600 02890025 |
| 6600 CONTINUE 02900025 |
| IVCOMP = IADN32(2,2,2) 02910025 |
| GO TO 46600 02920025 |
| 36600 IVDELE = IVDELE + 1 02930025 |
| WRITE (I02,80003) IVTNUM 02940025 |
| IF (ICZERO) 46600, 6611, 46600 02950025 |
| 46600 IF ( IVCOMP - 6 ) 26600, 16600, 26600 02960025 |
| 16600 IVPASS = IVPASS + 1 02970025 |
| WRITE (I02,80001) IVTNUM 02980025 |
| GO TO 6611 02990025 |
| 26600 IVFAIL = IVFAIL + 1 03000025 |
| IVCORR = 6 03010025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03020025 |
| 6611 CONTINUE 03030025 |
| IVTNUM = 661 03040025 |
| C 03050025 |
| C **** TEST 661 **** 03060025 |
| C TEST 661 - THIS TEST SETS THE ELEMENTS OF AN INTEGER ARRAY IN 03070025 |
| C COMMON TO MINUS THE VALUE OF THE INTEGER ARRAY SET IN TEST 659. 03080025 |
| C ELEMENT IADN32(1,1,2) = 4 SO ELEMENT IADN31(1,1,2) = -4 03090025 |
| C THE SAME INTEGER ASSIGNMENT STATEMENT IS USED AS THE TERMINATING 03100025 |
| C STATEMENT FOR ALL THREE DO LOOPS USED TO SET THE ARRAY VALUES 03110025 |
| C OF INTEGER ARRAY IADN31. 03120025 |
| C IF TEST 659 FAILS, THEN THIS TEST SHOULD ALSO FAIL. HOWEVER, THE 03130025 |
| C COMPUTED VALUES SHOULD RELATE IN THAT THE COMPUTED VALUE FOR 03140025 |
| C TEST 661 SHOULD BE MINUS THE COMPUTED VALUE FOR TEST 659. 03150025 |
| C 03160025 |
| IF (ICZERO) 36610, 6610, 36610 03170025 |
| 6610 CONTINUE 03180025 |
| DO 6612 I = 1, 2 03190025 |
| DO 6612 J = 1, 2 03200025 |
| DO 6612 K = 1, 2 03210025 |
| 6612 IADN31(I,J,K) = - IADN32 ( I, J, K ) 03220025 |
| IVCOMP = IADN31(1,1,2) 03230025 |
| GO TO 46610 03240025 |
| 36610 IVDELE = IVDELE + 1 03250025 |
| WRITE (I02,80003) IVTNUM 03260025 |
| IF (ICZERO) 46610, 6621, 46610 03270025 |
| 46610 IF ( IVCOMP + 4 ) 26610, 16610, 26610 03280025 |
| 16610 IVPASS = IVPASS + 1 03290025 |
| WRITE (I02,80001) IVTNUM 03300025 |
| GO TO 6621 03310025 |
| 26610 IVFAIL = IVFAIL + 1 03320025 |
| IVCORR = -4 03330025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340025 |
| 6621 CONTINUE 03350025 |
| IVTNUM = 662 03360025 |
| C 03370025 |
| C **** TEST 662 **** 03380025 |
| C TEST 662 - THIS IS A TEST OF A TRIPLE NESTED DO LOOP USED TO 03390025 |
| C SET THE VALUES OF A LOGICAL ARRAY LADN31. UNLIKE THE OTHER TESTS 03400025 |
| C THE THIRD DIMENSION IS SET LAST, THE FIRST DIMENSION IS SET SECOND03410025 |
| C AND THE SECOND DIMENSION IS SET FIRST. ALL ARRAY ELEMENTS ARE SET03420025 |
| C TO THE LOGICAL CONSTANT .FALSE. 03430025 |
| C 03440025 |
| IF (ICZERO) 36620, 6620, 36620 03450025 |
| 6620 CONTINUE 03460025 |
| DO 6622 K = 1, 2 03470025 |
| DO 6622 I = 1, 2 03480025 |
| DO 6622 J = 1, 2 03490025 |
| LADN31( I, J, K ) = .FALSE. 03500025 |
| 6622 CONTINUE 03510025 |
| ICON01 = 1 03520025 |
| IF ( LADN31(2,1,2) ) ICON01 = 0 03530025 |
| GO TO 46620 03540025 |
| 36620 IVDELE = IVDELE + 1 03550025 |
| WRITE (I02,80003) IVTNUM 03560025 |
| IF (ICZERO) 46620, 6631, 46620 03570025 |
| 46620 IF ( ICON01 - 1 ) 26620, 16620, 26620 03580025 |
| 16620 IVPASS = IVPASS + 1 03590025 |
| WRITE (I02,80001) IVTNUM 03600025 |
| GO TO 6631 03610025 |
| 26620 IVFAIL = IVFAIL + 1 03620025 |
| IVCOMP = ICON01 03630025 |
| IVCORR = 1 03640025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03650025 |
| 6631 CONTINUE 03660025 |
| IVTNUM = 665 04030025 |
| C 04040025 |
| C **** TEST 665 **** 04050025 |
| C TEST 665 - ARRAY ELEMENTS SET TO TYPE REAL BY THE EXPLICIT 04060025 |
| C REAL STATEMENT ARE SET TO THE VALUE 0.5 AND USED TO SET THE VALUE 04070025 |
| C OF AN ARRAY ELEMENT SET TO TYPE INTEGER BY THE INTEGER STATEMENT. 04080025 |
| C THIS LAST INTEGER ELEMENT IS USED IN A LOGICAL IF STATEMENT 04090025 |
| C THAT SHOULD COMPARE TRUE. ( .5 + .5 + .5 ) * 2. .EQ. 3 04100025 |
| C 04110025 |
| IF (ICZERO) 36650, 6650, 36650 04120025 |
| 6650 CONTINUE 04130025 |
| IADN33(2,2,2) = 0.5 04140025 |
| IADN22(2,4) = 0.5 04150025 |
| IADN12(8) = 0.5 04160025 |
| RADN11(8) = ( IADN33(2,2,2) + IADN22(2,4) + IADN12(8) ) * 2. 04170025 |
| ICON01 = 0 04180025 |
| IF ( RADN11(8) .EQ. 3 ) ICON01 = 1 04190025 |
| GO TO 46650 04200025 |
| 36650 IVDELE = IVDELE + 1 04210025 |
| WRITE (I02,80003) IVTNUM 04220025 |
| IF (ICZERO) 46650, 6661, 46650 04230025 |
| 46650 IF ( ICON01 - 1 ) 26650, 16650, 26650 04240025 |
| 16650 IVPASS = IVPASS + 1 04250025 |
| WRITE (I02,80001) IVTNUM 04260025 |
| GO TO 6661 04270025 |
| 26650 IVFAIL = IVFAIL + 1 04280025 |
| IVCOMP = ICON01 04290025 |
| IVCORR = 1 04300025 |
| WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04310025 |
| 6661 CONTINUE 04320025 |
| C 04330025 |
| C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04340025 |
| 99999 CONTINUE 04350025 |
| WRITE (I02,90002) 04360025 |
| WRITE (I02,90006) 04370025 |
| WRITE (I02,90002) 04380025 |
| WRITE (I02,90002) 04390025 |
| WRITE (I02,90007) 04400025 |
| WRITE (I02,90002) 04410025 |
| WRITE (I02,90008) IVFAIL 04420025 |
| WRITE (I02,90009) IVPASS 04430025 |
| WRITE (I02,90010) IVDELE 04440025 |
| C 04450025 |
| C 04460025 |
| C TERMINATE ROUTINE EXECUTION 04470025 |
| STOP 04480025 |
| C 04490025 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 04500025 |
| 90000 FORMAT ("1") 04510025 |
| 90002 FORMAT (" ") 04520025 |
| 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04530025 |
| 90003 FORMAT (" ",21X,"VERSION 2.1" ) 04540025 |
| 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04550025 |
| 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04560025 |
| 90006 FORMAT (" ",5X,"----------------------------------------------" ) 04570025 |
| 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04580025 |
| C 04590025 |
| C FORMAT STATEMENTS FOR RUN SUMMARIES 04600025 |
| 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04610025 |
| 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04620025 |
| 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04630025 |
| C 04640025 |
| C FORMAT STATEMENTS FOR TEST RESULTS 04650025 |
| 80001 FORMAT (" ",4X,I5,7X,"PASS") 04660025 |
| 80002 FORMAT (" ",4X,I5,7X,"FAIL") 04670025 |
| 80003 FORMAT (" ",4X,I5,7X,"DELETED") 04680025 |
| 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04690025 |
| 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04700025 |
| C 04710025 |
| 90007 FORMAT (" ",20X,"END OF PROGRAM FM025" ) 04720025 |
| END 04730025 |
