FM829.f Source File


Contents

Source Code


Source Code

      PROGRAM FM829

C***********************************************************************00010829
C*****  FORTRAN 77                                                      00020829
C*****   FM829                                                          00030829
C*****                       YGEN1 - (206)                              00040829
C*****                                                                  00050829
C***********************************************************************00060829
C*****  TESTING OF GENERIC FUNCTIONS                            ANS REF 00070829
C*****          INT, REAL, DBLE, CMPLX                           15.3   00080829
C*****                                                          TABLE 5 00090829
CBB** ********************** BBCCOMNT **********************************00100829
C****                                                                   00110829
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120829
C****                          VERSION 2.1                              00130829
C****                                                                   00140829
C****                                                                   00150829
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160829
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00170829
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00180829
C****                      BUILDING 225  RM A266                        00190829
C****                     GAITHERSBURG, MD  20899                       00200829
C****                                                                   00210829
C****                                                                   00220829
C****                                                                   00230829
CBE** ********************** BBCCOMNT **********************************00240829
C*****                                                                  00250829
C*****  S P E C I F I C A T I O N S  SEGMENT 206                        00260829
        DOUBLE PRECISION AVD, BVD, CVD, DVCORR                          00270829
        COMPLEX AVC, BVC, CVC, ZVCORR                                   00280829
        REAL R2E(2)                                                     00290829
        EQUIVALENCE (BVC, R2E)                                          00300829
C*****                                                                  00310829
CBB** ********************** BBCINITA **********************************00320829
C**** SPECIFICATION STATEMENTS                                          00330829
C****                                                                   00340829
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00350829
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00360829
CBE** ********************** BBCINITA **********************************00370829
CBB** ********************** BBCINITB **********************************00380829
C**** INITIALIZE SECTION                                                00390829
      DATA  ZVERS,                  ZVERSD,             ZDATE           00400829
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00410829
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00420829
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00430829
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00440829
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00450829
      DATA   REMRKS /'                               '/                 00460829
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00470829
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00480829
C****                                                                   00490829
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00500829
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00510829
CZ03  ZPROG  = 'PROGRAM NAME'                                           00520829
CZ04  ZDATE  = 'DATE OF TEST'                                           00530829
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00540829
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00550829
CZ07  ZNAME  = 'NAME OF USER'                                           00560829
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00570829
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00580829
C                                                                       00590829
      IVPASS = 0                                                        00600829
      IVFAIL = 0                                                        00610829
      IVDELE = 0                                                        00620829
      IVINSP = 0                                                        00630829
      IVTOTL = 0                                                        00640829
      IVTOTN = 0                                                        00650829
      ICZERO = 0                                                        00660829
C                                                                       00670829
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00680829
      I01 = 05                                                          00690829
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00700829
      I02 = 06                                                          00710829
C                                                                       00720829
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730829
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00740829
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00750829
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00760829
C                                                                       00770829
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00780829
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00790829
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00800829
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00810829
C                                                                       00820829
CBE** ********************** BBCINITB **********************************00830829
      NUVI = I02                                                        00840829
      IVTOTL = 35                                                       00850829
      ZPROG = 'FM829'                                                   00860829
CBB** ********************** BBCHED0A **********************************00870829
C****                                                                   00880829
C**** WRITE REPORT TITLE                                                00890829
C****                                                                   00900829
      WRITE (I02, 90002)                                                00910829
      WRITE (I02, 90006)                                                00920829
      WRITE (I02, 90007)                                                00930829
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00940829
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00950829
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00960829
CBE** ********************** BBCHED0A **********************************00970829
C*****                                                                  00980829
C*****    HEADER FOR SEGMENT 206                                        00990829
        WRITE(NUVI,20600)                                               01000829
20600   FORMAT( " ", /  " YGEN1 - (206) GENERIC FUNCTIONS --" //        01010829
     1          "  INT, REAL, DBLE, CMPLX" //                           01020829
     2          "  ANS REF. - 15.3" )                                   01030829
CBB** ********************** BBCHED0B **********************************01040829
C**** WRITE DETAIL REPORT HEADERS                                       01050829
C****                                                                   01060829
      WRITE (I02,90004)                                                 01070829
      WRITE (I02,90004)                                                 01080829
      WRITE (I02,90013)                                                 01090829
      WRITE (I02,90014)                                                 01100829
      WRITE (I02,90015) IVTOTL                                          01110829
CBE** ********************** BBCHED0B **********************************01120829
C*****                                                                  01130829
CT001*  TEST 1                          TEST OF INT                     01140829
C*****                                          WITH INTEGER ARG        01150829
           IVTNUM = 1                                                   01160829
        LVI = INT(485)                                                  01170829
           IF (LVI -   485) 20010, 10010, 20010                         01180829
