FM909.f Source File


Contents

Source Code


Source Code

      PROGRAM FM909

C***********************************************************************00010909
C*****  FORTRAN 77                                                      00020909
C*****   FM909                                                          00030909
C*****                       INTER4 - (393)                             00040909
C*****                                                                  00050909
C***********************************************************************00060909
C*****  TESTING OF INTERNAL FILES -                            ANS. REF 00070909
C*****          USING WRITE                                     12.2.5  00080909
C*****                                                                  00090909
C*****                                                                  00100909
CBB** ********************** BBCCOMNT **********************************00110909
C****                                                                   00120909
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130909
C****                          VERSION 2.1                              00140909
C****                                                                   00150909
C****                                                                   00160909
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170909
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00180909
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00190909
C****                      BUILDING 225  RM A266                        00200909
C****                     GAITHERSBURG, MD  20899                       00210909
C****                                                                   00220909
C****                                                                   00230909
C****                                                                   00240909
CBE** ********************** BBCCOMNT **********************************00250909
C*****                                                                  00260909
C*****  S P E C I F I C A T I O N S  SEGMENT 393                        00270909
C*****                                                                  00280909
        LOGICAL AVB                                                     00290909
        DOUBLE PRECISION AVD, BVD, CVD, DVD, B1D(5)                     00300909
        COMPLEX AVC, BVC, CVC                                           00310909
        CHARACTER A8VK*8, A97VK*97, CVCORR*97, AVCORR(24)*97            00320909
        CHARACTER*29 A291K(5)                                           00330909
        CHARACTER*43 A431K(2)                                           00340909
        CHARACTER*1 A97E1(97), A97E2(97)                                00350909
        EQUIVALENCE (A97VK, A97E1), (A431K, A97E1)                      00360909
        EQUIVALENCE (CVCORR, A97E2)                                     00370909
C*****                                                                  00380909
CBB** ********************** BBCINITA **********************************00390909
C**** SPECIFICATION STATEMENTS                                          00400909
C****                                                                   00410909
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00420909
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00430909
CBE** ********************** BBCINITA **********************************00440909
CBB** ********************** BBCINITB **********************************00450909
C**** INITIALIZE SECTION                                                00460909
      DATA  ZVERS,                  ZVERSD,             ZDATE           00470909
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00480909
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00490909
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00500909
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00510909
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00520909
      DATA   REMRKS /'                               '/                 00530909
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00540909
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00550909
C****                                                                   00560909
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00570909
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00580909
CZ03  ZPROG  = 'PROGRAM NAME'                                           00590909
CZ04  ZDATE  = 'DATE OF TEST'                                           00600909
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00610909
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00620909
CZ07  ZNAME  = 'NAME OF USER'                                           00630909
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00640909
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00650909
C                                                                       00660909
      IVPASS = 0                                                        00670909
      IVFAIL = 0                                                        00680909
      IVDELE = 0                                                        00690909
      IVINSP = 0                                                        00700909
      IVTOTL = 0                                                        00710909
      IVTOTN = 0                                                        00720909
      ICZERO = 0                                                        00730909
C                                                                       00740909
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00750909
      I01 = 05                                                          00760909
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00770909
      I02 = 06                                                          00780909
C                                                                       00790909
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00800909
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00810909
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00820909
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00830909
C                                                                       00840909
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00850909
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00860909
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00870909
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00880909
C                                                                       00890909
CBE** ********************** BBCINITB **********************************00900909
      NUVI = I02                                                        00910909
      IVTOTL = 27                                                       00920909
      ZPROG = 'FM909'                                                   00930909
CBB** ********************** BBCHED0A **********************************00940909
C****                                                                   00950909
C**** WRITE REPORT TITLE                                                00960909
C****                                                                   00970909
      WRITE (I02, 90002)                                                00980909
      WRITE (I02, 90006)                                                00990909
      WRITE (I02, 90007)                                                01000909
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01010909
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01020909
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01030909
CBE** ********************** BBCHED0A **********************************01040909
C*****                                                                  01050909
C*****    HEADER FOR SEGMENT 393                                        01060909
C*****                                                                  01070909
        WRITE(NUVI,39300)                                               01080909
