FM023.f Source File


Contents

Source Code


Source Code

      PROGRAM FM023

C     COMMENT SECTION.                                                  00010023
C                                                                       00020023
C     FM023                                                             00030023
C                                                                       00040023
C                  TWO DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE.     00050023
C         THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060023
C     SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT.  THE VALUES  00070023
C     OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE      00080023
C     ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS  00090023
C     (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO  00100023
C     INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY      00110023
C     USE OF THE  EQUIVALENCE  STATEMENT.                               00120023
C                                                                       00130023
C                                                                       00140023
C      REFERENCES                                                       00150023
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00160023
C              X3.9-1978                                                00170023
C                                                                       00180023
C        SECTION 8, SPECIFICATION STATEMENTS                            00190023
C        SECTION 8.1, DIMENSION STATEMENT                               00200023
C        SECTION 8.2, EQUIVALENCE STATEMENT                             00210023
C        SECTION 8.3, COMMON STATEMENT                                  00220023
C        SECTION 8.4, TYPE-STATEMENTS                                   00230023
C        SECTION 9, DATA STATEMENT                                      00240023
C                                                                       00250023
      COMMON IADN22(2,2), RADN22(2,2), ICOE01, RCOE01                   00260023
      DIMENSION IADN21(2,2), RADN21(2,2)                                00270023
      DIMENSION IADE23(2,2), IADE24(2,2), RADE23(2,2), RADE24(2,2)      00280023
      EQUIVALENCE (IADE23(2,2),IADN22(2,2),IADE24(2,2))                 00290023
      EQUIVALENCE (RADE23(2,2),RADN22(2,2),RADE24(2,2))                 00300023
      EQUIVALENCE (ICOE01,ICOE02,ICOE03,ICOE04), (RCOE01,RCOE02,RCOE03) 00310023
      INTEGER RADN11(2), RADN25(2,2)                                    00320023
      LOGICAL LADN21(2,2)                                               00330023
      DATA RADN21(2,2)/-512./                                           00340023
      DATA LADN21/4*.TRUE./                                             00350023
C                                                                       00360023
C      **********************************************************       00370023
C                                                                       00380023
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00390023
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00400023
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00410023
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00420023
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00430023
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00440023
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00450023
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00460023
C     OF EXECUTING THESE TESTS.                                         00470023
C                                                                       00480023
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00490023
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00500023
C                                                                       00510023
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00520023
C                                                                       00530023
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00540023
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00550023
C                          BUILDING 225  RM A266                        00560023
C                         GAITHERSBURG, MD  20899                       00570023
C      **********************************************************       00580023
C                                                                       00590023
C                                                                       00600023
C                                                                       00610023
C     INITIALIZATION SECTION                                            00620023
C                                                                       00630023
C     INITIALIZE CONSTANTS                                              00640023
C      **************                                                   00650023
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00660023
      I01 = 5                                                           00670023
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00680023
      I02 = 6                                                           00690023
C     SYSTEM ENVIRONMENT SECTION                                        00700023
C                                                                       00710023
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00720023
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00730023
C     (UNIT NUMBER FOR CARD READER).                                    00740023
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00750023
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00760023
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00770023
C                                                                       00780023
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00790023
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00800023
C     (UNIT NUMBER FOR PRINTER).                                        00810023
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00820023
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00830023
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00840023
C                                                                       00850023
      IVPASS=0                                                          00860023
      IVFAIL=0                                                          00870023
      IVDELE=0                                                          00880023
      ICZERO=0                                                          00890023
C                                                                       00900023
C     WRITE PAGE HEADERS                                                00910023
      WRITE (I02,90000)                                                 00920023
      WRITE (I02,90001)                                                 00930023
      WRITE (I02,90002)                                                 00940023
      WRITE (I02, 90002)                                                00950023
      WRITE (I02,90003)                                                 00960023
      WRITE (I02,90002)                                                 00970023
      WRITE (I02,90004)                                                 00980023
      WRITE (I02,90002)                                                 00990023
      WRITE (I02,90011)                                                 01000023
      WRITE (I02,90002)                                                 01010023
      WRITE (I02,90002)                                                 01020023
      WRITE (I02,90005)                                                 01030023
      WRITE (I02,90006)                                                 01040023
      WRITE (I02,90002)                                                 01050023
      IVTNUM = 632                                                      01060023
C                                                                       01070023
C      ****  TEST 632  ****                                             01080023
C     TEST 632  -  TESTS SETTING AN INTEGER ARRAY ELEMENT BY A          01090023
C     SIMPLE ASSIGNMENT STATEMENT TO THE VALUE 9999.                    01100023
C                                                                       01110023
      IF (ICZERO) 36320, 6320, 36320                                    01120023
 6320 CONTINUE                                                          01130023
      IADN21(1,1) = 9999                                                01140023
      IVCOMP = IADN21(1,1)                                              01150023
      GO TO 46320                                                       01160023
36320 IVDELE = IVDELE + 1                                               01170023
      WRITE (I02,80003) IVTNUM                                          01180023
      IF (ICZERO) 46320, 6331, 46320                                    01190023
46320 IF ( IVCOMP - 9999 )  26320, 16320, 26320                         01200023
16320 IVPASS = IVPASS + 1                                               01210023
      WRITE (I02,80001) IVTNUM                                          01220023
      GO TO 6331                                                        01230023
26320 IVFAIL = IVFAIL + 1                                               01240023
      IVCORR = 9999                                                     01250023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01260023
 6331 CONTINUE                                                          01270023
      IVTNUM = 633                                                      01280023
C                                                                       01290023
C      ****  TEST 633  ****                                             01300023
C     TEST 633  -  TESTS SETTING A REAL ARRAY ELEMENT BY A SIMPLE       01310023
C     ASSIGNMENT STATEMENT TO THE VALUE -32766.                         01320023
C                                                                       01330023
      IF (ICZERO) 36330, 6330, 36330                                    01340023
 6330 CONTINUE                                                          01350023
      RADN21(1,2) = -32766.                                             01360023
      IVCOMP = RADN21(1,2)                                              01370023
      GO TO 46330                                                       01380023
36330 IVDELE = IVDELE + 1                                               01390023
      WRITE (I02,80003) IVTNUM                                          01400023
      IF (ICZERO) 46330, 6341, 46330                                    01410023
46330 IF ( IVCOMP + 32766 )  26330, 16330, 26330                        01420023
16330 IVPASS = IVPASS + 1                                               01430023
      WRITE (I02,80001) IVTNUM                                          01440023
      GO TO 6341                                                        01450023
26330 IVFAIL = IVFAIL + 1                                               01460023
      IVCORR = -32766                                                   01470023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01480023
 6341 CONTINUE                                                          01490023
      IVTNUM = 634                                                      01500023
C                                                                       01510023
C      ****  TEST 634  ****                                             01520023
C     TEST 634  -  TEST OF THE DATA INITIALIZATION STATEMENT AND SETTING01530023
C     AN INTEGER ARRAY ELEMENT EQUAL TO THE VALUE OF A REAL ARRAY       01540023
C     ELEMENT.  THE VALUE USED IS -512.                                 01550023
C                                                                       01560023
      IF (ICZERO) 36340, 6340, 36340                                    01570023
 6340 CONTINUE                                                          01580023
      IADN21(2,2) = RADN21(2,2)                                         01590023
      IVCOMP = IADN21(2,2)                                              01600023
      GO TO 46340                                                       01610023
36340 IVDELE = IVDELE + 1                                               01620023
      WRITE (I02,80003) IVTNUM                                          01630023
      IF (ICZERO) 46340, 6351, 46340                                    01640023
46340 IF ( IVCOMP + 512 )  26340, 16340, 26340                          01650023
16340 IVPASS = IVPASS + 1                                               01660023
      WRITE (I02,80001) IVTNUM                                          01670023
      GO TO 6351                                                        01680023
26340 IVFAIL = IVFAIL + 1                                               01690023
      IVCORR = -512                                                     01700023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01710023
 6351 CONTINUE                                                          01720023
      IVTNUM = 635                                                      01730023
C                                                                       01740023
C      ****  TEST 635  ****                                             01750023
C     TEST 635  -  TEST OF SETTING A TWO DIMENSIONED ARRAY ELEMENT      01760023
C     EQUAL TO THE VALUE OF A ONE DIMENSIONED ARRAY ELEMENT.            01770023
C     BOTH ARRAYS ARE SET INTEGER BY THE TYPE STATEMENT AND THE TWO     01780023
C     DIMENSIONED ARRAY ELEMENT IS MINUS THE VALUE OF THE ONE DIMENSION 01790023
C     ELEMENT.  THE VALUE USED IS 3.                                    01800023
C                                                                       01810023
      IF (ICZERO) 36350, 6350, 36350                                    01820023
 6350 CONTINUE                                                          01830023
      RADN11(1) = 3                                                     01840023
      RADN25(2,2) = - RADN11(1)                                         01850023
      IVCOMP = RADN25(2,2)                                              01860023
      GO TO 46350                                                       01870023
36350 IVDELE = IVDELE + 1                                               01880023
      WRITE (I02,80003) IVTNUM                                          01890023
      IF (ICZERO) 46350, 6361, 46350                                    01900023
46350 IF ( IVCOMP + 3 )  26350, 16350, 26350                            01910023
16350 IVPASS = IVPASS + 1                                               01920023
      WRITE (I02,80001) IVTNUM                                          01930023
      GO TO 6361                                                        01940023
26350 IVFAIL = IVFAIL + 1                                               01950023
      IVCORR = -3                                                       01960023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01970023
 6361 CONTINUE                                                          01980023
      IVTNUM = 636                                                      01990023
C                                                                       02000023
C      ****  TEST 636  ****                                             02010023
C     TEST 636  -  TEST OF LOGICAL ARRAY ELEMENTS SET BY DATA STATEMENTS02020023
C                                                                       02030023
      IF (ICZERO) 36360, 6360, 36360                                    02040023
 6360 CONTINUE                                                          02050023
      ICON01 = 0                                                        02060023
      IF ( LADN21(2,1) )  ICON01 = 1                                    02070023
      GO TO 46360                                                       02080023
36360 IVDELE = IVDELE + 1                                               02090023
      WRITE (I02,80003) IVTNUM                                          02100023
      IF (ICZERO) 46360, 6371, 46360                                    02110023
46360 IF ( ICON01 - 1 )  26360, 16360, 26360                            02120023
16360 IVPASS = IVPASS + 1                                               02130023
      WRITE (I02,80001) IVTNUM                                          02140023
      GO TO 6371                                                        02150023
26360 IVFAIL = IVFAIL + 1                                               02160023
      IVCOMP = ICON01                                                   02170023
      IVCORR = 1                                                        02180023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02190023
 6371 CONTINUE                                                          02200023
      IVTNUM = 637                                                      02210023
C                                                                       02220023
C      ****  TEST 637  ****                                             02230023
C     TEST 637  -  TEST OF REAL TO INTEGER CONVERSION AND SETTING       02240023
C     INTEGER ARRAY ELEMENTS TO THE VALUE OBTAINED IN AN ARITHMETIC     02250023
C     EXPRESSION USING REAL ARRAY ELEMENTS.   .5  +  .5  =  1           02260023
C                                                                       02270023
      IF (ICZERO) 36370, 6370, 36370                                    02280023
 6370 CONTINUE                                                          02290023
      RADN21(1,2) = 00000.5                                             02300023
      RADN21(2,1) = .500000                                             02310023
      IADN21(2,1) = RADN21(1,2) + RADN21(2,1)                           02320023
      IVCOMP = IADN21(2,1)                                              02330023
      GO TO 46370                                                       02340023
36370 IVDELE = IVDELE + 1                                               02350023
      WRITE (I02,80003) IVTNUM                                          02360023
      IF (ICZERO) 46370, 6381, 46370                                    02370023
46370 IF ( IVCOMP - 1 )  26370, 16370, 26370                            02380023
16370 IVPASS = IVPASS + 1                                               02390023
      WRITE (I02,80001) IVTNUM                                          02400023
      GO TO 6381                                                        02410023
26370 IVFAIL = IVFAIL + 1                                               02420023
      IVCORR = 1                                                        02430023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02440023
 6381 CONTINUE                                                          02450023
      IVTNUM = 638                                                      02460023
C                                                                       02470023
C      ****  TEST 638  ****                                             02480023
C     TEST 638  -  TEST OF EQUIVALENCE OF THREE INTEGER ARRAYS ONE OF   02490023
C     WHICH IS IN COMMON.                                               02500023
C                                                                       02510023
      IF (ICZERO) 36380, 6380, 36380                                    02520023
 6380 CONTINUE                                                          02530023
      IADN22(2,1) = -9999                                               02540023
      IVCOMP = IADE23(2,1)                                              02550023
      GO TO 46380                                                       02560023
36380 IVDELE = IVDELE + 1                                               02570023
      WRITE (I02,80003) IVTNUM                                          02580023
      IF (ICZERO) 46380, 6391, 46380                                    02590023
46380 IF ( IVCOMP + 9999 )  26380, 16380, 26380                         02600023
16380 IVPASS = IVPASS + 1                                               02610023
      WRITE (I02,80001) IVTNUM                                          02620023
      GO TO 6391                                                        02630023
26380 IVFAIL = IVFAIL + 1                                               02640023
      IVCORR = -9999                                                    02650023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02660023
 6391 CONTINUE                                                          02670023
      IVTNUM = 639                                                      02680023
C                                                                       02690023
C      ****  TEST 639  ****                                             02700023
C     TEST 639  -  LIKE TEST 638 ONLY THE OTHER EQUIVALENCED ARRAY IS   02710023
C     TESTED FOR THE VALUE -9999.                                       02720023
C                                                                       02730023
      IF (ICZERO) 36390, 6390, 36390                                    02740023
 6390 CONTINUE                                                          02750023
      IADE23(2,1) = -9999                                               02760023
      IVCOMP = IADE24(2,1)                                              02770023
      GO TO 46390                                                       02780023
36390 IVDELE = IVDELE + 1                                               02790023
      WRITE (I02,80003) IVTNUM                                          02800023
      IF (ICZERO) 46390, 6401, 46390                                    02810023
46390 IF ( IVCOMP + 9999 )  26390, 16390, 26390                         02820023
16390 IVPASS = IVPASS + 1                                               02830023
      WRITE (I02,80001) IVTNUM                                          02840023
      GO TO 6401                                                        02850023
26390 IVFAIL = IVFAIL + 1                                               02860023
      IVCORR = -9999                                                    02870023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02880023
 6401 CONTINUE                                                          02890023
      IVTNUM = 640                                                      02900023
C                                                                       02910023
C      ****  TEST 640  ****                                             02920023
C     TEST 640  -  TEST OF THREE REAL ARRAYS THAT ARE EQUIVALENCED.     02930023
C     ONE OF THE ARRAYS IS IN COMMON.  THE VALUE 512 IS SET INTO ONE OF 02940023
C     THE DIMENSIONED ARRAY ELEMENTS BY AN INTEGER TO REAL CONVERSION   02950023
C     ASSIGNMENT STATEMENT.                                             02960023
C                                                                       02970023
      IF (ICZERO) 36400, 6400, 36400                                    02980023
 6400 CONTINUE                                                          02990023
      RADE24(2,2) = 512                                                 03000023
      IVCOMP = RADN22(2,2)                                              03010023
      GO TO 46400                                                       03020023
36400 IVDELE = IVDELE + 1                                               03030023
      WRITE (I02,80003) IVTNUM                                          03040023
      IF (ICZERO) 46400, 6411, 46400                                    03050023
46400 IF ( IVCOMP - 512 )  26400, 16400, 26400                          03060023
16400 IVPASS = IVPASS + 1                                               03070023
      WRITE (I02,80001) IVTNUM                                          03080023
      GO TO 6411                                                        03090023
26400 IVFAIL = IVFAIL + 1                                               03100023
      IVCORR = 512                                                      03110023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03120023
 6411 CONTINUE                                                          03130023
      IVTNUM = 641                                                      03140023
C                                                                       03150023
C      ****  TEST 641  ****                                             03160023
C     TEST 641  -  LIKE TEST 640 ONLY THE OTHER EQUIVALENCED ARRAY IS   03170023
C     TESTED FOR THE VALUE 512.                                         03180023
C                                                                       03190023
      IF (ICZERO) 36410, 6410, 36410                                    03200023
 6410 CONTINUE                                                          03210023
      RADN22(2,2) = 512                                                 03220023
      IVCOMP = RADE23(2,2)                                              03230023
      GO TO 46410                                                       03240023
36410 IVDELE = IVDELE + 1                                               03250023
      WRITE (I02,80003) IVTNUM                                          03260023
      IF (ICZERO) 46410, 6421, 46410                                    03270023
46410 IF ( IVCOMP - 512 )  26410, 16410, 26410                          03280023
16410 IVPASS = IVPASS + 1                                               03290023
      WRITE (I02,80001) IVTNUM                                          03300023
      GO TO 6421                                                        03310023
26410 IVFAIL = IVFAIL + 1                                               03320023
      IVCORR = 512                                                      03330023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03340023
 6421 CONTINUE                                                          03350023
      IVTNUM = 642                                                      03360023
C                                                                       03370023
C      ****  TEST 642  ****                                             03380023
C     TEST 642  -  TEST OF FOUR INTEGER VARIABLES THAT ARE EQUIVALENCED.03390023
C     ONE OF THE INTEGER VARIABLES IS IN BLANK COMMON.  THE VALUE USED  03400023
C     IS 3 SET  BY AN ASSIGNMENT STATEMENT.                             03410023
C                                                                       03420023
      IF (ICZERO) 36420, 6420, 36420                                    03430023
 6420 CONTINUE                                                          03440023
      ICOE03 = 3                                                        03450023
      IVCOMP = ICOE01                                                   03460023
      GO TO 46420                                                       03470023
36420 IVDELE = IVDELE + 1                                               03480023
      WRITE (I02,80003) IVTNUM                                          03490023
      IF (ICZERO) 46420, 6431, 46420                                    03500023
46420 IF ( IVCOMP - 3 )  26420, 16420, 26420                            03510023
16420 IVPASS = IVPASS + 1                                               03520023
      WRITE (I02,80001) IVTNUM                                          03530023
      GO TO 6431                                                        03540023
26420 IVFAIL = IVFAIL + 1                                               03550023
      IVCORR = 3                                                        03560023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03570023
 6431 CONTINUE                                                          03580023
      IVTNUM = 643                                                      03590023
C                                                                       03600023
C      ****  TEST 643  ****                                             03610023
C     TEST 643  -  LIKE TEST 642 BUT ANOTHER OF THE ELEMENTS IS TESTED  03620023
C     BY AN ARITHMETIC EXPRESSION USING THE EQUIVALENCED  ELEMENTS.     03630023
C     THE VALUE OF ALL OF THE ELEMENTS SHOULD INITITIALLY BE 3 SINCE    03640023
C     THEY ALL SHOULD SHARE THE SAME STORAGE LOCATION. ICOE04 = 3+3+3+3 03650023
C     ICOE04 = 12  THEN THE ELEMENT ICOE02 IS TESTED FOR THE VALUE 12.  03660023
C                                                                       03670023
      IF (ICZERO) 36430, 6430, 36430                                    03680023
 6430 CONTINUE                                                          03690023
      ICOE01 = 3                                                        03700023
      ICOE04 = ICOE01 + ICOE02 + ICOE03 + ICOE04                        03710023
      IVCOMP = ICOE02                                                   03720023
      GO TO 46430                                                       03730023
36430 IVDELE = IVDELE + 1                                               03740023
      WRITE (I02,80003) IVTNUM                                          03750023
      IF (ICZERO) 46430, 6441, 46430                                    03760023
46430 IF ( IVCOMP - 12 )  26430, 16430, 26430                           03770023
16430 IVPASS = IVPASS + 1                                               03780023
      WRITE (I02,80001) IVTNUM                                          03790023
      GO TO 6441                                                        03800023
26430 IVFAIL = IVFAIL + 1                                               03810023
      IVCORR = 12                                                       03820023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03830023
 6441 CONTINUE                                                          03840023
      IVTNUM = 644                                                      03850023
C                                                                       03860023
C      ****  TEST 644  ****                                             03870023
C     TEST 644  -  TEST OF EQUIVALENCE WITH THREE REAL VARIABLES ONE    03880023
C     OF WHICH IS IN BLANK COMMON.  THE ELEMENTS ARE SET INITIALLY TO .503890023
C     THEN ALL OF THE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION     03900023
C     RCOE01 =(.5 + .5 + .5) * 2.   SO RCOE01 = 3.   ELEMENT RCOE02     03910023
C     IS TESTED FOR THE VALUE 3.                                        03920023
C                                                                       03930023
      IF (ICZERO) 36440, 6440, 36440                                    03940023
 6440 CONTINUE                                                          03950023
      RCOE02 = 0.5                                                      03960023
      RCOE01 = ( RCOE01 + RCOE02 + RCOE03 ) * 2.                        03970023
      IVCOMP = RCOE02                                                   03980023
      GO TO 46440                                                       03990023
36440 IVDELE = IVDELE + 1                                               04000023
      WRITE (I02,80003) IVTNUM                                          04010023
      IF (ICZERO) 46440, 6451, 46440                                    04020023
46440 IF ( IVCOMP - 3 )  26440, 16440, 26440                            04030023
16440 IVPASS = IVPASS + 1                                               04040023
      WRITE (I02,80001) IVTNUM                                          04050023
      GO TO 6451                                                        04060023
26440 IVFAIL = IVFAIL + 1                                               04070023
      IVCORR = 3                                                        04080023
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          04090023
 6451 CONTINUE                                                          04100023
C                                                                       04110023
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             04120023
99999 CONTINUE                                                          04130023
      WRITE (I02,90002)                                                 04140023
      WRITE (I02,90006)                                                 04150023
      WRITE (I02,90002)                                                 04160023
      WRITE (I02,90002)                                                 04170023
      WRITE (I02,90007)                                                 04180023
      WRITE (I02,90002)                                                 04190023
      WRITE (I02,90008)  IVFAIL                                         04200023
      WRITE (I02,90009) IVPASS                                          04210023
      WRITE (I02,90010) IVDELE                                          04220023
C                                                                       04230023
C                                                                       04240023
C     TERMINATE ROUTINE EXECUTION                                       04250023
      STOP                                                              04260023
C                                                                       04270023
C     FORMAT STATEMENTS FOR PAGE HEADERS                                04280023
90000 FORMAT ("1")                                                      04290023
90002 FORMAT (" ")                                                      04300023
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            04310023
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   04320023
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        04330023
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04340023
90006 FORMAT (" ",5X,"----------------------------------------------" ) 04350023
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             04360023
C                                                                       04370023
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               04380023
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        04390023
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              04400023
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             04410023
C                                                                       04420023
C     FORMAT STATEMENTS FOR TEST RESULTS                                04430023
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      04440023
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      04450023
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   04460023
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         04470023
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    04480023
C                                                                       04490023
90007 FORMAT (" ",20X,"END OF PROGRAM FM023" )                          04500023
      END                                                               04510023