10010      IVPASS = IVPASS + 1                                          01190829
           WRITE (NUVI, 80002) IVTNUM                                   01200829
           GO TO 0011                                                   01210829
20010      IVFAIL = IVFAIL + 1                                          01220829
           IVCORR =   485                                               01230829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01240829
 0011      CONTINUE                                                     01250829
CT002*  TEST 2                                  WITH DOUBLE PREC ARG    01260829
           IVTNUM = 2                                                   01270829
        LVI = INT(1.375D0)                                              01280829
           IF (LVI -     1) 20020, 10020, 20020                         01290829
10020      IVPASS = IVPASS + 1                                          01300829
           WRITE (NUVI, 80002) IVTNUM                                   01310829
           GO TO 0021                                                   01320829
20020      IVFAIL = IVFAIL + 1                                          01330829
           IVCORR =     1                                               01340829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01350829
 0021      CONTINUE                                                     01360829
CT003*  TEST 3                                  WITH COMPLEX ARG        01370829
           IVTNUM = 3                                                   01380829
        LVI = INT((1.24, 5.67))                                         01390829
           IF (LVI -     1) 20030, 10030, 20030                         01400829
10030      IVPASS = IVPASS + 1                                          01410829
           WRITE (NUVI, 80002) IVTNUM                                   01420829
           GO TO 0031                                                   01430829
20030      IVFAIL = IVFAIL + 1                                          01440829
           IVCORR =     1                                               01450829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01460829
 0031      CONTINUE                                                     01470829
CT004*  TEST 4                          TEST OF INT AND IFIX            01480829
C*****                                          WITH REAL ARGS          01490829
           IVTNUM = 4                                                   01500829
        LVI = INT(6.0001) + IFIX(-1.750)                                01510829
           IF (LVI -     5) 20040, 10040, 20040                         01520829
10040      IVPASS = IVPASS + 1                                          01530829
           WRITE (NUVI, 80002) IVTNUM                                   01540829
           GO TO 0041                                                   01550829
20040      IVFAIL = IVFAIL + 1                                          01560829
           IVCORR =     5                                               01570829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01580829
 0041      CONTINUE                                                     01590829
CT005*  TEST 5                          TEST OF INT AND IDINT           01600829
C*****                                          WITH DOUBLE PREC ARGS   01610829
           IVTNUM = 5                                                   01620829
        AVD = -1.11D1                                                   01630829
        LVI = INT(AVD) * IDINT(3.5D0)                                   01640829
           IF (LVI +    33) 20050, 10050, 20050                         01650829
10050      IVPASS = IVPASS + 1                                          01660829
           WRITE (NUVI, 80002) IVTNUM                                   01670829
           GO TO 0051                                                   01680829
20050      IVFAIL = IVFAIL + 1                                          01690829
           IVCORR =   -33                                               01700829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01710829
 0051      CONTINUE                                                     01720829
CT006*  TEST 6             INTEGER, REAL, DOUBLE PRECISION, AND COMPLEX 01730829
C*****                                                        ARGUMENTS 01740829
           IVTNUM = 6                                                   01750829
        LVI = INT(-327) + INT(6.75) * INT(123) - INT(6.0001D0)          01760829
     1        / IFIX(13.3) + INT((2.4, 3.5)) + IDINT(-3.375D0)          01770829
           IF (LVI -   410) 20060, 10060, 20060                         01780829
10060      IVPASS = IVPASS + 1                                          01790829
           WRITE (NUVI, 80002) IVTNUM                                   01800829
           GO TO 0061                                                   01810829
20060      IVFAIL = IVFAIL + 1                                          01820829
           IVCORR =   410                                               01830829
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01840829
 0061      CONTINUE                                                     01850829
CT007*  TEST 7                          TEST OF REAL                    01860829
C*****                                          WITH REAL ARG           01870829
           IVTNUM = 7                                                   01880829
        AVS = -3.0                                                      01890829
        BVS = REAL(AVS)                                                 01900829
           IF (BVS +  0.30002E+01) 20070, 10070, 40070                  01910829
40070      IF (BVS +  0.29998E+01) 10070, 10070, 20070                  01920829
10070      IVPASS = IVPASS + 1                                          01930829
           WRITE (NUVI, 80002) IVTNUM                                   01940829
           GO TO 0071                                                   01950829
20070      IVFAIL = IVFAIL + 1                                          01960829
           RVCORR = -3.0                                                01970829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      01980829
 0071      CONTINUE                                                     01990829
