FM025.f Source File


Contents

Source Code


Source Code

      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