39300   FORMAT(" ",/ " INTER4 - (393) INTERNAL FILES --  USING WRITE"   01090909
     1        //" ANS. REF. - 12.2.5" )                                 01100909
CBB** ********************** BBCHED0B **********************************01110909
C**** WRITE DETAIL REPORT HEADERS                                       01120909
C****                                                                   01130909
      WRITE (I02,90004)                                                 01140909
      WRITE (I02,90004)                                                 01150909
      WRITE (I02,90013)                                                 01160909
      WRITE (I02,90014)                                                 01170909
      WRITE (I02,90015) IVTOTL                                          01180909
CBE** ********************** BBCHED0B **********************************01190909
        WRITE (NUVI, 39199)                                             01200909
39199   FORMAT (" ",48X,"NOTE 1: FOR NUMERIC VALUES,    " /             01210909
     1          " ",48X,"   OPTIONAL LEADING ZERO MAY BE" /             01220909
     2          " ",48X,"   BLANK FOR ABSOLUTE VALUE < 1" /             01230909
     3          " ",48X,"NOTE 2: LEADING PLUS SIGN IS   " /             01240909
     4          " ",48X,"   OPTIONAL FOR NUMERIC VALUES " /             01250909
     5          " ",48X,"NOTE 3: E FORMAT EXPONENT MAY  " /             01260909
     6          " ",48X,"   BE E+NN OR +0NN FOR REALS   " /             01270909
     7          " ",48X,"NOTE 4: D FORMAT EXPONENT MAY  " /             01280909
     8          " ",48X,"   BE D+NN, E+NN, OR +0NN FOR  " /             01290909
     9          " ",48X,"   DOUBLE PRECISION VALUES     " /)            01300909
C*****                                                                  01310909
CT001*  TEST 1                          DOUBLE PRECISION INTO VARIABLE  01320909
           IVTNUM = 1                                                   01330909
        A97VK = 'XXXXXXXXXXXXXXXXXX'                                    01340909
        AVD = 23.456D3                                                  01350909
        WRITE(UNIT=A97VK,FMT=39301) AVD                                 01360909
39301   FORMAT(13X,D10.5)                                               01370909
           IVCOMP = 0                                                   01380909
           AVCORR(1) = '             .23456D+05'                        01390909
           AVCORR(2) = '             .23456E+05'                        01400909
           AVCORR(3) = '             .23456+005'                        01410909
           DO 40011 I = 1, 3                                            01420909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           01430909
           IF (IVCOMP - 1) 40011, 10010, 40011                          01440909
40011      CONTINUE                                                     01450909
           GO TO 20010                                                  01460909
10010      IVPASS = IVPASS + 1                                          01470909
           WRITE (NUVI, 80002) IVTNUM                                   01480909
           GO TO 0011                                                   01490909
20010      IVFAIL = IVFAIL + 1                                          01500909
           CVCORR = '             .23456D+05'                           01510909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     01520909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           01530909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    01540909
           WRITE (NUVI, 80050) REMRKS                                   01550909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     01560909
70010      FORMAT(" ",16X,"COMPUTED: " ,54A1)                           01570909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     01580909
70020      FORMAT(" ",26X,43A1)                                         01590909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     01600909
70030      FORMAT(" ",16X,"CORRECT:  " ,54A1)                           01610909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     01620909
70040      FORMAT(" ",26X,43A1)                                         01630909
 0011      CONTINUE                                                     01640909
CT002*  TEST 2                                   INTO ARRAY ELEMENT     01650909
           IVTNUM = 2                                                   01660909
        AVD = 2.1D1                                                     01670909
        A431K(1) = ' '                                                  01680909
        A431K(2) = 'WRONG'                                              01690909
        WRITE(UNIT=A431K(1),FMT=39303) AVD                              01700909
39303   FORMAT(D12.7)                                                   01710909
           IVCOMP = 0                                                   01720909
           AVCORR(1) = '.2100000D+02'                                   01730909
           AVCORR(2) = '.2100000E+02'                                   01740909
           AVCORR(3) = '.2100000+002'                                   01750909
           DO 40021 I = 1, 3                                            01760909
           IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1                        01770909
           IF (IVCOMP - 1) 40021, 10020, 40021                          01780909
40021      CONTINUE                                                     01790909
           GO TO 20020                                                  01800909
10020      IVPASS = IVPASS + 1                                          01810909
           WRITE (NUVI, 80002) IVTNUM                                   01820909
           GO TO 0021                                                   01830909
20020      IVFAIL = IVFAIL + 1                                          01840909
           CVCORR = '.2100000D+02'                                      01850909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     01860909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           01870909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    01880909
           WRITE (NUVI, 80050) REMRKS                                   01890909
           WRITE (NUVI, 80020) A431K(1)                                 01900909
           WRITE (NUVI, 80022) CVCORR                                   01910909
 0021      CONTINUE                                                     01920909
CT003*  TEST 3                                     CHARACTER SUBSTRING  01930909
           IVTNUM = 3                                                   01940909
        A97VK = ' SOME WHERE'                                           01950909
        AVD = 23.45D2                                                   01960909
        WRITE(UNIT=A97VK(21:),FMT=39305) AVD                            01970909
39305   FORMAT(11X,D14.9)                                               01980909
           IVCOMP = 0                                                   01990909
           AVCORR(1) = ' SOME WHERE                    .234500000D+04'  02000909
           AVCORR(2) = ' SOME WHERE                    .234500000E+04'  02010909
           AVCORR(3) = ' SOME WHERE                    .234500000+004'  02020909
           DO 40031 I = 1, 3                                            02030909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           02040909
           IF (IVCOMP - 1) 40031, 10030, 40031                          02050909
40031      CONTINUE                                                     02060909
           GO TO 20030                                                  02070909
10030      IVPASS = IVPASS + 1                                          02080909
           WRITE (NUVI, 80002) IVTNUM                                   02090909
           GO TO 0031                                                   02100909
20030      IVFAIL = IVFAIL + 1                                          02110909
           CVCORR =    ' SOME WHERE                    .234500000D+04'  02120909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     02130909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           02140909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    02150909
           WRITE (NUVI, 80050) REMRKS                                   02160909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     02170909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     02180909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     02190909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     02200909
 0031      CONTINUE                                                     02210909
C*****    TESTS 4 - 5                              ARRAY, SINGLE RECORD 02220909
CT004*  TEST 4                                                          02230909
           IVTNUM = 4                                                   02240909
        CVD = 23.45D2                                                   02250909
        A431K(2) = ' '                                                  02260909
        WRITE(UNIT=A431K,FMT=39306) CVD                                 02270909
39306   FORMAT(24X,D19.10)                                              02280909
           IVCOMP = 0                                                   02290909
           AVCORR(1) = '                           0.2345000000D+04'    02300909
           AVCORR(2) = '                           0.2345000000E+04'    02310909
           AVCORR(3) = '                           0.2345000000+004'    02320909
           AVCORR(4) = '                            .2345000000D+04'    02330909
           AVCORR(5) = '                            .2345000000E+04'    02340909
           AVCORR(6) = '                            .2345000000+004'    02350909
           AVCORR(7) = '                           +.2345000000D+04'    02360909
           AVCORR(8) = '                           +.2345000000E+04'    02370909
           AVCORR(9) = '                           +.2345000000+004'    02380909
           AVCORR(10) = '                          +0.2345000000D+04'   02390909
           AVCORR(11) = '                          +0.2345000000E+04'   02400909
           AVCORR(12) = '                          +0.2345000000+004'   02410909
           DO 40041 I = 1, 12                                           02420909
           IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1                        02430909
           IF (IVCOMP - 1) 40041, 10040, 40041                          02440909
40041      CONTINUE                                                     02450909
           GO TO 20040                                                  02460909
10040      IVPASS = IVPASS + 1                                          02470909
           WRITE (NUVI, 80002) IVTNUM                                   02480909
           GO TO 0041                                                   02490909
20040      IVFAIL = IVFAIL + 1                                          02500909
           CVCORR = '                           0.2345000000D+04'       02510909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     02520909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           02530909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    02540909
           WRITE (NUVI, 80050) REMRKS                                   02550909
           WRITE (NUVI, 70050) (A97E1(I), I = 1,43)                     02560909
           WRITE (NUVI, 70060) (A97E2(I), I = 1,43)                     02570909
70050      FORMAT(" ",16X,"COMPUTED: " ,43A1)                           02580909
70060      FORMAT(" ",16X,"CORRECT:  " ,43A1)                           02590909
 0041      CONTINUE                                                     02600909
CT005*  TEST 5                                                          02610909
           IVTNUM = 5                                                   02620909
           IVCOMP = 0                                                   02630909
           IF (A431K(2).EQ.' ') IVCOMP = 1                              02640909
           IF (IVCOMP - 1) 20050, 10050, 20050                          02650909
10050      IVPASS = IVPASS + 1                                          02660909
           WRITE (NUVI, 80002) IVTNUM                                   02670909
           GO TO 0051                                                   02680909
20050      IVFAIL = IVFAIL + 1                                          02690909
           CVCORR = ' '                                                 02700909
           WRITE (NUVI, 80018) IVTNUM, A431K(2), CVCORR                 02710909
 0051      CONTINUE                                                     02720909
C*****    TESTS 6 - 10             ARRAY, 5 RECORDS, ONE BLANK          02730909
CT006*  TEST 6                                                          02740909
           IVTNUM = 6                                                   02750909
        B1D(1) = 11D1                                                   02760909
        B1D(2) = 21D1                                                   02770909
        B1D(3) = 31D1                                                   02780909
        B1D(4) = 32D1                                                   02790909
        B1D(5) = 51D1                                                   02800909
        WRITE(UNIT=A291K,FMT=39307) (B1D(JVI), JVI=1,5)                 02810909
39307   FORMAT(E11.6E2/1X,E10.5E2/2X,2(E9.4E2,3X)//4X,E7.2E2)           02820909
           IVCOMP = 0                                                   02830909
           IF (A291K(1).EQ.'.110000E+03') IVCOMP = 1                    02840909
           IF (IVCOMP - 1) 20060, 10060, 20060                          02850909
10060      IVPASS = IVPASS + 1                                          02860909
           WRITE (NUVI, 80002) IVTNUM                                   02870909
           GO TO 0061                                                   02880909
20060      IVFAIL = IVFAIL + 1                                          02890909
           CVCORR = '.110000E+03'                                       02900909
           WRITE (NUVI, 80018) IVTNUM, A291K(1), CVCORR                 02910909
 0061      CONTINUE                                                     02920909
CT007*  TEST 7                                                          02930909
           IVTNUM = 7                                                   02940909
           IVCOMP = 0                                                   02950909
           IF (A291K(2).EQ.' .21000E+03') IVCOMP = 1                    02960909
           IF (IVCOMP - 1) 20070, 10070, 20070                          02970909
10070      IVPASS = IVPASS + 1                                          02980909
           WRITE (NUVI, 80002) IVTNUM                                   02990909
           GO TO 0071                                                   03000909
20070      IVFAIL = IVFAIL + 1                                          03010909
           CVCORR = ' .21000E+03'                                       03020909
           WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR                 03030909
 0071      CONTINUE                                                     03040909
CT008*  TEST 8                                                          03050909
           IVTNUM = 8                                                   03060909
           IVCOMP = 0                                                   03070909
           IF (A291K(3).EQ.'  .3100E+03   .3200E+03') IVCOMP = 1        03080909
           IF (IVCOMP - 1) 20080, 10080, 20080                          03090909
10080      IVPASS = IVPASS + 1                                          03100909
           WRITE (NUVI, 80002) IVTNUM                                   03110909
           GO TO 0081                                                   03120909
20080      IVFAIL = IVFAIL + 1                                          03130909
           CVCORR = '  .3100+003   .3200E+03'                           03140909
           WRITE (NUVI, 70070) IVTNUM, A291K(3), CVCORR                 03150909
70070      FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED: " ,      03160909
     1             A29,/," ",16X,"CORRECT:  " ,A29)                     03170909
 0081      CONTINUE                                                     03180909
CT009*  TEST 9                                                          03190909
           IVTNUM = 9                                                   03200909
           IVCOMP = 0                                                   03210909
           IF (A291K(4).EQ.' ') IVCOMP = 1                              03220909
           IF (IVCOMP - 1) 20090, 10090, 20090                          03230909
10090      IVPASS = IVPASS + 1                                          03240909
           WRITE (NUVI, 80002) IVTNUM                                   03250909
           GO TO 0091                                                   03260909
20090      IVFAIL = IVFAIL + 1                                          03270909
           CVCORR = ' '                                                 03280909
           WRITE (NUVI, 80018) IVTNUM, A291K(4), CVCORR                 03290909
 0091      CONTINUE                                                     03300909
CT010*  TEST 10                                                         03310909
           IVTNUM = 10                                                  03320909
           IVCOMP = 0                                                   03330909
           IF (A291K(5).EQ.'    .51E+03') IVCOMP = 1                    03340909
           IF (IVCOMP - 1) 20100, 10100, 20100                          03350909
10100      IVPASS = IVPASS + 1                                          03360909
           WRITE (NUVI, 80002) IVTNUM                                   03370909
           GO TO 0101                                                   03380909
20100      IVFAIL = IVFAIL + 1                                          03390909
           CVCORR = '    .51E+03'                                       03400909
           WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR                 03410909
 0101      CONTINUE                                                     03420909
C*****                                                                  03430909
        WRITE(NUVI, 90002)                                              03440909
        WRITE(NUVI, 90013)                                              03450909
        WRITE(NUVI, 90014)                                              03460909
C*****                                                                  03470909
CT011*  TEST 11                           VARIABLE, MORE THEN ONE FIELD 03480909
           IVTNUM = 11                                                  03490909
        AVD = 34.58673D2                                                03500909
        BVD = 34.58673D2                                                03510909
        CVD = 34.58673D2                                                03520909
        DVD = 34.58673D2                                                03530909
        WRITE(UNIT=A97VK,FMT=39309) AVD, BVD, CVD, DVD                  03540909
39309   FORMAT(D10.5,1X,F10.5,1X,D11.5,G11.5)                           03550909
           IVCOMP = 0                                                   03560909
           CVCORR = '.34587D+04 3458.67300 0.34587D+04 3458.7'          03570909
           IF (A97VK.EQ.CVCORR) IVCOMP = 1                              03580909
           IF (IVCOMP - 1) 20110, 10110, 20110                          03590909
10110      IVPASS = IVPASS + 1                                          03600909
           WRITE (NUVI, 80002) IVTNUM                                   03610909
           GO TO 0111                                                   03620909
20110      IVFAIL = IVFAIL + 1                                          03630909
           REMRKS = '54 PERMISSIBLE REPRESENTATIONS'                    03640909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           03650909
           REMRKS = 'SEE NOTES ABOVE'                                   03660909
           WRITE (NUVI, 80050) REMRKS                                   03670909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     03680909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     03690909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     03700909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     03710909
 0111      CONTINUE                                                     03720909
CT012*  TEST 12                                 GW.D FIELD WITH D.P.    03730909
           IVTNUM = 12                                                  03740909
        AVD = 314.5673D0                                                03750909
        BVD = 14.45673D-1                                               03760909
        CVD = 85.7343D6                                                 03770909
        WRITE(UNIT=A97VK,FMT=39310) AVD, BVD, CVD                       03780909
39310   FORMAT(G12.5,1X,G14.5E3,1X,G10.5E2)                             03790909
           IVCOMP = 0                                                   03800909
           AVCORR(1) = '  314.57        1.4457      .85734E+08'         03810909
           AVCORR(2) = ' +314.57        1.4457      .85734E+08'         03820909
           AVCORR(3) = '  314.57       +1.4457      .85734E+08'         03830909
           AVCORR(4) = ' +314.57       +1.4457      .85734E+08'         03840909
           DO 40121 I = 1, 4                                            03850909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           03860909
           IF (IVCOMP - 1) 40121, 10120, 40121                          03870909
40121      CONTINUE                                                     03880909
           GO TO 20120                                                  03890909
10120      IVPASS = IVPASS + 1                                          03900909
           WRITE (NUVI, 80002) IVTNUM                                   03910909
           GO TO 0121                                                   03920909
20120      IVFAIL = IVFAIL + 1                                          03930909
           CVCORR = '  314.57        1.4457      .85734E+08'            03940909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     03950909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           03960909
           REMRKS = 'WITH PERMISSIBLE OPTIONS. SEE '                    03970909
           WRITE (NUVI, 80050) REMRKS                                   03980909
           REMRKS = 'NOTES ABOVE'                                       03990909
           WRITE (NUVI, 80050) REMRKS                                   04000909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     04010909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     04020909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     04030909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     04040909
 0121      CONTINUE                                                     04050909
CT013*  TEST 13                         DIFFERENT TYPES IN SAME RECORD  04060909
           IVTNUM = 13                                                  04070909
        KVI = 348                                                       04080909
        AVS = 34.783                                                    04090909
        AVD = 384.3847D1                                                04100909
        AVB = .TRUE.                                                    04110909
        BVS = 3.4857                                                    04120909
        A8VK = 'KDFJ D/.'                                               04130909
        WRITE(UNIT=A97VK,FMT=39311) KVI, AVS, AVD, AVB, BVS, A8VK       04140909
39311   FORMAT(I4,1X,E9.4,1X,D10.4,1X,L4,1X,F12.5,1X,A8)                04150909
           IVCOMP = 0                                                   04160909
           CVCORR = ' 348 .3478E+02 0.3844D+04    T      3.48570 KDFJ D/04170909
     1.'                                                                04180909
           IF (A97VK.EQ.CVCORR) IVCOMP = 1                              04190909
           IF (IVCOMP - 1) 20130, 10130, 20130                          04200909
10130      IVPASS = IVPASS + 1                                          04210909
           WRITE (NUVI, 80002) IVTNUM                                   04220909
           GO TO 0131                                                   04230909
20130      IVFAIL = IVFAIL + 1                                          04240909
           REMRKS = '72 PERMISSIBLE REPRESENTATIONS'                    04250909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           04260909
           REMRKS = 'SEE NOTES ABOVE'                                   04270909
           WRITE (NUVI, 80050) REMRKS                                   04280909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     04290909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     04300909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     04310909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     04320909
 0131      CONTINUE                                                     04330909
CT014*  TEST 14                                 POSITIONAL EDITING      04340909
           IVTNUM = 14                                                  04350909
        AVB = .TRUE.                                                    04360909
        AVS = 10.98                                                     04370909
        A8VK = 'THISISIT'                                               04380909
        AVD = 3.4945D2                                                  04390909
        BVS = 3.4945                                                    04400909
        KVI = 3                                                         04410909
        WRITE(UNIT=A97VK,FMT=39312) AVB, AVS, A8VK, AVD, BVS, KVI       04420909
39312   FORMAT(L1,T5,F5.2,A8,TR2,E10.4E2,TL10,F6.4,6X,I1)               04430909
           IVCOMP = 0                                                   04440909
           IF (A97VK.EQ.'T   10.98THISISIT  3.4945E+03  3')             04450909
     1     IVCOMP = 1                                                   04460909
           IF (IVCOMP - 1) 20140, 10140, 20140                          04470909
10140      IVPASS = IVPASS + 1                                          04480909
           WRITE (NUVI, 80002) IVTNUM                                   04490909
           GO TO 0141                                                   04500909
20140      IVFAIL = IVFAIL + 1                                          04510909
           CVCORR = 'T   10.98THISISIT  3.4945E+03  3'                  04520909
           WRITE (NUVI, 80008) IVTNUM                                   04530909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     04540909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     04550909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     04560909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     04570909
 0141      CONTINUE                                                     04580909
CT015*  TEST 15                                      COLON AND SIGN     04590909
           IVTNUM = 15                                                  04600909
        AVB = .TRUE.                                                    04610909
        AVS = 98.11                                                     04620909
        A8VK = 'THISISIT'                                               04630909
        AVD = 3.4945D2                                                  04640909
        KVI = 33                                                        04650909
        WRITE(UNIT=A97VK,FMT=39313) AVB, AVS, A8VK, AVD, KVI            04660909
39313   FORMAT(L1,S,F7.2,A8,SP,D11.5,6X,SS,I2,:,F9.3)                   04670909
           IVCOMP = 0                                                   04680909
           AVCORR(1) = 'T  98.11THISISIT+.34945D+03      33'            04690909
           AVCORR(2) = 'T  98.11THISISIT+.34945E+03      33'            04700909
           AVCORR(3) = 'T  98.11THISISIT+.34945+003      33'            04710909
           DO 40151 I = 1, 3                                            04720909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           04730909
           IF (IVCOMP - 1) 40151, 10150, 40151                          04740909
40151      CONTINUE                                                     04750909
           GO TO 20150                                                  04760909
10150      IVPASS = IVPASS + 1                                          04770909
           WRITE (NUVI, 80002) IVTNUM                                   04780909
           GO TO 0151                                                   04790909
20150      IVFAIL = IVFAIL + 1                                          04800909
           CVCORR = 'T  98.11THISISIT+.34945D+03      33'               04810909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     04820909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           04830909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    04840909
           WRITE (NUVI, 80050) REMRKS                                   04850909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     04860909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     04870909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     04880909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     04890909
 0151      CONTINUE                                                     04900909
CT016*  TEST 16                             COMPLEX TYPES INTO VARIABLE 04910909
           IVTNUM = 16                                                  04920909
        AVC = (2.343, 34.394)                                           04930909
        WRITE(UNIT=A97VK,FMT=39314) AVC                                 04940909
39314   FORMAT(F10.5,1X,F10.5)                                          04950909
           IVCOMP = 0                                                   04960909
           AVCORR(1) = '   2.34300   34.39400'                          04970909
           AVCORR(2) = '   2.34300  +34.39400'                          04980909
           AVCORR(3) = '  +2.34300   34.39400'                          04990909
           AVCORR(4) = '  +2.34300  +34.39400'                          05000909
           DO 40161 I = 1, 4                                            05010909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           05020909
           IF (IVCOMP - 1) 40161, 10160, 40161                          05030909
40161      CONTINUE                                                     05040909
           GO TO 20160                                                  05050909
10160      IVPASS = IVPASS + 1                                          05060909
           WRITE (NUVI, 80002) IVTNUM                                   05070909
           GO TO 0161                                                   05080909
20160      IVFAIL = IVFAIL + 1                                          05090909
           CVCORR = '  +2.34300  +34.39400'                             05100909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     05110909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           05120909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    05130909
           WRITE (NUVI, 80050) REMRKS                                   05140909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     05150909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     05160909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     05170909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     05180909
 0161      CONTINUE                                                     05190909
CT017*  TEST 17                                                         05200909
           IVTNUM = 17                                                  05210909
        AVC = (34.84, 349.887)                                          05220909
        WRITE(UNIT=A97VK,FMT=39315) AVC                                 05230909
39315   FORMAT(E12.5,1X,E12.5)                                          05240909
           IVCOMP = 0                                                   05250909
           IF (A97VK.EQ.' 0.34840E+02  0.34989E+03') IVCOMP = 1         05260909
           IF (IVCOMP - 1) 20170, 10170, 20170                          05270909
10170      IVPASS = IVPASS + 1                                          05280909
           WRITE (NUVI, 80002) IVTNUM                                   05290909
           GO TO 0171                                                   05300909
20170      IVFAIL = IVFAIL + 1                                          05310909
           CVCORR = ' 0.34840E+02  0.34989E+03'                         05320909
           REMRKS = '16 PERMISSIBLE REPRESENTATIONS'                    05330909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           05340909
           REMRKS = 'SEE NOTES ABOVE'                                   05350909
           WRITE (NUVI, 80050) REMRKS                                   05360909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     05370909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     05380909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     05390909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     05400909
 0171      CONTINUE                                                     05410909
CT018*  TEST 18                                       LIST OF COMPLEX   05420909
           IVTNUM = 18                                                  05430909
        AVC = (2.34, 2.456)                                             05440909
        BVC = (2.34, 2.456)                                             05450909
        CVC = (2.34, 2.456)                                             05460909
        WRITE(UNIT=A97VK,FMT=39316) AVC, BVC, CVC                       05470909
39316   FORMAT(2(G9.4,1X),2(G10.4E2,1X),2(G11.5E3,1X))                  05480909
           IVCOMP = 0                                                   05490909
           AVCORR(1) = '2.340     2.456      2.340      2.456     2.340005500909
     1      2.4560'                                                     05510909
           AVCORR(2) = '2.340     2.456      2.340     +2.456     2.340005520909
     1      2.4560'                                                     05530909
           AVCORR(3) = '2.340     2.456     +2.340      2.456     2.340005540909
     1      2.4560'                                                     05550909
           AVCORR(4) = '2.340     2.456     +2.340     +2.456     2.340005560909
     1      2.4560'                                                     05570909
           DO 40181 I = 1, 4                                            05580909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           05590909
           IF (IVCOMP - 1) 40181, 10180, 40181                          05600909
40181      CONTINUE                                                     05610909
           GO TO 20180                                                  05620909
10180      IVPASS = IVPASS + 1                                          05630909
           WRITE (NUVI, 80002) IVTNUM                                   05640909
           GO TO 0181                                                   05650909
20180      IVFAIL = IVFAIL + 1                                          05660909
           CVCORR = '2.340     2.456      2.340      2.456     2.3400   05670909
     1   2.4560'                                                        05680909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     05690909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           05700909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    05710909
           WRITE (NUVI, 80050) REMRKS                                   05720909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     05730909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     05740909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     05750909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     05760909
 0181      CONTINUE                                                     05770909
CT019*  TEST 19                                    LIST FROM SUBSTRING  05780909
           IVTNUM = 19                                                  05790909
        AVC = (5.6798, 0.9876)                                          05800909
        BVC = (5.6798, 0.9876)                                          05810909
        CVC = (5.6798, 0.9876)                                          05820909
        WRITE(UNIT=A97VK(1:),FMT=39317) AVC, BVC, CVC                   05830909
39317   FORMAT(2(E6.2E1,1X),1X,2(E7.2E2,1X),1X,2(E9.2E3,1X))            05840909
           IVCOMP = 0                                                   05850909
           AVCORR(1) = '.57E+1 .99E+0  .57E+01 .99E+00   .57E+001  .99E+05860909
     1000'                                                              05870909
           AVCORR(2) = '.57E+1 .99E+0  .57E+01 .99E+00   .57E+001 0.99E+05880909
     1000'                                                              05890909
           AVCORR(3) = '.57E+1 .99E+0  .57E+01 .99E+00   .57E+001 +.99E+05900909
     1000'                                                              05910909
           AVCORR(4) = '.57E+1 .99E+0  .57E+01 .99E+00  0.57E+001  .99E+05920909
     1000'                                                              05930909
           AVCORR(5) = '.57E+1 .99E+0  .57E+01 .99E+00  0.57E+001 0.99E+05940909
     1000'                                                              05950909
           AVCORR(6) = '.57E+1 .99E+0  .57E+01 .99E+00  0.57E+001 +.99E+05960909
     1000'                                                              05970909
           AVCORR(7) = '.57E+1 .99E+0  .57E+01 .99E+00  +.57E+001  .99E+05980909
     1000'                                                              05990909
           AVCORR(8) = '.57E+1 .99E+0  .57E+01 .99E+00  +.57E+001 0.99E+06000909
     1000'                                                              06010909
           AVCORR(9) = '.57E+1 .99E+0  .57E+01 .99E+00  +.57E+001 +.99E+06020909
     1000'                                                              06030909
           DO 40191 I = 1, 9                                            06040909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           06050909
           IF (IVCOMP - 1) 40191, 10190, 40191                          06060909
40191      CONTINUE                                                     06070909
           GO TO 20190                                                  06080909
10190      IVPASS = IVPASS + 1                                          06090909
           WRITE (NUVI, 80002) IVTNUM                                   06100909
           GO TO 0191                                                   06110909
20190      IVFAIL = IVFAIL + 1                                          06120909
           CVCORR = '.57E+1 .99E+0  .57E+01 .99E+00  0.57E+001 0.99E+00006130909
     1'                                                                 06140909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     06150909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           06160909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    06170909
           WRITE (NUVI, 80050) REMRKS                                   06180909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     06190909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     06200909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     06210909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     06220909
 0191      CONTINUE                                                     06230909
CT020*  TEST 20                                         MIXED TYPES     06240909
           IVTNUM = 20                                                  06250909
        AVC = (0.934, 34.567)                                           06260909
        AVS = 34.65                                                     06270909
        AVD = 0.6354D1                                                  06280909
        WRITE(UNIT=A97VK,FMT=39318) AVC, AVS, AVD                       06290909
39318   FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,E13.5E2)                        06300909
           IVCOMP = 0                                                   06310909
           IF (A97VK.EQ.'  0.934  34.567   34.65000   0.63540E+01') IVCO06320909
     1MP = 1                                                            06330909
           IF (A97VK.EQ.'   .934  34.567   34.65000    .63540E+01') IVCO06330909
     1MP = 1                                                            06330909
           IF (A97VK.EQ.'  0.934  34.567   34.64999   0.63540E+01') IVCO06330909
     1MP = 1                                                            06330909
           IF (A97VK.EQ.'   .934  34.567   34.64999    .63540E+01') IVCO06330909
     1MP = 1                                                            06330909
           IF (IVCOMP - 1) 20200, 10200, 20200                          06340909