CT008*  TEST 8                                  WITH DOUBLE PRECISION   02000829
           IVTNUM = 8                                                   02010829
        AVD = 0.96875D0                                                 02020829
        BVS = REAL(AVD)                                                 02030829
           IF (BVS -  0.96870E+00) 20080, 10080, 40080                  02040829
40080      IF (BVS -  0.96880E+00) 10080, 10080, 20080                  02050829
10080      IVPASS = IVPASS + 1                                          02060829
           WRITE (NUVI, 80002) IVTNUM                                   02070829
           GO TO 0081                                                   02080829
20080      IVFAIL = IVFAIL + 1                                          02090829
           RVCORR = 0.96875                                             02100829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      02110829
 0081      CONTINUE                                                     02120829
CT009*  TEST 9                                  WITH COMPLEX            02130829
           IVTNUM = 9                                                   02140829
        BVS = REAL((2.5, -3.0))                                         02150829
           IF (BVS -  0.24998E+01) 20090, 10090, 40090                  02160829
40090      IF (BVS -  0.25002E+01) 10090, 10090, 20090                  02170829
10090      IVPASS = IVPASS + 1                                          02180829
           WRITE (NUVI, 80002) IVTNUM                                   02190829
           GO TO 0091                                                   02200829
20090      IVFAIL = IVFAIL + 1                                          02210829
           RVCORR = 2.5                                                 02220829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      02230829
 0091      CONTINUE                                                     02240829
CT010*  TEST 10                         TEST OF REAL AND FLOAT          02250829
           IVTNUM = 10                                                  02260829
        BVS = REAL(6) + FLOAT(8)                                        02270829
           IF (BVS -  0.13999E+02) 20100, 10100, 40100                  02280829
40100      IF (BVS -  0.14001E+02) 10100, 10100, 20100                  02290829
10100      IVPASS = IVPASS + 1                                          02300829
           WRITE (NUVI, 80002) IVTNUM                                   02310829
           GO TO 0101                                                   02320829
20100      IVFAIL = IVFAIL + 1                                          02330829
           RVCORR = 14.0                                                02340829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      02350829
 0101      CONTINUE                                                     02360829
CT011*  TEST 11                         TEST OF REAL AND SNGL           02370829
           IVTNUM = 11                                                  02380829
        AVD = 2.5D0                                                     02390829
        BVS = REAL(AVD) + SNGL(0.35875D2)                               02400829
           IF (BVS -  0.38373E+02) 20110, 10110, 40110                  02410829
40110      IF (BVS -  0.38377E+02) 10110, 10110, 20110                  02420829
10110      IVPASS = IVPASS + 1                                          02430829
           WRITE (NUVI, 80002) IVTNUM                                   02440829
           GO TO 0111                                                   02450829
20110      IVFAIL = IVFAIL + 1                                          02460829
           RVCORR = 38.375                                              02470829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      02480829
 0111      CONTINUE                                                     02490829
CT012*  TEST 12                         TEST OF REAL, FLOAT, AND SNGL   02500829
           IVTNUM = 12                                                  02510829
        BVS = REAL(13) + FLOAT(9) * SNGL(0.7625D1) - REAL(2.625D0) +    02520829
     1          REAL(3.5) / REAL((2.0, 4.0))                            02530829
           IF (BVS -  0.80746E+02) 20120, 10120, 40120                  02540829
40120      IF (BVS -  0.80754E+02) 10120, 10120, 20120                  02550829
10120      IVPASS = IVPASS + 1                                          02560829
           WRITE (NUVI, 80002) IVTNUM                                   02570829
           GO TO 0121                                                   02580829
20120      IVFAIL = IVFAIL + 1                                          02590829
           RVCORR = 80.75                                               02600829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      02610829
 0121      CONTINUE                                                     02620829
CT013*  TEST 13                         TEST OF DBLE                    02630829
C*****                                          WITH INTEGER ARG        02640829
           IVTNUM = 13                                                  02650829
        LVI = 9                                                         02660829
        BVD = DBLE(LVI)                                                 02670829
           IF (BVD -  0.89995D+01) 20130, 10130, 40130                  02680829
40130      IF (BVD -  0.90005D+01) 10130, 10130, 20130                  02690829
10130      IVPASS = IVPASS + 1                                          02700829
           WRITE (NUVI, 80002) IVTNUM                                   02710829
           GO TO 0131                                                   02720829
20130      IVFAIL = IVFAIL + 1                                          02730829
           DVCORR = 9.0D0                                               02740829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      02750829
 0131      CONTINUE                                                     02760829
