FM022.f Source File


Contents

Source Code


Source Code

      PROGRAM FM022

C     COMMENT SECTION.                                                  00010022
C                                                                       00020022
C     FM022                                                             00030022
C                                                                       00040022
C         THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00050022
C     SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT.  THE VALUES  00060022
C     OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE      00070022
C     ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS  00080022
C     (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO  00090022
C     INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY      00100022
C     USE OF THE  EQUIVALENCE  STATEMENT.                               00110022
C                                                                       00120022
C      REFERENCES                                                       00130022
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00140022
C              X3.9-1978                                                00150022
C                                                                       00160022
C        SECTION 8, SPECIFICATION STATEMENTS                            00170022
C        SECTION 8.1, DIMENSION STATEMENT                               00180022
C        SECTION 8.2, EQUIVALENCE STATEMENT                             00190022
C        SECTION 8.3, COMMON STATEMENT                                  00200022
C        SECTION 8.4, TYPE-STATEMENTS                                   00210022
C        SECTION 9, DATA STATEMENT                                      00220022
C                                                                       00230022
C                                                                       00240022
C                                                                       00250022
      COMMON IADN14(5), RADN14(5), LADN13(2)                            00260022
C                                                                       00270022
      DIMENSION IADN11(5), RADN11(5), LADN11(2)                         00280022
      DIMENSION IADN12(5), RADN12(5), LADN12(2)                         00290022
      DIMENSION IADN15(2), RADN15(2)                                    00300022
      DIMENSION IADN16(4), IADN17(4)                                    00310022
C                                                                       00320022
      INTEGER RADN13(5)                                                 00330022
      REAL IADN13(5)                                                    00340022
      LOGICAL LADN11, LADN12, LADN13, LCTN01                            00350022
C                                                                       00360022
      EQUIVALENCE (IADN14(1), IADN15(1)), (RADN14(2),RADN15(2))         00370022
      EQUIVALENCE (LADN13(1),LCTN01),  (IADN14(5), ICON02)              00380022
      EQUIVALENCE (RADN14(5), RCON01)                                   00390022
      EQUIVALENCE ( IADN16(3), IADN17(2) )                              00400022
C                                                                       00410022
      DATA IADN12(1)/3/, RADN12(1)/-512./, IADN13(1)/0.5/, RADN13(1)/-3/00420022
C                                                                       00430022
C                                                                       00440022
C                                                                       00450022
C      **********************************************************       00460022
C                                                                       00470022
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00480022
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00490022
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00500022
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00510022
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00520022
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00530022
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00540022
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00550022
C     OF EXECUTING THESE TESTS.                                         00560022
C                                                                       00570022
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00580022
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00590022
C                                                                       00600022
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00610022
C                                                                       00620022
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00630022
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00640022
C                          BUILDING 225  RM A266                        00650022
C                         GAITHERSBURG, MD  20899                       00660022
C      **********************************************************       00670022
C                                                                       00680022
C                                                                       00690022
C                                                                       00700022
C     INITIALIZATION SECTION                                            00710022
C                                                                       00720022
C     INITIALIZE CONSTANTS                                              00730022
C      **************                                                   00740022
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00750022
      I01 = 5                                                           00760022
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00770022
      I02 = 6                                                           00780022
C     SYSTEM ENVIRONMENT SECTION                                        00790022
C                                                                       00800022
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00810022
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00820022
C     (UNIT NUMBER FOR CARD READER).                                    00830022
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00840022
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00850022
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00860022
C                                                                       00870022
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00880022
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00890022
C     (UNIT NUMBER FOR PRINTER).                                        00900022
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00910022
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00920022
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00930022
C                                                                       00940022
      IVPASS=0                                                          00950022
      IVFAIL=0                                                          00960022
      IVDELE=0                                                          00970022
      ICZERO=0                                                          00980022
C                                                                       00990022
C     WRITE PAGE HEADERS                                                01000022
      WRITE (I02,90000)                                                 01010022
      WRITE (I02,90001)                                                 01020022
      WRITE (I02,90002)                                                 01030022
      WRITE (I02, 90002)                                                01040022
      WRITE (I02,90003)                                                 01050022
      WRITE (I02,90002)                                                 01060022
      WRITE (I02,90004)                                                 01070022
      WRITE (I02,90002)                                                 01080022
      WRITE (I02,90011)                                                 01090022
      WRITE (I02,90002)                                                 01100022
      WRITE (I02,90002)                                                 01110022
      WRITE (I02,90005)                                                 01120022
      WRITE (I02,90006)                                                 01130022
      WRITE (I02,90002)                                                 01140022
      IVTNUM = 604                                                      01150022
C                                                                       01160022
C      ****  TEST 604  ****                                             01170022
C     TEST 604  -  THIS TESTS A  SIMPLE ASSIGNMENT STATEMENT IN SETTING 01180022
C     AN INTEGER ARRAY ELEMENT TO A POSITIVE VALUE OF 32767.            01190022
C                                                                       01200022
      IF (ICZERO) 36040, 6040, 36040                                    01210022
 6040 CONTINUE                                                          01220022
      IADN11(5) = 32767                                                 01230022
      IVCOMP = IADN11(5)                                                01240022
      GO TO 46040                                                       01250022
36040 IVDELE = IVDELE + 1                                               01260022
      WRITE (I02,80003) IVTNUM                                          01270022
      IF (ICZERO) 46040, 6051, 46040                                    01280022
46040 IF ( IVCOMP - 32767 )  26040, 16040, 26040                        01290022
16040 IVPASS = IVPASS + 1                                               01300022
      WRITE (I02,80001) IVTNUM                                          01310022
      GO TO 6051                                                        01320022
26040 IVFAIL = IVFAIL + 1                                               01330022
      IVCORR = 32767                                                    01340022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01350022
 6051 CONTINUE                                                          01360022
      IVTNUM = 605                                                      01370022
C                                                                       01380022
C      ****  TEST 605  ****                                             01390022
C     TEST 605  -  TEST OF A SIMPLE ASSIGN WITH A NEGATIVE VALUE -32766 01400022
C                                                                       01410022
      IF (ICZERO) 36050, 6050, 36050                                    01420022
 6050 CONTINUE                                                          01430022
      IADN11(1) = -32766                                                01440022
      IVCOMP = IADN11(1)                                                01450022
      GO TO 46050                                                       01460022
36050 IVDELE = IVDELE + 1                                               01470022
      WRITE (I02,80003) IVTNUM                                          01480022
      IF (ICZERO) 46050, 6061, 46050                                    01490022
46050 IF ( IVCOMP + 32766 )  26050, 16050, 26050                        01500022
16050 IVPASS = IVPASS + 1                                               01510022
      WRITE (I02,80001) IVTNUM                                          01520022
      GO TO 6061                                                        01530022
26050 IVFAIL = IVFAIL + 1                                               01540022
      IVCORR = -32766                                                   01550022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01560022
 6061 CONTINUE                                                          01570022
      IVTNUM = 606                                                      01580022
C                                                                       01590022
C      ****  TEST 606  ****                                             01600022
C     TEST 606  -  TEST OF UNSIGNED ZERO SET TO AN ARRAY ELEMENT        01610022
C     BY A SIMPLE ASSIGNMENT STATEMENT.                                 01620022
C                                                                       01630022
      IF (ICZERO) 36060, 6060, 36060                                    01640022
 6060 CONTINUE                                                          01650022
      IADN11(3) = 0                                                     01660022
      IVCOMP = IADN11(3)                                                01670022
      GO TO 46060                                                       01680022
36060 IVDELE = IVDELE + 1                                               01690022
      WRITE (I02,80003) IVTNUM                                          01700022
      IF (ICZERO) 46060, 6071, 46060                                    01710022
46060 IF ( IVCOMP - 0 )  26060, 16060, 26060                            01720022
16060 IVPASS = IVPASS + 1                                               01730022
      WRITE (I02,80001) IVTNUM                                          01740022
      GO TO 6071                                                        01750022
26060 IVFAIL = IVFAIL + 1                                               01760022
      IVCORR = 0                                                        01770022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01780022
 6071 CONTINUE                                                          01790022
      IVTNUM = 607                                                      01800022
C                                                                       01810022
C      ****  TEST 607  ****                                             01820022
C     TEST 607  -  TEST OF A NEGATIVELY SIGNED ZERO COMPARED TO A       01830022
C     ZERO UNSIGNED BOTH VALUES SET AS INTEGER ARRAY ELEMENTS.          01840022
C                                                                       01850022
      IF (ICZERO) 36070, 6070, 36070                                    01860022
 6070 CONTINUE                                                          01870022
      IADN11(2) = -0                                                    01880022
      IADN11(3) = 0                                                     01890022
      ICON01 = 0                                                        01900022
      IF ( IADN11(2) .EQ. IADN11(3) )  ICON01 = 1                       01910022
      GO TO 46070                                                       01920022
36070 IVDELE = IVDELE + 1                                               01930022
      WRITE (I02,80003) IVTNUM                                          01940022
      IF (ICZERO) 46070, 6081, 46070                                    01950022
46070 IF ( ICON01 - 1 )  26070, 16070, 26070                            01960022
16070 IVPASS = IVPASS + 1                                               01970022
      WRITE (I02,80001) IVTNUM                                          01980022
      GO TO 6081                                                        01990022
26070 IVFAIL = IVFAIL + 1                                               02000022
      IVCOMP = ICON01                                                   02010022
      IVCORR = 1                                                        02020022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02030022
 6081 CONTINUE                                                          02040022
      IVTNUM = 608                                                      02050022
C                                                                       02060022
C      ****  TEST 608  ****                                             02070022
C     TEST 608  -  TEST OF SETTING ONE INTEGER ARRAY ELEMENT EQUAL TO   02080022
C     THE VALUE OF ANOTHER INTEGER ARRAY ELEMENT.  THE VALUE IS 32767.  02090022
C                                                                       02100022
      IF (ICZERO) 36080, 6080, 36080                                    02110022
 6080 CONTINUE                                                          02120022
      IADN11(1) = 32767                                                 02130022
      IADN12(5) = IADN11(1)                                             02140022
      IVCOMP = IADN12(5)                                                02150022
      GO TO 46080                                                       02160022
36080 IVDELE = IVDELE + 1                                               02170022
      WRITE (I02,80003) IVTNUM                                          02180022
      IF (ICZERO) 46080, 6091, 46080                                    02190022
46080 IF ( IVCOMP - 32767 )  26080, 16080, 26080                        02200022
16080 IVPASS = IVPASS + 1                                               02210022
      WRITE (I02,80001) IVTNUM                                          02220022
      GO TO 6091                                                        02230022
26080 IVFAIL = IVFAIL + 1                                               02240022
      IVCORR = 32767                                                    02250022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02260022
 6091 CONTINUE                                                          02270022
      IVTNUM = 609                                                      02280022
C                                                                       02290022
C      ****  TEST 609  ****                                             02300022
C     TEST 609  -  TEST OF AN ARRAY ELEMENT SET TO ANOTHER ARRAY ELEMENT02310022
C     WHICH HAD BEEN SET AT COMPILE TIME BY A DATA INITIALIZATION       02320022
C     STATEMENT.  AN INTEGER ARRAY IS USED WITH THE VALUE 3.            02330022
C                                                                       02340022
      IF (ICZERO) 36090, 6090, 36090                                    02350022
 6090 CONTINUE                                                          02360022
      IADN11(4) = IADN12(1)                                             02370022
      IVCOMP = IADN11(4)                                                02380022
      GO TO 46090                                                       02390022
36090 IVDELE = IVDELE + 1                                               02400022
      WRITE (I02,80003) IVTNUM                                          02410022
      IF (ICZERO) 46090, 6101, 46090                                    02420022
46090 IF ( IVCOMP - 3 )  26090, 16090, 26090                            02430022
16090 IVPASS = IVPASS + 1                                               02440022
      WRITE (I02,80001) IVTNUM                                          02450022
      GO TO 6101                                                        02460022
26090 IVFAIL = IVFAIL + 1                                               02470022
      IVCORR = 3                                                        02480022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02490022
 6101 CONTINUE                                                          02500022
      IVTNUM = 610                                                      02510022
C                                                                       02520022
C      ****  TEST 610  ****                                             02530022
C     TEST 610  -   TEST OF SETTING A REAL ARRAY ELEMENT TO A POSITIVE  02540022
C     VALUE IN A SIMPLE ASSIGNMENT STATEMENT.  VALUE IS 32767.          02550022
C                                                                       02560022
      IF (ICZERO) 36100, 6100, 36100                                    02570022
 6100 CONTINUE                                                          02580022
      RADN11(5) = 32767.                                                02590022
      IVCOMP = RADN11(5)                                                02600022
      GO TO 46100                                                       02610022
36100 IVDELE = IVDELE + 1                                               02620022
      WRITE (I02,80003) IVTNUM                                          02630022
      IF (ICZERO) 46100, 6111, 46100                                    02640022
46100 IF ( IVCOMP - 32767 )  26100, 16100, 26100                        02650022
16100 IVPASS = IVPASS + 1                                               02660022
      WRITE (I02,80001) IVTNUM                                          02670022
      GO TO 6111                                                        02680022
26100 IVFAIL = IVFAIL + 1                                               02690022
      IVCORR = 32767                                                    02700022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02710022
 6111 CONTINUE                                                          02720022
      IVTNUM = 611                                                      02730022
C                                                                       02740022
C      ****  TEST 611  ****                                             02750022
C     TEST 611  -  TEST OF SETTING A REAL ARRAY ELEMENT TO A NEGATIVE   02760022
C     VALUE IN A SIMPLE ASSIGNMENT STATEMENT.  VALUE IS -32766.         02770022
C                                                                       02780022
      IF (ICZERO) 36110, 6110, 36110                                    02790022
 6110 CONTINUE                                                          02800022
      RADN11(1) = -32766.                                               02810022
      IVCOMP = RADN11(1)                                                02820022
      GO TO 46110                                                       02830022
36110 IVDELE = IVDELE + 1                                               02840022
      WRITE (I02,80003) IVTNUM                                          02850022
      IF (ICZERO) 46110, 6121, 46110                                    02860022
46110 IF ( IVCOMP + 32766 )  26110, 16110, 26110                        02870022
16110 IVPASS = IVPASS + 1                                               02880022
      WRITE (I02,80001) IVTNUM                                          02890022
      GO TO 6121                                                        02900022
26110 IVFAIL = IVFAIL + 1                                               02910022
      IVCORR = -32766                                                   02920022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02930022
 6121 CONTINUE                                                          02940022
      IVTNUM = 612                                                      02950022
C                                                                       02960022
C      ****  TEST 612  ****                                             02970022
C     TEST 612  -  TEST OF SETTING A REAL ARRAY ELEMENT TO UNSIGNED ZERO02980022
C     IN A SIMPLE ASSIGNMENT STATEMENT.                                 02990022
C                                                                       03000022
      IF (ICZERO) 36120, 6120, 36120                                    03010022
 6120 CONTINUE                                                          03020022
      RADN11(3) = 0.                                                    03030022
      IVCOMP = RADN11(3)                                                03040022
      GO TO 46120                                                       03050022
36120 IVDELE = IVDELE + 1                                               03060022
      WRITE (I02,80003) IVTNUM                                          03070022
      IF (ICZERO) 46120, 6131, 46120                                    03080022
46120 IF ( IVCOMP - 0 )  26120, 16120, 26120                            03090022
16120 IVPASS = IVPASS + 1                                               03100022
      WRITE (I02,80001) IVTNUM                                          03110022
      GO TO 6131                                                        03120022
26120 IVFAIL = IVFAIL + 1                                               03130022
      IVCORR = 0                                                        03140022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03150022
 6131 CONTINUE                                                          03160022
      IVTNUM = 613                                                      03170022
C                                                                       03180022
C      ****  TEST 613  ****                                             03190022
C     TEST 613  -  TEST OF A NEGATIVELY SIGNED ZERO IN A REAL ARRAY     03200022
C     ELEMENT COMPARED TO A REAL ELEMENT SET TO AN UNSIGNED ZERO.       03210022
C                                                                       03220022
      IF (ICZERO) 36130, 6130, 36130                                    03230022
 6130 CONTINUE                                                          03240022
      RADN11(2) = -0.0                                                  03250022
      RADN11(3) = 0.0                                                   03260022
      ICON01 = 0                                                        03270022
      IF ( RADN11(2) .EQ. RADN11(3) )  ICON01 = 1                       03280022
      GO TO 46130                                                       03290022
36130 IVDELE = IVDELE + 1                                               03300022
      WRITE (I02,80003) IVTNUM                                          03310022
      IF (ICZERO) 46130, 6141, 46130                                    03320022
46130 IF ( ICON01 - 1 )  26130, 16130, 26130                            03330022
16130 IVPASS = IVPASS + 1                                               03340022
      WRITE (I02,80001) IVTNUM                                          03350022
      GO TO 6141                                                        03360022
26130 IVFAIL = IVFAIL + 1                                               03370022
      IVCOMP = ICON01                                                   03380022
      IVCORR = 1                                                        03390022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03400022
 6141 CONTINUE                                                          03410022
      IVTNUM = 614                                                      03420022
C                                                                       03430022
C      ****  TEST 614  ****                                             03440022
C     TEST 614  -  TEST OF SETTING ONE REAL ARRAY ELEMENT EQUAL TO THE  03450022
C     VALUE OF ANOTHER REAL ARRAY ELEMENT.  THE VALUE IS 32767.         03460022
C                                                                       03470022
      IF (ICZERO) 36140, 6140, 36140                                    03480022
 6140 CONTINUE                                                          03490022
      RADN11(1) = 32767.                                                03500022
      RADN12(5) = RADN11(1)                                             03510022
      IVCOMP = RADN12(5)                                                03520022
      GO TO 46140                                                       03530022
36140 IVDELE = IVDELE + 1                                               03540022
      WRITE (I02,80003) IVTNUM                                          03550022
      IF (ICZERO) 46140, 6151, 46140                                    03560022
46140 IF ( IVCOMP - 32767 )  26140, 16140, 26140                        03570022
16140 IVPASS = IVPASS + 1                                               03580022
      WRITE (I02,80001) IVTNUM                                          03590022
      GO TO 6151                                                        03600022
26140 IVFAIL = IVFAIL + 1                                               03610022
      IVCORR = 32767                                                    03620022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03630022
 6151 CONTINUE                                                          03640022
      IVTNUM = 615                                                      03650022
C                                                                       03660022
C      ****  TEST 615  ****                                             03670022
C     TEST 615  -  TEST OF A REAL ARRAY ELEMENT SET TO ANOTHER REAL     03680022
C     ARRAY ELEMENT WHICH HAD BEEN SET AT COMPILE TIME BY A DATA        03690022
C     INITIALIZATION STATEMENT. THE VALUE IS -512.                      03700022
C                                                                       03710022
      IF (ICZERO) 36150, 6150, 36150                                    03720022
 6150 CONTINUE                                                          03730022
      RADN11(4) = RADN12(1)                                             03740022
      IVCOMP = RADN11(4)                                                03750022
      GO TO 46150                                                       03760022
36150 IVDELE = IVDELE + 1                                               03770022
      WRITE (I02,80003) IVTNUM                                          03780022
      IF (ICZERO) 46150, 6161, 46150                                    03790022
46150 IF ( IVCOMP + 512 )  26150, 16150, 26150                          03800022
16150 IVPASS = IVPASS + 1                                               03810022
      WRITE (I02,80001) IVTNUM                                          03820022
      GO TO 6161                                                        03830022
26150 IVFAIL = IVFAIL + 1                                               03840022
      IVCORR = - 512                                                    03850022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          03860022
 6161 CONTINUE                                                          03870022
      IVTNUM = 616                                                      03880022
C                                                                       03890022
C      ****  TEST 616  ****                                             03900022
C     TEST 616  -  TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT03910022
C     BY AN ARITHMETIC EXPRESSION.                                      03920022
C                                                                       03930022
      IF (ICZERO) 36160, 6160, 36160                                    03940022
 6160 CONTINUE                                                          03950022
      ICON01 = 1                                                        03960022
      IADN11(3) = ICON01 + 1                                            03970022
      IVCOMP = IADN11(3)                                                03980022
      GO TO 46160                                                       03990022
36160 IVDELE = IVDELE + 1                                               04000022
      WRITE (I02,80003) IVTNUM                                          04010022
      IF (ICZERO) 46160, 6171, 46160                                    04020022
46160 IF ( IVCOMP - 2 )  26160, 16160, 26160                            04030022
16160 IVPASS = IVPASS + 1                                               04040022
      WRITE (I02,80001) IVTNUM                                          04050022
      GO TO 6171                                                        04060022
26160 IVFAIL = IVFAIL + 1                                               04070022
      IVCORR = 2                                                        04080022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          04090022
 6171 CONTINUE                                                          04100022
      IVTNUM = 617                                                      04110022
C                                                                       04120022
C      ****  TEST 617  ****                                             04130022
C     TEST 617  -  TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT    04140022
C     BY AN ARITHMETIC EXPRESSION.                                      04150022
C                                                                       04160022
      IF (ICZERO) 36170, 6170, 36170                                    04170022
 6170 CONTINUE                                                          04180022
      RCON01 = 1.                                                       04190022
      RADN11(3) = RCON01 + 1.                                           04200022
      IVCOMP = RADN11(3)                                                04210022
      GO TO 46170                                                       04220022
36170 IVDELE = IVDELE + 1                                               04230022
      WRITE (I02,80003) IVTNUM                                          04240022
      IF (ICZERO) 46170, 6181, 46170                                    04250022
46170 IF ( IVCOMP - 2 )  26170, 16170, 26170                            04260022
16170 IVPASS = IVPASS + 1                                               04270022
      WRITE (I02,80001) IVTNUM                                          04280022
      GO TO 6181                                                        04290022
26170 IVFAIL = IVFAIL + 1                                               04300022
      IVCORR = 2                                                        04310022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          04320022
 6181 CONTINUE                                                          04330022
      IVTNUM = 618                                                      04340022
C                                                                       04350022
C      ****  TEST 618  ****                                             04360022
C     TEST 618  -  TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT04370022
C     TO ANOTHER INTEGER ARRAY ELEMENT AND CHANGING THE SIGN.           04380022
C                                                                       04390022
      IF (ICZERO) 36180, 6180, 36180                                    04400022
 6180 CONTINUE                                                          04410022
      IADN11(2) = 32766                                                 04420022
      IADN11(4) = - IADN11(2)                                           04430022
      IVCOMP = IADN11(4)                                                04440022
      GO TO 46180                                                       04450022
36180 IVDELE = IVDELE + 1                                               04460022
      WRITE (I02,80003) IVTNUM                                          04470022
      IF (ICZERO) 46180, 6191, 46180                                    04480022
46180 IF ( IVCOMP + 32766 )  26180, 16180, 26180                        04490022
16180 IVPASS = IVPASS + 1                                               04500022
      WRITE (I02,80001) IVTNUM                                          04510022
      GO TO 6191                                                        04520022
26180 IVFAIL = IVFAIL + 1                                               04530022
      IVCORR = -32766                                                   04540022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          04550022
 6191 CONTINUE                                                          04560022
      IVTNUM = 619                                                      04570022
C                                                                       04580022
C      ****  TEST 619  ****                                             04590022
C     TEST 619  -  TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT    04600022
C     TO THE VALUE OF ANOTHER REAL ARRAY ELEMENT AND CHANGING THE SIGN. 04610022
C                                                                       04620022
      IF (ICZERO) 36190, 6190, 36190                                    04630022
 6190 CONTINUE                                                          04640022
      RADN11(2) = 32766.                                                04650022
      RADN11(4) = - RADN11(2)                                           04660022
      IVCOMP = RADN11(4)                                                04670022
      GO TO 46190                                                       04680022
36190 IVDELE = IVDELE + 1                                               04690022
      WRITE (I02,80003) IVTNUM                                          04700022
      IF (ICZERO) 46190, 6201, 46190                                    04710022
46190 IF ( IVCOMP + 32766 )  26190, 16190, 26190                        04720022
16190 IVPASS = IVPASS + 1                                               04730022
      WRITE (I02,80001) IVTNUM                                          04740022
      GO TO 6201                                                        04750022
26190 IVFAIL = IVFAIL + 1                                               04760022
      IVCORR = -32766                                                   04770022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          04780022
 6201 CONTINUE                                                          04790022
      IVTNUM = 620                                                      04800022
C                                                                       04810022
C      ****  TEST 620  ****                                             04820022
C     TEST 620  -  TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 04830022
C     TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT.                    04840022
C                                                                       04850022
      IF (ICZERO) 36200, 6200, 36200                                    04860022
 6200 CONTINUE                                                          04870022
      LADN11(1) = .TRUE.                                                04880022
      LADN12(1) = LADN11(1)                                             04890022
      ICON01 = 0                                                        04900022
      IF ( LADN12(1) )  ICON01 = 1                                      04910022
      GO TO 46200                                                       04920022
36200 IVDELE = IVDELE + 1                                               04930022
      WRITE (I02,80003) IVTNUM                                          04940022
      IF (ICZERO) 46200, 6211, 46200                                    04950022
46200 IF ( ICON01 - 1 )  26200, 16200, 26200                            04960022
16200 IVPASS = IVPASS + 1                                               04970022
      WRITE (I02,80001) IVTNUM                                          04980022
      GO TO 6211                                                        04990022
26200 IVFAIL = IVFAIL + 1                                               05000022
      IVCOMP = ICON01                                                   05010022
      IVCORR = 1                                                        05020022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          05030022
 6211 CONTINUE                                                          05040022
      IVTNUM = 621                                                      05050022
C                                                                       05060022
C      ****  TEST 621  ****                                             05070022
C     TEST 621  -  TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 05080022
C     TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT AND CHANGING        05090022
C     THE VALUE FROM  .TRUE.  TO  .FALSE. BY USING THE .NOT. STATEMENT. 05100022
C                                                                       05110022
      IF (ICZERO) 36210, 6210, 36210                                    05120022
 6210 CONTINUE                                                          05130022
      LADN11(2) = .TRUE.                                                05140022
      LADN12(2) = .NOT. LADN11(2)                                       05150022
      ICON01 = 1                                                        05160022
      IF ( LADN12(2) )  ICON01 = 0                                      05170022
      GO TO 46210                                                       05180022
36210 IVDELE = IVDELE + 1                                               05190022
      WRITE (I02,80003) IVTNUM                                          05200022
      IF (ICZERO) 46210, 6221, 46210                                    05210022
46210 IF ( ICON01 - 1 )  26210, 16210, 26210                            05220022
16210 IVPASS = IVPASS + 1                                               05230022
      WRITE (I02,80001) IVTNUM                                          05240022
      GO TO 6221                                                        05250022
26210 IVFAIL = IVFAIL + 1                                               05260022
      IVCOMP = ICON01                                                   05270022
      IVCORR = 1                                                        05280022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          05290022
 6221 CONTINUE                                                          05300022
      IVTNUM = 622                                                      05310022
C                                                                       05320022
C      ****  TEST 622  ****                                             05330022
C     TEST 622  -  TEST OF THE TYPE STATEMENT AND THE DATA              05340022
C     INITIALIZATION STATEMENT.  THE EXPLICITLY REAL ARRAY ELEMENT      05350022
C     SHOULD HAVE THE VALUE OF .5                                       05360022
C                                                                       05370022
      IF (ICZERO) 36220, 6220, 36220                                    05380022
 6220 CONTINUE                                                          05390022
      IVCOMP = 2. * IADN13(1)                                           05400022
      GO TO 46220                                                       05410022
36220 IVDELE = IVDELE + 1                                               05420022
      WRITE (I02,80003) IVTNUM                                          05430022
      IF (ICZERO) 46220, 6231, 46220                                    05440022
46220 IF ( IVCOMP - 1 )  26220, 16220, 26220                            05450022
16220 IVPASS = IVPASS + 1                                               05460022
      WRITE (I02,80001) IVTNUM                                          05470022
      GO TO 6231                                                        05480022
26220 IVFAIL = IVFAIL + 1                                               05490022
      IVCORR = 1                                                        05500022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          05510022
 6231 CONTINUE                                                          05520022
      IVTNUM = 623                                                      05530022
C                                                                       05540022
C      ****  TEST 623  ****                                             05550022
C     TEST 623  -  TEST OF REAL TO INTEGER CONVERSION USING ARRAYS.     05560022
C     THE INITIALIZED VALUE OF 0.5 SHOULD BE TRUNCATED TO ZERO.         05570022
C                                                                       05580022
      IF (ICZERO) 36230, 6230, 36230                                    05590022
 6230 CONTINUE                                                          05600022
      IADN11(1) = IADN13(1)                                             05610022
      IVCOMP = IADN11(1)                                                05620022
      GO TO 46230                                                       05630022
36230 IVDELE = IVDELE + 1                                               05640022
      WRITE (I02,80003) IVTNUM                                          05650022
      IF (ICZERO) 46230, 6241, 46230                                    05660022
46230 IF ( IVCOMP - 0 )  26230, 16230, 26230                            05670022
16230 IVPASS = IVPASS + 1                                               05680022
      WRITE (I02,80001) IVTNUM                                          05690022
      GO TO 6241                                                        05700022
26230 IVFAIL = IVFAIL + 1                                               05710022
      IVCORR = 0                                                        05720022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          05730022
 6241 CONTINUE                                                          05740022
      IVTNUM = 624                                                      05750022
C                                                                       05760022
C      ****  TEST 624  ****                                             05770022
C     TEST 624  -  TEST OF THE COMMON STATEMENT BY SETTING THE VALUE OF 05780022
C     AN INTEGER ARRAY ELEMENT IN A DIMENSIONED ARRAY TO THE VALUE      05790022
C     OF A REAL ARRAY ELEMENT IN COMMON.  THE ELEMENT IN COMMON HAD ITS 05800022
C     VALUE SET IN A SIMPLE ASSIGNMENT STATEMENT TO 9999.               05810022
C                                                                       05820022
      IF (ICZERO) 36240, 6240, 36240                                    05830022
 6240 CONTINUE                                                          05840022
      RADN14(1) = 9999.                                                 05850022
      IADN11(1) = RADN14(1)                                             05860022
      IVCOMP = IADN11(1)                                                05870022
      GO TO 46240                                                       05880022
36240 IVDELE = IVDELE + 1                                               05890022
      WRITE (I02,80003) IVTNUM                                          05900022
      IF (ICZERO) 46240, 6251, 46240                                    05910022
46240 IF ( IVCOMP - 9999 )  26240, 16240, 26240                         05920022
16240 IVPASS = IVPASS + 1                                               05930022
      WRITE (I02,80001) IVTNUM                                          05940022
      GO TO 6251                                                        05950022
26240 IVFAIL = IVFAIL + 1                                               05960022
      IVCORR = 9999                                                     05970022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          05980022
 6251 CONTINUE                                                          05990022
      IVTNUM = 625                                                      06000022
C                                                                       06010022
C      ****  TEST 625  ****                                             06020022
C     TEST 625  -  TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT06030022
C     IN COMMON TO THE VALUE OF A REAL ARRAY ELEMENT ALSO IN BLANK      06040022
C     COMMON AND CHANGING THE SIGN.  THE VALUE USED IS 9999.            06050022
C                                                                       06060022
      IF (ICZERO) 36250, 6250, 36250                                    06070022
 6250 CONTINUE                                                          06080022
      RADN14(1) = 9999.                                                 06090022
      IADN14(1) = - RADN14(1)                                           06100022
      IVCOMP = IADN14(1)                                                06110022
      GO TO 46250                                                       06120022
36250 IVDELE = IVDELE + 1                                               06130022
      WRITE (I02,80003) IVTNUM                                          06140022
      IF (ICZERO) 46250, 6261, 46250                                    06150022
46250 IF ( IVCOMP + 9999 ) 26250, 16250, 26250                          06160022
16250 IVPASS = IVPASS + 1                                               06170022
      WRITE (I02,80001) IVTNUM                                          06180022
      GO TO 6261                                                        06190022
26250 IVFAIL = IVFAIL + 1                                               06200022
      IVCORR = - 9999                                                   06210022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          06220022
 6261 CONTINUE                                                          06230022
      IVTNUM = 626                                                      06240022
C                                                                       06250022
C      ****  TEST 626  ****                                             06260022
C     TEST 626  -  TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 06270022
C     IN BLANK COMMON TO  .NOT.  .TRUE.                                 06280022
C     THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT ALSO IN COMMON IS THEN 06290022
C     SET TO .NOT. OF THE VALUE OF THE FIRST.                           06300022
C     VALUE OF THE FIRST ELEMENT SHOULD BE .FALSE.                      06310022
C     VALUE OF THE SECOND ELEMENT SHOULD BE .TRUE.                      06320022
C                                                                       06330022
      IF (ICZERO) 36260, 6260, 36260                                    06340022
 6260 CONTINUE                                                          06350022
      LADN13(1) = .NOT. .TRUE.                                          06360022
      LADN13(2) = .NOT. LADN13(1)                                       06370022
      ICON01 = 0                                                        06380022
      IF ( LADN13(2) )  ICON01 = 1                                      06390022
      GO TO 46260                                                       06400022
36260 IVDELE = IVDELE + 1                                               06410022
      WRITE (I02,80003) IVTNUM                                          06420022
      IF (ICZERO) 46260, 6271, 46260                                    06430022
46260 IF ( ICON01 - 1 )  26260, 16260, 26260                            06440022
16260 IVPASS = IVPASS + 1                                               06450022
      WRITE (I02,80001) IVTNUM                                          06460022
      GO TO 6271                                                        06470022
26260 IVFAIL = IVFAIL + 1                                               06480022
      IVCOMP = ICON01                                                   06490022
      IVCORR = 1                                                        06500022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          06510022
 6271 CONTINUE                                                          06520022
      IVTNUM = 627                                                      06530022
C                                                                       06540022
C      ****  TEST 627  ****                                             06550022
C     TEST 627  -  TEST OF EQUIVALENCE ON THE FIRST ELEMENTS OF INTEGER 06560022
C     ARRAYS ONE OF WHICH IS IN COMMON AND THE OTHER ONE IS DIMENSIONED.06570022
C                                                                       06580022
      IF (ICZERO) 36270, 6270, 36270                                    06590022
 6270 CONTINUE                                                          06600022
      IADN14(2) = 32767                                                 06610022
      IVCOMP = IADN15(2)                                                06620022
      GO TO 46270                                                       06630022
36270 IVDELE = IVDELE + 1                                               06640022
      WRITE (I02,80003) IVTNUM                                          06650022
      IF (ICZERO) 46270, 6281, 46270                                    06660022
46270 IF ( IVCOMP - 32767 )  26270, 16270, 26270                        06670022
16270 IVPASS = IVPASS + 1                                               06680022
      WRITE (I02,80001) IVTNUM                                          06690022
      GO TO 6281                                                        06700022
26270 IVFAIL = IVFAIL + 1                                               06710022
      IVCORR = 32767                                                    06720022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          06730022
 6281 CONTINUE                                                          06740022
      IVTNUM = 628                                                      06750022
C                                                                       06760022
C      ****  TEST 628  ****                                             06770022
C     TEST 628  -  TEST OF EQUIVALENCE ON REAL ARRAYS ONE OF WHICH IS   06780022
C     IN COMMON AND THE OTHER ONE IS DIMENSIONED.  THE ARRAYS WERE      06790022
C     ALIGNED ON THEIR SECOND ELEMENTS.                                 06800022
C                                                                       06810022
      IF (ICZERO) 36280, 6280, 36280                                    06820022
 6280 CONTINUE                                                          06830022
      RADN15(1) = -32766.                                               06840022
      IVCOMP = RADN14(1)                                                06850022
      GO TO 46280                                                       06860022
36280 IVDELE = IVDELE + 1                                               06870022
      WRITE (I02,80003) IVTNUM                                          06880022
      IF (ICZERO) 46280, 6291, 46280                                    06890022
46280 IF ( IVCOMP + 32766 )  26280, 16280, 26280                        06900022
16280 IVPASS = IVPASS + 1                                               06910022
      WRITE (I02,80001) IVTNUM                                          06920022
      GO TO 6291                                                        06930022
26280 IVFAIL = IVFAIL + 1                                               06940022
      IVCORR = -32766                                                   06950022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          06960022
 6291 CONTINUE                                                          06970022
      IVTNUM = 629                                                      06980022
C                                                                       06990022
C      ****  TEST 629  ****                                             07000022
C     TEST 629  -  TEST OF EQUIVALENCE WITH LOGICAL ELEMENTS.  AN ARRAY 07010022
C     ELEMENT IN COMMON IS EQUIVALENCED TO A LOGICAL VARIABLE.          07020022
C                                                                       07030022
      IF (ICZERO) 36290, 6290, 36290                                    07040022
 6290 CONTINUE                                                          07050022
      LADN13(2) = .TRUE.                                                07060022
      LCTN01 = .NOT. LADN13(2)                                          07070022
      ICON01 = 1                                                        07080022
      IF ( LADN13(1) )  ICON01 = 0                                      07090022
      GO TO 46290                                                       07100022
36290 IVDELE = IVDELE + 1                                               07110022
      WRITE (I02,80003) IVTNUM                                          07120022
      IF (ICZERO) 46290, 6301, 46290                                    07130022
46290 IF ( ICON01 - 1 )  26290, 16290, 26290                            07140022
16290 IVPASS = IVPASS + 1                                               07150022
      WRITE (I02,80001) IVTNUM                                          07160022
      GO TO 6301                                                        07170022
26290 IVFAIL = IVFAIL + 1                                               07180022
      IVCOMP = ICON01                                                   07190022
      IVCORR = 1                                                        07200022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          07210022
 6301 CONTINUE                                                          07220022
      IVTNUM = 630                                                      07230022
C                                                                       07240022
C      ****  TEST 630  ****                                             07250022
C     TEST 630  -  TEST OF EQUIVALENCE WITH REAL AND INTEGER ELEMENTS   07260022
C     WHICH ARE EQUIVALENCED TO ARRAY ELEMENTS IN COMMON.               07270022
C                                                                       07280022
      IF (ICZERO) 36300, 6300, 36300                                    07290022
 6300 CONTINUE                                                          07300022
      RCON01 = 1.                                                       07310022
      ICON02 = - RADN14(5)                                              07320022
      IVCOMP = IADN14(5)                                                07330022
      GO TO 46300                                                       07340022
36300 IVDELE = IVDELE + 1                                               07350022
      WRITE (I02,80003) IVTNUM                                          07360022
      IF (ICZERO) 46300, 6311, 46300                                    07370022
46300 IF ( IVCOMP + 1 )  26300, 16300, 26300                            07380022
16300 IVPASS = IVPASS + 1                                               07390022
      WRITE (I02,80001) IVTNUM                                          07400022
      GO TO 6311                                                        07410022
26300 IVFAIL = IVFAIL + 1                                               07420022
      IVCORR = -1                                                       07430022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          07440022
 6311 CONTINUE                                                          07450022
      IVTNUM = 631                                                      07460022
C                                                                       07470022
C      ****  TEST 631  ****                                             07480022
C     TEST 631  -  TEST OF EQUIVALENCE ON INTEGER ARRAY ELEMENTS.       07490022
C     BOTH ARRAYS ARE DIMENSIONED.  THE FOURTH ELEMENT                  07500022
C     OF THE FIRST OF THE ARRAYS SHOULD BE EQUAL TO THE THIRD ELEMENT OF07510022
C     THE SECOND ARRAY.                                                 07520022
C                                                                       07530022
      IF (ICZERO) 36310, 6310, 36310                                    07540022
 6310 CONTINUE                                                          07550022
      IADN16(4) = 9999                                                  07560022
      IVCOMP = IADN17(3)                                                07570022
      GO TO 46310                                                       07580022
36310 IVDELE = IVDELE + 1                                               07590022
      WRITE (I02,80003) IVTNUM                                          07600022
      IF (ICZERO) 46310, 6321, 46310                                    07610022
46310 IF ( IVCOMP - 9999 )  26310, 16310, 26310                         07620022
16310 IVPASS = IVPASS + 1                                               07630022
      WRITE (I02,80001) IVTNUM                                          07640022
      GO TO 6321                                                        07650022
26310 IVFAIL = IVFAIL + 1                                               07660022
      IVCORR = 9999                                                     07670022
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          07680022
 6321 CONTINUE                                                          07690022
C                                                                       07700022
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             07710022
99999 CONTINUE                                                          07720022
      WRITE (I02,90002)                                                 07730022
      WRITE (I02,90006)                                                 07740022
      WRITE (I02,90002)                                                 07750022
      WRITE (I02,90002)                                                 07760022
      WRITE (I02,90007)                                                 07770022
      WRITE (I02,90002)                                                 07780022
      WRITE (I02,90008)  IVFAIL                                         07790022
      WRITE (I02,90009) IVPASS                                          07800022
      WRITE (I02,90010) IVDELE                                          07810022
C                                                                       07820022
C                                                                       07830022
C     TERMINATE ROUTINE EXECUTION                                       07840022
      STOP                                                              07850022
C                                                                       07860022
C     FORMAT STATEMENTS FOR PAGE HEADERS                                07870022
90000 FORMAT ("1")                                                      07880022
90002 FORMAT (" ")                                                      07890022
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            07900022
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   07910022
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        07920022
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07930022
90006 FORMAT (" ",5X,"----------------------------------------------" ) 07940022
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             07950022
C                                                                       07960022
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               07970022
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        07980022
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              07990022
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             08000022
C                                                                       08010022
C     FORMAT STATEMENTS FOR TEST RESULTS                                08020022
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      08030022
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      08040022
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   08050022
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         08060022
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    08070022
C                                                                       08080022
90007 FORMAT (" ",20X,"END OF PROGRAM FM022" )                          08090022
      END                                                               08100022