10200      IVPASS = IVPASS + 1                                          06350909
           WRITE (NUVI, 80002) IVTNUM                                   06360909
           GO TO 0201                                                   06370909
20200      IVFAIL = IVFAIL + 1                                          06380909
           CVCORR = '  0.934  34.567   34.65000   0.63540E+01'          06390909
           REMRKS = '32 PERMISSIBLE REPRESENTATIONS'                    06400909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           06410909
           REMRKS = 'SEE NOTES ABOVE'                                   06420909
           WRITE (NUVI, 80050) REMRKS                                   06430909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     06440909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     06450909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     06460909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     06470909
 0201      CONTINUE                                                     06480909
C*****                                                                  06490909
        WRITE(NUVI, 90002)                                              06500909
        WRITE(NUVI, 90013)                                              06510909
        WRITE(NUVI, 90014)                                              06520909
C*****                                                                  06530909
CT021*  TEST 21                     MIXED TYPES WITH POSITIONAL EDITING 06540909
           IVTNUM = 21                                                  06550909
        AVC = (0.345, 34.349)                                           06560909
        AVB = .FALSE.                                                   06570909
        AVD = 34.859D-1                                                 06580909
        AVS = 10.0                                                      06590909
        A8VK = '12345678'                                               06600909
        WRITE(UNIT=A97VK,FMT=39319) AVC, AVB, AVD, AVS, A8VK            06610909