CT014*  TEST 14                                 WITH REAL ARG           02770829
           IVTNUM = 14                                                  02780829
        AVS = 10.5                                                      02790829
        BVD = DBLE(AVS)                                                 02800829
           IF (BVD -  0.10499D+02) 20140, 10140, 40140                  02810829
40140      IF (BVD -  0.10501D+02) 10140, 10140, 20140                  02820829
10140      IVPASS = IVPASS + 1                                          02830829
           WRITE (NUVI, 80002) IVTNUM                                   02840829
           GO TO 0141                                                   02850829
20140      IVFAIL = IVFAIL + 1                                          02860829
           DVCORR = 10.5D0                                              02870829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      02880829
 0141      CONTINUE                                                     02890829
CT015*  TEST 15                                 WITH DOUBLE PREC ARG    02900829
           IVTNUM = 15                                                  02910829
        AVD = 9.9D0                                                     02920829
        BVD = DBLE(AVD)                                                 02930829
           IF (BVD -  0.9899999995D+01) 20150, 10150, 40150             02940829
40150      IF (BVD -  0.9900000005D+01) 10150, 10150, 20150             02950829
10150      IVPASS = IVPASS + 1                                          02960829
           WRITE (NUVI, 80002) IVTNUM                                   02970829
           GO TO 0151                                                   02980829
20150      IVFAIL = IVFAIL + 1                                          02990829
           DVCORR = 9.9D0                                               03000829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      03010829
 0151      CONTINUE                                                     03020829
CT016*  TEST 16                                 WITH COMPLEX ARG        03030829
           IVTNUM = 16                                                  03040829
        AVC = (2.5, 5.5)                                                03050829
        BVD = DBLE(AVC)                                                 03060829
           IF (BVD -  0.24998D+01) 20160, 10160, 40160                  03070829
40160      IF (BVD -  0.25002D+01) 10160, 10160, 20160                  03080829
10160      IVPASS = IVPASS + 1                                          03090829
           WRITE (NUVI, 80002) IVTNUM                                   03100829
           GO TO 0161                                                   03110829
20160      IVFAIL = IVFAIL + 1                                          03120829
           DVCORR = 2.5D0                                               03130829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      03140829
 0161      CONTINUE                                                     03150829
CT017*  TEST 17                         TEST OF CMPLX WITH ONE ARG      03160829
C*****                                          WITH INTEGER ARG        03170829
           IVTNUM = 17                                                  03180829
        BVC = CMPLX(9)                                                  03190829
           IF (R2E(1) -  0.89995E+01) 20170, 40172, 40171               03200829
40171      IF (R2E(1) -  0.90005E+01) 40172, 40172, 20170               03210829
40172      IF (R2E(2) +  0.50000E-04) 20170, 10170, 40170               03220829
40170      IF (R2E(2) -  0.50000E-04) 10170, 10170, 20170               03230829
10170      IVPASS = IVPASS + 1                                          03240829
           WRITE (NUVI, 80002) IVTNUM                                   03250829
           GO TO 0171                                                   03260829
20170      IVFAIL = IVFAIL + 1                                          03270829
           ZVCORR = (9,0)                                               03280829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      03290829
 0171      CONTINUE                                                     03300829
CT018*  TEST 18                                 WITH REAL               03310829
           IVTNUM = 18                                                  03320829
        BVC = CMPLX(4.093)                                              03330829
           IF (R2E(1) -  0.40928E+01) 20180, 40182, 40181               03340829
40181      IF (R2E(1) -  0.40932E+01) 40182, 40182, 20180               03350829
40182      IF (R2E(2) +  0.50000E-04) 20180, 10180, 40180               03360829
40180      IF (R2E(2) -  0.50000E-04) 10180, 10180, 20180               03370829
10180      IVPASS = IVPASS + 1                                          03380829
           WRITE (NUVI, 80002) IVTNUM                                   03390829
           GO TO 0181                                                   03400829
20180      IVFAIL = IVFAIL + 1                                          03410829
           ZVCORR = (4.093,0.0)                                         03420829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      03430829
 0181      CONTINUE                                                     03440829
CT019*  TEST 19                                 WITH DOUBLE PREC ARG    03450829
           IVTNUM = 19                                                  03460829
        AVD = 0.375D-3                                                  03470829
        BVC = CMPLX(AVD)                                                03480829
           IF (R2E(1) -  0.37498E-03) 20190, 40192, 40191               03490829
40191      IF (R2E(1) -  0.37502E-03) 40192, 40192, 20190               03500829
40192      IF (R2E(2) +  0.50000E-04) 20190, 10190, 40190               03510829
40190      IF (R2E(2) -  0.50000E-04) 10190, 10190, 20190               03520829
10190      IVPASS = IVPASS + 1                                          03530829
           WRITE (NUVI, 80002) IVTNUM                                   03540829
           GO TO 0191                                                   03550829
20190      IVFAIL = IVFAIL + 1                                          03560829
           ZVCORR = (0.375E-3, 0.0E0)                                   03570829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      03580829
 0191      CONTINUE                                                     03590829
CT020*  TEST 20                                 WITH COMPLEX            03600829
           IVTNUM = 20                                                  03610829
        AVC = (4.5, 1.2)                                                03620829
        BVC = CMPLX(AVC)                                                03630829
           IF (R2E(1) -  0.44997E+01) 20200, 40202, 40201               03640829
40201      IF (R2E(1) -  0.45003E+01) 40202, 40202, 20200               03650829
40202      IF (R2E(2) -  0.11999E+01) 20200, 10200, 40200               03660829
40200      IF (R2E(2) -  0.12001E+01) 10200, 10200, 20200               03670829
10200      IVPASS = IVPASS + 1                                          03680829
           WRITE (NUVI, 80002) IVTNUM                                   03690829
           GO TO 0201                                                   03700829
20200      IVFAIL = IVFAIL + 1                                          03710829
           ZVCORR = (4.5, 1.2)                                          03720829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      03730829
 0201      CONTINUE                                                     03740829
CT021*  TEST 21                         TEST OF CMPLX WITH TWO ARGS     03750829
C*****                                          WITH INTEGER ARGS       03760829
           IVTNUM = 21                                                  03770829
        BVC = CMPLX(3, 1)                                               03780829
           IF (R2E(1) -  0.29998E+01) 20210, 40212, 40211               03790829
40211      IF (R2E(1) -  0.30002E+01) 40212, 40212, 20210               03800829
40212      IF (R2E(2) -  0.99995E+00) 20210, 10210, 40210               03810829
40210      IF (R2E(2) -  0.10001E+01) 10210, 10210, 20210               03820829
10210      IVPASS = IVPASS + 1                                          03830829
           WRITE (NUVI, 80002) IVTNUM                                   03840829
           GO TO 0211                                                   03850829
20210      IVFAIL = IVFAIL + 1                                          03860829
           ZVCORR = (3.0, 1.0)                                          03870829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      03880829
 0211      CONTINUE                                                     03890829
CT022*  TEST 22                                 WITH REAL ARGS          03900829
           IVTNUM = 22                                                  03910829
        BVC = CMPLX(8.34, 634.3)                                        03920829
           IF (R2E(1) -  0.83395E+01) 20220, 40222, 40221               03930829
40221      IF (R2E(1) -  0.83405E+01) 40222, 40222, 20220               03940829
40222      IF (R2E(2) -  0.63426E+03) 20220, 10220, 40220               03950829
40220      IF (R2E(2) -  0.63434E+03) 10220, 10220, 20220               03960829
10220      IVPASS = IVPASS + 1                                          03970829
           WRITE (NUVI, 80002) IVTNUM                                   03980829
           GO TO 0221                                                   03990829
20220      IVFAIL = IVFAIL + 1                                          04000829
           ZVCORR = (8.34, 634.3)                                       04010829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      04020829
 0221      CONTINUE                                                     04030829
CT023*  TEST 23                                 WITH DOUBLE PREC ARGS   04040829
           IVTNUM = 23                                                  04050829
        AVD = 0.96875D0                                                 04060829
        BVD = 3.5D-1                                                    04070829
        BVC = CMPLX(AVD, BVD)                                           04080829
           IF (R2E(1) -  0.96870E+00) 20230, 40232, 40231               04090829
40231      IF (R2E(1) -  0.96880E+00) 40232, 40232, 20230               04100829
40232      IF (R2E(2) -  0.34998E+00) 20230, 10230, 40230               04110829
40230      IF (R2E(2) -  0.35002E+00) 10230, 10230, 20230               04120829
10230      IVPASS = IVPASS + 1                                          04130829
           WRITE (NUVI, 80002) IVTNUM                                   04140829
           GO TO 0231                                                   04150829
20230      IVFAIL = IVFAIL + 1                                          04160829
           ZVCORR = (0.96875, 0.35)                                     04170829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      04180829
 0231      CONTINUE                                                     04190829