39319   FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8)                  06620909
           IVCOMP = 0                                                   06630909
           IF (A97VK.EQ.'   0.3450 .3435E+02 F  0.34859D+01 10.00    12306640909
     145678') IVCOMP = 1                                                06650909
           IF (IVCOMP - 1) 20210, 10210, 20210                          06660909
10210      IVPASS = IVPASS + 1                                          06670909
           WRITE (NUVI, 80002) IVTNUM                                   06680909
           GO TO 0211                                                   06690909
20210      IVFAIL = IVFAIL + 1                                          06700909
           CVCORR = '   0.3450 .3435E+02 F  0.34859D+01 10.00    123456706710909
     18'                                                                06720909
           REMRKS = '96 PERMISSIBLE REPRESENTATIONS'                    06730909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           06740909
           REMRKS = 'SEE NOTES ABOVE'                                   06750909
           WRITE (NUVI, 80050) REMRKS                                   06760909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     06770909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     06780909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     06790909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     06800909
 0211      CONTINUE                                                     06810909
C*****    TESTS 22 - 26                     MIXED TYPES INTO 5 RECORDS  06820909
CT022*  TEST 22                                                         06830909
           IVTNUM = 22                                                  06840909
        KVI = 98                                                        06850909
        AVD = 84.0489D1                                                 06860909
        AVB = .TRUE.                                                    06870909
        AVC = (34.0435, 34.94)                                          06880909
        A8VK = 'THE LAST'                                               06890909
        WRITE(UNIT=A291K,FMT=39320) KVI, AVD, AVB, AVC, A8VK            06900909
39320   FORMAT(I5/E10.5E2//1X,L6,2(1X,E10.3)/A8)                        06910909
           IVCOMP = 0                                                   06920909
           AVCORR(1) = '   98'                                          06930909
           AVCORR(2) = '  +98'                                          06940909
           DO 40221 I = 1, 2                                            06950909
           IF (A291K(1).EQ.AVCORR(I)) IVCOMP = 1                        06960909
           IF (IVCOMP - 1) 40221, 10220, 40221                          06970909
40221      CONTINUE                                                     06980909
           GO TO 20220                                                  06990909
10220      IVPASS = IVPASS + 1                                          07000909
           WRITE (NUVI, 80002) IVTNUM                                   07010909
           GO TO 0221                                                   07020909
20220      IVFAIL = IVFAIL + 1                                          07030909
           CVCORR = '   98'                                             07040909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     07050909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           07060909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    07070909
           WRITE (NUVI, 80050) REMRKS                                   07080909
           WRITE (NUVI, 80020) A291K(1)                                 07090909
           WRITE (NUVI, 80022) CVCORR                                   07100909
 0221      CONTINUE                                                     07110909
CT023*  TEST 23                                                         07120909
           IVTNUM = 23                                                  07130909
           IVCOMP = 0                                                   07140909
           IF (A291K(2).EQ.'.84049E+03') IVCOMP = 1                     07150909
           IF (IVCOMP - 1) 20230, 10230, 20230                          07160909
10230      IVPASS = IVPASS + 1                                          07170909
           WRITE (NUVI, 80002) IVTNUM                                   07180909
           GO TO 0231                                                   07190909
20230      IVFAIL = IVFAIL + 1                                          07200909
           CVCORR = '.84049E+03'                                        07210909
           WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR                 07220909
 0231      CONTINUE                                                     07230909
CT024*  TEST 24                                                         07240909
           IVTNUM = 24                                                  07250909
           IVCOMP = 0                                                   07260909
           IF (A291K(3).EQ.' ') IVCOMP = 1                              07270909
           IF (IVCOMP - 1) 20240, 10240, 20240                          07280909
10240      IVPASS = IVPASS + 1                                          07290909
           WRITE (NUVI, 80002) IVTNUM                                   07300909
           GO TO 0241                                                   07310909
20240      IVFAIL = IVFAIL + 1                                          07320909
           CVCORR = ' '                                                 07330909
           WRITE (NUVI, 80018) IVTNUM, A291K(3), CVCORR                 07340909
 0241      CONTINUE                                                     07350909
CT025*  TEST 25                                                         07360909
           IVTNUM = 25                                                  07370909
           IVCOMP = 0                                                   07380909
           IF (A291K(4).EQ.'      T  0.340E+02  0.349E+02') IVCOMP = 1  07390909
           IF (IVCOMP - 1) 20250, 10250, 20250                          07400909
10250      IVPASS = IVPASS + 1                                          07410909
           WRITE (NUVI, 80002) IVTNUM                                   07420909
           GO TO 0251                                                   07430909
20250      IVFAIL = IVFAIL + 1                                          07440909
           CVCORR = '      T  0.340E+02  0.349E+02'                     07450909
           REMRKS = '64 PERMISSIBLE REPRESENTATIONS'                    07460909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           07470909
           REMRKS = 'SEE NOTES ABOVE'                                   07480909
           WRITE (NUVI, 80050) REMRKS                                   07490909
           WRITE (NUVI, 70080) A291K(4), CVCORR                         07500909
70080      FORMAT (" ",16X,"COMPUTED: " , A29,/                         07510909
     1             " ",16X,"CORRECT:  " ,A29)                           07520909
 0251      CONTINUE                                                     07530909
CT026*  TEST 26                                                         07540909
           IVTNUM = 26                                                  07550909
           IVCOMP = 0                                                   07560909
           IF (A291K(5).EQ.'THE LAST') IVCOMP = 1                       07570909
           IF (IVCOMP - 1) 20260, 10260, 20260                          07580909
10260      IVPASS = IVPASS + 1                                          07590909
           WRITE (NUVI, 80002) IVTNUM                                   07600909
           GO TO 0261                                                   07610909
20260      IVFAIL = IVFAIL + 1                                          07620909
           CVCORR = 'THE LAST'                                          07630909
           WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR                 07640909
 0261      CONTINUE                                                     07650909
CT027*  TEST 27                      MIXED TYPES WITH SS, SP, NX, AND : 07660909
           IVTNUM = 27                                                  07670909
        JVI = 34                                                        07680909
        AVS = 34.983                                                    07690909
        BVS = 345.3                                                     07700909
        AVD = 95.83D2                                                   07710909
        AVB = .FALSE.                                                   07720909
        A8VK = '.FALSE.1'                                               07730909
        WRITE(UNIT=A97VK,FMT=39321)JVI, AVS, AVD, AVB, A8VK, BVS        07740909
39321   FORMAT(S,I2,1X,SP,F7.3,SS,1X,D10.5,L2,1X,A8,1X,E10.5,:,I5,F10.4)07750909
           IVCOMP = 0                                                   07760909
           AVCORR(1) = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03'    07770909
           AVCORR(2) = '34 +34.983 .95830D+04 F .FALSE.1 .34530+003'    07780909
           AVCORR(3) = '34 +34.983 .95830E+04 F .FALSE.1 .34530E+03'    07790909
           AVCORR(4) = '34 +34.983 .95830E+04 F .FALSE.1 .34530+003'    07800909
           AVCORR(5) = '34 +34.983 .95830+004 F .FALSE.1 .34530E+03'    07810909
           AVCORR(6) = '34 +34.983 .95830+004 F .FALSE.1 .34530+003'    07820909
           DO 40271 I = 1, 6                                            07830909
           IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1                           07840909
           IF (IVCOMP - 1) 40271, 10270, 40271                          07850909
40271      CONTINUE                                                     07860909
           GO TO 20270                                                  07870909
10270      IVPASS = IVPASS + 1                                          07880909
           WRITE (NUVI, 80002) IVTNUM                                   07890909
           GO TO 0271                                                   07900909
20270      IVFAIL = IVFAIL + 1                                          07910909
           CVCORR = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03'       07920909
           REMRKS = 'COMPUTED VALUE NOT CONSISTENT'                     07930909
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           07940909
           REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'                    07950909
           WRITE (NUVI, 80050) REMRKS                                   07960909
           WRITE (NUVI, 70010) (A97E1(I), I = 1,54)                     07970909
           WRITE (NUVI, 70020) (A97E1(I), I= 55,97)                     07980909
           WRITE (NUVI, 70030) (A97E2(I), I = 1,54)                     07990909
           WRITE (NUVI, 70040) (A97E2(I), I= 55,97)                     08000909
 0271      CONTINUE                                                     08010909
C*****                                                                  08020909
CBB** ********************** BBCSUM0  **********************************08030909
C**** WRITE OUT TEST SUMMARY                                            08040909
C****                                                                   08050909
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        08060909
      WRITE (I02, 90004)                                                08070909
      WRITE (I02, 90014)                                                08080909
      WRITE (I02, 90004)                                                08090909
      WRITE (I02, 90020) IVPASS                                         08100909
      WRITE (I02, 90022) IVFAIL                                         08110909
      WRITE (I02, 90024) IVDELE                                         08120909
      WRITE (I02, 90026) IVINSP                                         08130909
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 08140909
CBE** ********************** BBCSUM0  **********************************08150909
CBB** ********************** BBCFOOT0 **********************************08160909
C**** WRITE OUT REPORT FOOTINGS                                         08170909
C****                                                                   08180909
      WRITE (I02,90016) ZPROG, ZPROG                                    08190909
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     08200909
      WRITE (I02,90019)                                                 08210909
CBE** ********************** BBCFOOT0 **********************************08220909
CBB** ********************** BBCFMT0A **********************************08230909
C**** FORMATS FOR TEST DETAIL LINES                                     08240909
C****                                                                   08250909
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           08260909
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           08270909
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           08280909
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           08290909
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           08300909
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    08310909
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08320909
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              08330909
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08340909
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  08350909
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         08360909
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         08370909
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         08380909
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         08390909
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      08400909
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      08410909
80050 FORMAT (" ",48X,A31)                                              08420909
CBE** ********************** BBCFMT0A **********************************08430909
CBB** ********************** BBCFMAT1 **********************************08440909
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     08450909
C****                                                                   08460909
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08470909
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            08480909
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     08490909
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     08500909
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    08510909
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    08520909
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    08530909
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    08540909
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08550909
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  08560909
     2"(",F12.5,", ",F12.5,")")                                         08570909
CBE** ********************** BBCFMAT1 **********************************08580909
CBB** ********************** BBCFMT0B **********************************08590909
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                08600909
C****                                                                   08610909
90002 FORMAT ("1")                                                      08620909
90004 FORMAT (" ")                                                      08630909
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08640909
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            08650909
90008 FORMAT (" ",21X,A13,A17)                                          08660909
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       08670909
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    08680909
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     08690909
     1       7X,"REMARKS",24X)                                          08700909
90014 FORMAT (" ","----------------------------------------------" ,    08710909
     1        "---------------------------------" )                     08720909
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               08730909
C****                                                                   08740909
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             08750909
C****                                                                   08760909
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          08770909
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        08780909
     1        A13)                                                      08790909
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 08800909
C****                                                                   08810909
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 08820909
C****                                                                   08830909
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              08840909
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              08850909
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             08860909
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  08870909
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  08880909
CBE** ********************** BBCFMT0B **********************************08890909
C*****                                                                  08900909
C*****    END OF TEST SEGMENT 393                                       08910909
      STOP                                                              08920909
      END                                                               08930909