CT024*  TEST 24                         TEST OF INT AND =               04200829
C*****                                          WITH REAL EXPR          04210829
           IVTNUM = 24                                                  04220829
        CVS = 0.0                                                       04230829
        CVD = 0.0D0                                                     04240829
        CVC = (0.0,0.0)                                                 04250829
        LVI = 0                                                         04260829
        AVS = 5.0                                                       04270829
        IVI = 1.0 * 5.0 + 6.0                                           04280829
        KVI = LVI + INT(1.0 * AVS + 6.0)                                04290829
           IF (KVI -    11) 20240, 10240, 20240                         04300829
10240      IVPASS = IVPASS + 1                                          04310829
           WRITE (NUVI, 80002) IVTNUM                                   04320829
           GO TO 0241                                                   04330829
20240      IVFAIL = IVFAIL + 1                                          04340829
           IVCORR =    11                                               04350829
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR                      04360829
 0241      CONTINUE                                                     04370829
CT025*  TEST 25                                 WITH DOUBLE PREC EXPR   04380829
           IVTNUM = 25                                                  04390829
        AVD = 3.48D0                                                    04400829
        IVI = 3.48D0 * 47.98D0                                          04410829
        KVI = LVI + INT(AVD * 47.98D0)                                  04420829
           IF (KVI -   166) 20250, 10250, 20250                         04430829
10250      IVPASS = IVPASS + 1                                          04440829
           WRITE (NUVI, 80002) IVTNUM                                   04450829
           GO TO 0251                                                   04460829
20250      IVFAIL = IVFAIL + 1                                          04470829
           IVCORR =   166                                               04480829
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR                      04490829
 0251      CONTINUE                                                     04500829
CT026*  TEST 26                                 WITH COMPLEX EXPR       04510829
           IVTNUM = 26                                                  04520829
        AVC = (3.9, 5.0)                                                04530829
        IVI = (3.4, 4.5) + (3.9, 5.0)                                   04540829
        KVI = LVI + INT((3.4, 4.5) + AVC)                               04550829
           IF (KVI -     7) 20260, 10260, 20260                         04560829
10260      IVPASS = IVPASS + 1                                          04570829
           WRITE (NUVI, 80002) IVTNUM                                   04580829
           GO TO 0261                                                   04590829
20260      IVFAIL = IVFAIL + 1                                          04600829
           IVCORR =     7                                               04610829
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR                      04620829
 0261      CONTINUE                                                     04630829
CT027*  TEST 27                         TEST OF REAL AND =              04640829
C*****                                          WITH INT EXPR           04650829
           IVTNUM = 27                                                  04660829
        IVI = 20                                                        04670829
        AVS = 20 + 34 / 20                                              04680829
        BVS = CVS + REAL(IVI + 34 / IVI)                                04690829
           IF (BVS -  0.20999E+02) 20270, 10270, 40270                  04700829
40270      IF (BVS -  0.21001E+02) 10270, 10270, 20270                  04710829
10270      IVPASS = IVPASS + 1                                          04720829
           WRITE (NUVI, 80002) IVTNUM                                   04730829
           GO TO 0271                                                   04740829
20270      IVFAIL = IVFAIL + 1                                          04750829
           RVCORR = 21.0                                                04760829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      04770829
 0271      CONTINUE                                                     04780829
CT028*  TEST 28                                 WITH DOUBLE PREC EXPR   04790829
           IVTNUM = 28                                                  04800829
        JVI = 28                                                        04810829
        AVD = 0.9834D0                                                  04820829
        AVS = 3.0748D0 / 0.9834D0                                       04830829
        BVS = CVS + REAL(3.0748D0 / AVD)                                04840829
           IF (BVS -  0.31265E+01) 20280, 10280, 40280                  04850829
40280      IF (BVS -  0.31269E+01) 10280, 10280, 20280                  04860829
10280      IVPASS = IVPASS + 1                                          04870829
           WRITE (NUVI, 80002) IVTNUM                                   04880829
           GO TO 0281                                                   04890829
20280      IVFAIL = IVFAIL + 1                                          04900829
           RVCORR = 3.1267033                                           04910829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      04920829
 0281      CONTINUE                                                     04930829
CT029*  TEST 29                                 WITH COMPLEX            04940829
           IVTNUM = 29                                                  04950829
        JVI = 29                                                        04960829
        AVC = (1.0, 384.9)                                              04970829
        AVS = (3.495, 98.734) * (1.0, 384.9)                            04980829
        BVS = CVS + REAL((3.495, 98.734) * AVC)                         04990829
           IF (BVS +  0.38001E+05) 20290, 10290, 40290                  05000829
40290      IF (BVS +  0.37997E+05) 10290, 10290, 20290                  05010829
10290      IVPASS = IVPASS + 1                                          05020829
           WRITE (NUVI, 80002) IVTNUM                                   05030829
           GO TO 0291                                                   05040829
20290      IVFAIL = IVFAIL + 1                                          05050829
           RVCORR = -37999.222                                          05060829
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR                      05070829
 0291      CONTINUE                                                     05080829
CT030*  TEST 30                         TEST OF DBLE AND =              05090829
C*****                                          WITH INTEGER EXPR       05100829
           IVTNUM = 30                                                  05110829
        JVI = 30                                                        05120829
        IVI = 5                                                         05130829
        AVD = 1 * 5 + 6                                                 05140829
        BVD = CVD + DBLE(1 * IVI + 6)                                   05150829
           IF (BVD -  0.10999D+02) 20300, 10300, 40300                  05160829
40300      IF (BVD -  0.11001D+02) 10300, 10300, 20300                  05170829
10300      IVPASS = IVPASS + 1                                          05180829
           WRITE (NUVI, 80002) IVTNUM                                   05190829
           GO TO 0301                                                   05200829
20300      IVFAIL = IVFAIL + 1                                          05210829
           DVCORR = .11000000D+02                                       05220829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      05230829
 0301      CONTINUE                                                     05240829
CT031*  TEST 31                                 WITH REAL EXPR          05250829
           IVTNUM = 31                                                  05260829
        JVI = 31                                                        05270829
        AVS = -4.5                                                      05280829
        AVD = 1.3 / (-4.5)                                              05290829
        BVD = CVD + DBLE(1.3 / AVS)                                     05300829
           IF (BVD +  0.28891D+00) 20310, 10310, 40310                  05310829
40310      IF (BVD +  0.28887D+00) 10310, 10310, 20310                  05320829
10310      IVPASS = IVPASS + 1                                          05330829
           WRITE (NUVI, 80002) IVTNUM                                   05340829
           GO TO 0311                                                   05350829
20310      IVFAIL = IVFAIL + 1                                          05360829
           DVCORR = -0.288888888888888889D+00                           05370829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      05380829
 0311      CONTINUE                                                     05390829
CT032*  TEST 32                                 WITH COMPLEX EXPR       05400829
           IVTNUM = 32                                                  05410829
        JVI = 32                                                        05420829
        AVC = (3.9, 5.0)                                                05430829
        AVD = (3.4, 4.5) + (3.9, 5.0)                                   05440829
        BVD = CVD + DBLE((3.4, 4.5) + AVC)                              05450829
           IF (BVD -  0.72996D+01) 20320, 10320, 40320                  05460829
40320      IF (BVD -  0.73004D+01) 10320, 10320, 20320                  05470829
10320      IVPASS = IVPASS + 1                                          05480829
           WRITE (NUVI, 80002) IVTNUM                                   05490829
           GO TO 0321                                                   05500829
20320      IVFAIL = IVFAIL + 1                                          05510829
           DVCORR = .73000000D+01                                       05520829
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR                      05530829
 0321      CONTINUE                                                     05540829
CT033*  TEST 33                         TEST OF CMPLX AND =             05550829
C*****                                          WITH INTEGER EXPR       05560829
           IVTNUM = 33                                                  05570829
        JVI = 33                                                        05580829
        IVI = 673                                                       05590829
        AVC = 394 - 673                                                 05600829
        BVC = CVC + CMPLX(394 - IVI)                                    05610829
           IF (R2E(1) +  0.27902E+03) 20330, 40332, 40331               05620829
40331      IF (R2E(1) +  0.27898E+03) 40332, 40332, 20330               05630829
40332      IF (R2E(2) +  0.50000E-04) 20330, 10330, 40330               05640829
40330      IF (R2E(2) -  0.50000E-04) 10330, 10330, 20330               05650829
10330      IVPASS = IVPASS + 1                                          05660829
           WRITE (NUVI, 80002) IVTNUM                                   05670829
           GO TO 0331                                                   05680829
20330      IVFAIL = IVFAIL + 1                                          05690829
           ZVCORR = (-279.00000, .00000000)                             05700829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      05710829
 0331      CONTINUE                                                     05720829
CT034*  TEST 34                                 WITH REAL EXPR          05730829
           IVTNUM = 34                                                  05740829
        JVI = 34                                                        05750829
        AVS = 3.48                                                      05760829
        AVC = 3.48 * 47.98                                              05770829
        BVC = CVC + CMPLX(AVS * 47.98)                                  05780829
           IF (R2E(1) -  0.16696E+03) 20340, 40342, 40341               05790829
40341      IF (R2E(1) -  0.16698E+03) 40342, 40342, 20340               05800829
40342      IF (R2E(2) +  0.50000E-04) 20340, 10340, 40340               05810829
40340      IF (R2E(2) -  0.50000E-04) 10340, 10340, 20340               05820829
10340      IVPASS = IVPASS + 1                                          05830829
           WRITE (NUVI, 80002) IVTNUM                                   05840829
           GO TO 0341                                                   05850829
20340      IVFAIL = IVFAIL + 1                                          05860829
           ZVCORR = (166.97040, .00000000)                              05870829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      05880829
 0341      CONTINUE                                                     05890829
CT035*  TEST 35                                                         05900829
           IVTNUM = 35                                                  05910829
        JVI = 35                                                        05920829
        AVD = 0.94D1                                                    05930829
        AVC = 3.0283D3 / 0.94D1                                         05940829
        BVC = CVC + CMPLX(3.0283D3 / AVD)                               05950829
           IF (R2E(1) -  0.32214E+03) 20350, 40352, 40351               05960829
40351      IF (R2E(1) -  0.32218E+03) 40352, 40352, 20350               05970829
40352      IF (R2E(2) +  0.50000E-04) 20350, 10350, 40350               05980829
40350      IF (R2E(2) -  0.50000E-04) 10350, 10350, 20350               05990829
10350      IVPASS = IVPASS + 1                                          06000829
           WRITE (NUVI, 80002) IVTNUM                                   06010829
           GO TO 0351                                                   06020829
20350      IVFAIL = IVFAIL + 1                                          06030829
           ZVCORR = (322.15957, .000000000)                             06040829
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR                      06050829
 0351      CONTINUE                                                     06060829
C*****                                                                  06070829
CBB** ********************** BBCSUM0  **********************************06080829
C**** WRITE OUT TEST SUMMARY                                            06090829
C****                                                                   06100829
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        06110829
      WRITE (I02, 90004)                                                06120829
      WRITE (I02, 90014)                                                06130829
      WRITE (I02, 90004)                                                06140829
      WRITE (I02, 90020) IVPASS                                         06150829
      WRITE (I02, 90022) IVFAIL                                         06160829
      WRITE (I02, 90024) IVDELE                                         06170829
      WRITE (I02, 90026) IVINSP                                         06180829
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 06190829
CBE** ********************** BBCSUM0  **********************************06200829
CBB** ********************** BBCFOOT0 **********************************06210829
C**** WRITE OUT REPORT FOOTINGS                                         06220829
C****                                                                   06230829
      WRITE (I02,90016) ZPROG, ZPROG                                    06240829
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     06250829
      WRITE (I02,90019)                                                 06260829
CBE** ********************** BBCFOOT0 **********************************06270829
CBB** ********************** BBCFMT0A **********************************06280829
C**** FORMATS FOR TEST DETAIL LINES                                     06290829
C****                                                                   06300829
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           06310829
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           06320829
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           06330829
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           06340829
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           06350829
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    06360829
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06370829
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              06380829
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06390829
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  06400829
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         06410829
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         06420829
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         06430829
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         06440829
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      06450829
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      06460829
80050 FORMAT (" ",48X,A31)                                              06470829
CBE** ********************** BBCFMT0A **********************************06480829
CBB** ********************** BBCFMAT1 **********************************06490829
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     06500829
C****                                                                   06510829
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06520829
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            06530829
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     06540829
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     06550829
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    06560829
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    06570829
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    06580829
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    06590829
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06600829
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  06610829
     2"(",F12.5,", ",F12.5,")")                                         06620829
CBE** ********************** BBCFMAT1 **********************************06630829
CBB** ********************** BBCFMT0B **********************************06640829
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                06650829
C****                                                                   06660829
90002 FORMAT ("1")                                                      06670829
90004 FORMAT (" ")                                                      06680829
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06690829
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            06700829
90008 FORMAT (" ",21X,A13,A17)                                          06710829
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       06720829
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    06730829
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     06740829
     1       7X,"REMARKS",24X)                                          06750829
90014 FORMAT (" ","----------------------------------------------" ,    06760829
     1        "---------------------------------" )                     06770829
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               06780829
C****                                                                   06790829
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             06800829
C****                                                                   06810829
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          06820829
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        06830829
     1        A13)                                                      06840829
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 06850829
C****                                                                   06860829
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 06870829
C****                                                                   06880829
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              06890829
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              06900829
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             06910829
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  06920829
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  06930829
CBE** ********************** BBCFMT0B **********************************06940829
C*****                                                                  06950829
C*****    END OF TEST SEGMENT 206                                       06960829
      STOP                                                              06970829
      END                                                               06980829