C***********************************************************************
C*****  FORTRAN 77
C*****   FM908
C*****                       INTER3 - (392)
C*****
C***********************************************************************
C*****  TESTING OF INTERNAL FILES -                           ANS. REF
C*****          USING READ                                      12.2.5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM
C****                          VERSION 2.0
C****
C****
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C****                   GENERAL SERVICES ADMINISTRATION
C****                   FEDERAL SOFTWARE TESTING CENTER
C****                   5203 LEESBURG PIKE, SUITE 1100
C****                      FALLS CHURCH, VA. 22041
C****
C****                          (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C*****  S P E C I F I C A T I O N S  SEGMENT 392
C*****
        DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, DVCORR
        LOGICAL AVB
        CHARACTER*43 A43VK, D43VK, F43VK, G43VK, K43VK, N43VK
        CHARACTER A8VK*8, E51VK*51, L53VK*53, I82VK*82
        CHARACTER J97VK*97, C431K(2)*43, CVCORR*30
        CHARACTER*29 B291K(5), M291K(5), H131K(2)*13
        COMPLEX AVC, BVC, CVC, DVC, ZVCORR
        REAL R2E(8)
        EQUIVALENCE (R2E(1),AVC),(R2E(3),BVC),(R2E(5),CVC),(R2E(7),DVC)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
      DATA  ZVERS,                  ZVERSD,             ZDATE
     1      /'VERSION 2.0  ',  '82/08/02*18.33.46',  '*NO DATE*TIME'/
      DATA       ZCOMPL,             ZNAME,             ZTAPE
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
      DATA       ZPROJ,           ZTAPED,         ZPROG
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/
      DATA   REMRKS /'                               '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03  ZPROG  = 'PROGRAM NAME'
      ZDATE  = ' DEC. 1983       '
      ZCOMPL = ' ICL VME FORTRAN77  '
      ZPROJ  = ' LANG. CENTRE'
      ZNAME  = 'ICL                 '
      ZTAPE  = 'M999      '
      ZTAPED = '831005       '
C
      IVPASS = 0
      IVFAIL = 0
      IVDELE = 0
      IVINSP = 0
      IVTOTL = 0
      IVTOTN = 0
      ICZERO = 0
C
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
      I01 = 05
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
      I02 = 06
C
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
      NUVI = I02
      IVTOTL = 54
      ZPROG = 'FM908'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
      WRITE (I02, 90002)
      WRITE (I02, 90006)
      WRITE (I02, 90007)
      WRITE (I02, 90008)  ZVERS, ZVERSD
      WRITE (I02, 90009)  ZPROG, ZPROG
      WRITE (I02, 90010)  ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C*****    HEADER FOR SEGMENT 392
C*****
        WRITE(NUVI,39200)
39200   FORMAT(1H ,/ 44H INTER3 - (392) INTERNAL FILES -- USING READ
     1             //19H ANS. REF. - 12.2.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
      WRITE (I02,90004)
      WRITE (I02,90004)
      WRITE (I02,90013)
      WRITE (I02,90014)
      WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
      A43VK = ' 2.1000000D1 23.45600D3      23.450000000D2'
      D43VK = '34.58673D2 3458.67300 34.58673D2 3458.673  '
      F43VK = 'T   10.98THISISIT  3.4945D2  3             '
      G43VK = '   2.343   34.394                      '
      K43VK = '  0.934, 34.567   34.65        0.63540D1   '
      N43VK = '34 34.98395.83000D2 F.FALSE.13.45300E+2    '
      E51VK = ' 348  3.4783E1384.3847D1    T      3.48570 KDFJ D/.'
      L53VK = '   0.345 ,3.4345E01,F, 34.85900D-1,  10.000012345678'
      I82VK = '  2.34 ,  2.456     2.34 ,  2.456     0.234E01,  2.456E00
     1   0.234E+001, 2.456E-000'
      J97VK = '   5.67980,   0.9876       5.67980,    0.9876   05.6798E0
     10, 9.8760E-1  5.67980E0000,0.09876E+001'
      B291K(1) =  '34.38457D1 34.38457D1       '
      B291K(2) = '34.38457D1                   '
      B291K(3) = '34.38457D1 34.38457D1        '
      B291K(4) = '                             '
      B291K(5) = '34.38457D1                   '
      M291K(1) = '   98                        '
      M291K(2) = '8.40485D02                   '
      M291K(3) = '                             '
      M291K(4) = ' .TRUE. 340.435E-1,  3.494E+1'
      M291K(5) = '87654321                     '
      C431K(1) = ' 2.1000000D1 23.45600D3      23.450000000D2'
      C431K(2) = '                                           '
      H131K(1) = '34.84'
      H131K(2) = '349.887'
CT001*  TEST 1                          DOUBLE PRECISION FROM VARIABLE
           IVTNUM = 1
        READ(UNIT=A43VK,FMT=39201) AVD
39201   FORMAT(13X,D10.5)
           IF (AVD - 0.2345599998D+05) 20010, 10010, 40010
40010      IF (AVD - 0.2345600002D+05) 10010, 10010, 20010
10010      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0011
20010      IVFAIL = IVFAIL + 1
           DVCORR = 23.456D3
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0011      CONTINUE
CT002*  TEST 2                                          FROM ELEMENT
           IVTNUM = 2
        READ(UNIT=C431K(1),FMT=39204) AVD
39204   FORMAT(D12.7)
           IF (AVD - 0.2099999999D+02) 20020, 10020, 40020
40020      IF (AVD - 0.2100000001D+02) 10020, 10020, 20020
10020      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0021
20020      IVFAIL = IVFAIL + 1
           DVCORR = 2.1D1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0021      CONTINUE
CT003*  TEST 3                                          FROM SUBSTRING
           IVTNUM = 3
        READ(UNIT=A43VK(19:),FMT=39206) AVD
39206   FORMAT(11X,D14.9)
           IF (AVD - 0.2344999998D+04) 20030, 10030, 40030
40030      IF (AVD - 0.2345000002D+04) 10030, 10030, 20030
10030      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0031
20030      IVFAIL = IVFAIL + 1
           DVCORR = 23.45D2
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0031      CONTINUE
CT004*  TEST 4                                          FROM ARRAY
           IVTNUM = 4
        READ(UNIT=C431K,FMT=39208) CVD
39208   FORMAT(25X,D18.10)
           IF (CVD - 0.2344999998D+04) 20040, 10040, 40040
40040      IF (CVD - 0.2345000002D+04) 10040, 10040, 20040
10040      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0041
20040      IVFAIL = IVFAIL + 1
           DVCORR = 23.45D2
           WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
 0041      CONTINUE
C*****
C*****  TESTS 5 THRU 9 - LIST FROM ARRAY
C*****
CT005*  TEST 5
           IVTNUM = 5
        READ(UNIT=B291K,FMT=39210) AVD, BVD, CVD, DVD, EVD
39210   FORMAT(D10.5,1X,D10.5,/,D10.5,/,D10.5,//,D10.5)
           IF (AVD - 0.3438456998D+03) 20050, 10050, 40050
40050      IF (AVD - 0.3438457002D+03) 10050, 10050, 20050
10050      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0051
20050      IVFAIL = IVFAIL + 1
           DVCORR = 34.38457D1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0051      CONTINUE
CT006*  TEST 6
           IVTNUM = 6
           IF (BVD - 0.3438456998D+03) 20060, 10060, 40060
40060      IF (BVD - 0.3438457002D+03) 10060, 10060, 20060
10060      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0061
20060      IVFAIL = IVFAIL + 1
           DVCORR = 34.38457D1
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
 0061      CONTINUE
CT007*  TEST 7
           IVTNUM = 7
           IF (CVD - 0.3438456998D+03) 20070, 10070, 40070
40070      IF (CVD - 0.3438457002D+03) 10070, 10070, 20070
10070      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0071
20070      IVFAIL = IVFAIL + 1
           DVCORR = 34.38457D1
           WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
 0071      CONTINUE
CT008*  TEST 8
           IVTNUM = 8
           IF (DVD - 0.3438456998D+03) 20080, 10080, 40080
40080      IF (DVD - 0.3438457002D+03) 10080, 10080, 20080
10080      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0081
20080      IVFAIL = IVFAIL + 1
           DVCORR = 34.38457D1
           WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR
 0081      CONTINUE
CT009*  TEST 9
           IVTNUM = 9
           IF (EVD - 0.3438456998D+03) 20090, 10090, 40090
40090      IF (EVD - 0.3438457002D+03) 10090, 10090, 20090
10090      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0091
20090      IVFAIL = IVFAIL + 1
           DVCORR = 34.38457D1
           WRITE (NUVI, 80031) IVTNUM, EVD, DVCORR
 0091      CONTINUE
C*****
C*****  TESTS 10 THRU 13 - LIST FROM VARIABLE WITH DIFFERENT FORMATS
C*****
CT010*  TEST 10
           IVTNUM = 10
        READ(UNIT=D43VK,FMT=39212) AVD, BVD, CVD, DVD
39212   FORMAT(D10.5,1X,F10.5,D11.5,G11.5)
           IF (AVD - 0.3458672998D+04) 20100, 10100, 40100
40100      IF (AVD - 0.3458673002D+04) 10100, 10100, 20100
10100      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0101
20100      IVFAIL = IVFAIL + 1
           DVCORR = 34.58673D2
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0101      CONTINUE
CT011*  TEST 11
           IVTNUM = 11
           IF (BVD - 0.3458672998D+04) 20110, 10110, 40110
40110      IF (BVD - 0.3458673002D+04) 10110, 10110, 20110
10110      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0111
20110      IVFAIL = IVFAIL + 1
           DVCORR = 34.58673D2
           WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
 0111      CONTINUE
CT012*  TEST 12
           IVTNUM = 12
           IF (CVD - 0.3458672998D+04) 20120, 10120, 40120
40120      IF (CVD - 0.3458673002D+04) 10120, 10120, 20120
10120      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0121
20120      IVFAIL = IVFAIL + 1
           DVCORR = 34.58673D2
           WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
 0121      CONTINUE
CT013*  TEST 13
           IVTNUM = 13
           IF (DVD - 0.3458672998D+04) 20130, 10130, 40130
40130      IF (DVD - 0.3458673002D+04) 10130, 10130, 20130
10130      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0131
20130      IVFAIL = IVFAIL + 1
           DVCORR = 34.58673D2
           WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR
 0131      CONTINUE
C*****
        WRITE (NUVI, 90002)
        WRITE (NUVI, 90013)
        WRITE (NUVI, 90014)
C*****
C*****  TESTS 14 THRU 19 - MIXED TYPES
C*****
CT014*  TEST 14
           IVTNUM = 14
        READ(UNIT=E51VK,FMT=39214) KVI, AVS, AVD, AVB, BVS, A8VK
39214   FORMAT(I4,1X,E9.4,D10.4,1X,L4,1X,F12.5,1X,A8)
           IF (KVI - 348) 20140, 10140, 20140
10140      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0141
20140      IVFAIL = IVFAIL + 1
           IVCORR = 348
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
 0141      CONTINUE
CT015*  TEST 15
           IVTNUM = 15
           IF (AVS - 0.34781E+02) 20150, 10150, 40150
40150      IF (AVS - 0.34785E+02) 10150, 10150, 20150
10150      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0151
20150      IVFAIL = IVFAIL + 1
           RVCORR = 34.783
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
 0151      CONTINUE
CT016*  TEST 16
           IVTNUM = 16
           IF (AVD - 0.3843846998D+04) 20160, 10160, 40160
40160      IF (AVD - 0.3843847002D+04) 10160, 10160, 20160
10160      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0161
20160      IVFAIL = IVFAIL + 1
           DVCORR = 384.3847D1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0161      CONTINUE
CT017*  TEST 17
           IVTNUM = 17
           IVCOMP = 0
           IF (AVB) IVCOMP = 1
           IF (IVCOMP - 1) 20170, 10170, 20170
10170      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0171
20170      IVFAIL = IVFAIL + 1
           LVCORR = 1
           REMRKS = '1 = TRUE ;  0 = FALSE'
           WRITE (NUVI, 80008) IVTNUM, REMRKS
           WRITE (NUVI, 80024) IVCOMP
           WRITE (NUVI, 80026) LVCORR
 0171      CONTINUE
CT018*  TEST 18
           IVTNUM = 18
           IF (BVS - 0.34855E+01) 20180, 10180, 40180
40180      IF (BVS - 0.34859E+01) 10180, 10180, 20180
10180      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0181
20180      IVFAIL = IVFAIL + 1
           RVCORR = 3.4857
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
 0181      CONTINUE
CT019*  TEST 19
           IVTNUM = 19
           IVCOMP = 0
           IF (A8VK.EQ.'KDFJ D/.') IVCOMP = 1
           IF (IVCOMP - 1) 20190, 10190, 20190
10190      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0191
20190      IVFAIL = IVFAIL + 1
           CVCORR = 'KDFJ D/.'
           WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
 0191      CONTINUE
C*****
C*****  TESTS 20 THRU 25 - MIXED TYPES WITH TC, TLC, TRC, AND NX
C*****
CT020*  TEST 20
           IVTNUM = 20
        READ(UNIT=F43VK,FMT=39216) AVB, AVS, A8VK, AVD, BVS, KVI
39216   FORMAT(L1,T5,F5.2,A8,TR2,D8.4,TL8,F6.4,4X,I1)
           IVCOMP = 0
           IF (AVB) IVCOMP = 1
           IF (IVCOMP - 1) 20200, 10200, 20200
10200      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0201
20200      IVFAIL = IVFAIL + 1
           LVCORR = 1
           REMRKS = '1 = TRUE ;  0 = FALSE'
           WRITE (NUVI, 80008) IVTNUM, REMRKS
           WRITE (NUVI, 80024) IVCOMP
           WRITE (NUVI, 80026) LVCORR
 0201      CONTINUE
CT021*  TEST 21
           IVTNUM = 21
           IF (AVS - 0.10979E+02) 20210, 10210, 40210
40210      IF (AVS - 0.10981E+02) 10210, 10210, 20210
10210      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0211
20210      IVFAIL = IVFAIL + 1
           RVCORR = 10.98
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
 0211      CONTINUE
CT022*  TEST 22
           IVTNUM = 22
           IVCOMP = 0
           IF (A8VK.EQ.'THISISIT') IVCOMP = 1
           IF (IVCOMP - 1) 20220, 10220, 20220
10220      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0221
20220      IVFAIL = IVFAIL + 1
           CVCORR = 'THISISIT'
           WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
 0221      CONTINUE
CT023*  TEST 23
           IVTNUM = 23
           IF (AVD - 0.3494499998D+03) 20230, 10230, 40230
40230      IF (AVD - 0.3494500002D+03) 10230, 10230, 20230
10230      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0231
20230      IVFAIL = IVFAIL + 1
           DVCORR = 3.4945D2
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0231      CONTINUE
CT024*  TEST 24
           IVTNUM = 24
           IF (BVS - 0.34943E+01) 20240, 10240, 40240
40240      IF (BVS - 0.34947E+01) 10240, 10240, 20240
10240      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0241
20240      IVFAIL = IVFAIL + 1
           RVCORR = 3.4945
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
 0241      CONTINUE
CT025*  TEST 25
           IVTNUM = 25
           IF (KVI - 3) 20250, 10250, 20250
10250      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0251
20250      IVFAIL = IVFAIL + 1
           IVCORR = 3
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
 0251      CONTINUE
CT026*  TEST 26                                 COMPLEX FROM VARIABLE
           IVTNUM = 26
        READ(UNIT=G43VK,FMT=39218) AVC
39218   FORMAT(F10.5,1X,F10.5)
           IF (R2E(1) - 0.23428E+01) 20260, 40262, 40261
40261      IF (R2E(1) - 0.23432E+01) 40262, 40262, 20260
40262      IF (R2E(2) - 0.34392E+02) 20260, 10260, 40260
40260      IF (R2E(2) - 0.34396E+02) 10260, 10260, 20260
10260      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0261
20260      IVFAIL = IVFAIL + 1
           ZVCORR = (2.343, 34.394)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0261      CONTINUE
CT027*  TEST 27                                 COMPLEX FROM ARRAY
           IVTNUM = 27
        READ(UNIT=H131K,FMT=39220) AVC
39220   FORMAT(E12.5,/,E12.5)
           IF (R2E(1) - 0.34838E+02) 20270, 40272, 40271
40271      IF (R2E(1) - 0.34842E+02) 40272, 40272, 20270
40272      IF (R2E(2) - 0.34987E+03) 20270, 10270, 40270
40270      IF (R2E(2) - 0.34991E+03) 10270, 10270, 20270
10270      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0271
20270      IVFAIL = IVFAIL + 1
           ZVCORR = (34.84, 349.887)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0271      CONTINUE
C*****
        WRITE (NUVI, 90002)
        WRITE (NUVI, 90013)
        WRITE (NUVI, 90014)
C*****
C*****  TESTS 28 THRU 31 - COMPLEX LIST FROM VARIABLE POSITION 1X BEYOND
C*****                     VARIABLE LENGTH
CT028*  TEST 28
           IVTNUM = 28
        READ(UNIT=I82VK,FMT=39222) AVC, BVC, CVC, DVC
39222   FORMAT(2(2(G7.5,1X),2X),2(G10.4E2,1X),1X,2(G11.7E4,1X))
           IF (R2E(1) - 0.23398E+01) 20280, 40282, 40281
40281      IF (R2E(1) - 0.23402E+01) 40282, 40282, 20280
40282      IF (R2E(2) - 0.24558E+01) 20280, 10280, 40280
40280      IF (R2E(2) - 0.24562E+01) 10280, 10280, 20280
10280      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0281
20280      IVFAIL = IVFAIL + 1
           ZVCORR = (2.34, 2.456)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0281      CONTINUE
CT029*  TEST 29
           IVTNUM = 29
           IF (R2E(3) - 0.23398E+01) 20290, 40292, 40291
40291      IF (R2E(3) - 0.23402E+01) 40292, 40292, 20290
40292      IF (R2E(4) - 0.24558E+01) 20290, 10290, 40290
40290      IF (R2E(4) - 0.24562E+01) 10290, 10290, 20290
10290      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0291
20290      IVFAIL = IVFAIL + 1
           ZVCORR = (2.34, 2.456)
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
 0291      CONTINUE
CT030*  TEST 30
           IVTNUM = 30
           IF (R2E(5) - 0.23398E+01) 20300, 40302, 40301
40301      IF (R2E(5) - 0.23402E+01) 40302, 40302, 20300
40302      IF (R2E(6) - 0.24558E+01) 20300, 10300, 40300
40300      IF (R2E(6) - 0.24562E+01) 10300, 10300, 20300
10300      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0301
20300      IVFAIL = IVFAIL + 1
           ZVCORR = (2.34, 2.456)
           WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
 0301      CONTINUE
CT031*  TEST 31
           IVTNUM = 31
           IF (R2E(7) - 0.23398E+01) 20310, 40312, 40311
40311      IF (R2E(7) - 0.23402E+01) 40312, 40312, 20310
40312      IF (R2E(8) - 0.24558E+01) 20310, 10310, 40310
40310      IF (R2E(8) - 0.24562E+01) 10310, 10310, 20310
10310      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0311
20310      IVFAIL = IVFAIL + 1
           ZVCORR = (2.34, 2.456)
           WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR
 0311      CONTINUE
C*****
C*****  TESTS 32 THRU 35 - COMPLEX LIST USING EW.D AND EW.DEN
C*****
CT032*  TEST 32
           IVTNUM = 32
        READ(UNIT=J97VK(1:),FMT=39224) AVC, BVC, CVC, DVC
39224   FORMAT(2(2(E10.5,1X),2X),2(E10.4E2,1X),1X,2(E12.5E4,1X))
           IF (R2E(1) - 0.56795E+01) 20320, 40322, 40321
40321      IF (R2E(1) - 0.56801E+01) 40322, 40322, 20320
40322      IF (R2E(2) - 0.98755E+00) 20320, 10320, 40320
40320      IF (R2E(2) - 0.98765E+00) 10320, 10320, 20320
10320      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0321
20320      IVFAIL = IVFAIL + 1
           ZVCORR = (5.6798, 0.9876)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0321      CONTINUE
CT033*  TEST 33
           IVTNUM = 33
           IF (R2E(3) - 0.56795E+01) 20330, 40332, 40331
40331      IF (R2E(3) - 0.56801E+01) 40332, 40332, 20330
40332      IF (R2E(4) - 0.98755E+00) 20330, 10330, 40330
40330      IF (R2E(4) - 0.98765E+00) 10330, 10330, 20330
10330      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0331
20330      IVFAIL = IVFAIL + 1
           ZVCORR = (5.6798, 0.9876)
           WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
 0331      CONTINUE
CT034*  TEST 34
           IVTNUM = 34
           IF (R2E(5) - 0.56795E+01) 20340, 40342, 40341
40341      IF (R2E(5) - 0.56801E+01) 40342, 40342, 20340
40342      IF (R2E(6) - 0.98755E+00) 20340, 10340, 40340
40340      IF (R2E(6) - 0.98765E+00) 10340, 10340, 20340
10340      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0341
20340      IVFAIL = IVFAIL + 1
           ZVCORR = (5.6798, 0.9876)
           WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
 0341      CONTINUE
CT035*  TEST 35
           IVTNUM = 35
           IF (R2E(7) - 0.56795E+01) 20350, 40352, 40351
40351      IF (R2E(7) - 0.56801E+01) 40352, 40352, 20350
40352      IF (R2E(8) - 0.98755E+00) 20350, 10350, 40350
40350      IF (R2E(8) - 0.98765E+00) 10350, 10350, 20350
10350      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0351
20350      IVFAIL = IVFAIL + 1
           ZVCORR = (5.6798, 0.9876)
           WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR
 0351      CONTINUE
C*****
C*****  TESTS 36 THRU 38 - MIXED TYPES FROM VARIABLE
C*****
CT036*  TEST 36
           IVTNUM = 36
        READ(UNIT=K43VK,FMT=39226) AVC, AVS, AVD
39226   FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,D13.5)
           IF (R2E(1) - 0.93395E+00) 20360, 40362, 40361
40361      IF (R2E(1) - 0.93405E+00) 40362, 40362, 20360
40362      IF (R2E(2) - 0.34565E+02) 20360, 10360, 40360
40360      IF (R2E(2) - 0.34569E+02) 10360, 10360, 20360
10360      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0361
20360      IVFAIL = IVFAIL + 1
           ZVCORR = (0.934, 34.567)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0361      CONTINUE
CT037*  TEST 37
           IVTNUM = 37
           IF (AVS - 0.34648E+02) 20370, 10370, 40370
40370      IF (AVS - 0.34652E+02) 10370, 10370, 20370
10370      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0371
20370      IVFAIL = IVFAIL + 1
           RVCORR = 34.65
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
 0371      CONTINUE
CT038*  TEST 38
           IVTNUM = 38
           IF (AVD - 0.6353999996D+01) 20380, 10380, 40380
40380      IF (AVD - 0.6354000004D+01) 10380, 10380, 20380
10380      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0381
20380      IVFAIL = IVFAIL + 1
           DVCORR = 0.6354D1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0381      CONTINUE
C*****
C*****  TESTS 39 THRU 43 - MIXED TYPES FROM ARRAY
C*****
CT039*  TEST 39
           IVTNUM = 39
        READ(UNIT=L53VK,FMT=39228) AVC, AVB, AVD, AVS, A8VK
39228   FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8)
           IF (R2E(1) - 0.34498E+00) 20390, 40392, 40391
40391      IF (R2E(1) - 0.34502E+00) 40392, 40392, 20390
40392      IF (R2E(2) - 0.34343E+02) 20390, 10390, 40390
40390      IF (R2E(2) - 0.34347E+02) 10390, 10390, 20390
10390      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0391
20390      IVFAIL = IVFAIL + 1
           ZVCORR = (0.345, 34.345)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0391      CONTINUE
CT040*  TEST 40
           IVTNUM = 40
           IVCOMP = 0
           IF (AVB) IVCOMP = 1
           IF (IVCOMP - 0) 20400, 10400, 20400
10400      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0401
20400      IVFAIL = IVFAIL + 1
           LVCORR = 0
           REMRKS = '1 = TRUE ;  0 = FALSE'
           WRITE (NUVI, 80008) IVTNUM, REMRKS
           WRITE (NUVI, 80024) IVCOMP
           WRITE (NUVI, 80026) LVCORR
 0401      CONTINUE
CT041*  TEST 41
           IVTNUM = 41
           IF (AVD - 0.3485899998D+01) 20410, 10410, 40410
40410      IF (AVD - 0.3485900002D+01) 10410, 10410, 20410
10410      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0411
20410      IVFAIL = IVFAIL + 1
           DVCORR = 34.859D-1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0411      CONTINUE
CT042*  TEST 42
           IVTNUM = 42
           IF (AVS - 0.99995E+01) 20420, 10420, 40420
40420      IF (AVS - 0.10001E+02) 10420, 10420, 20420
10420      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0421
20420      IVFAIL = IVFAIL + 1
           RVCORR = 10.0
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
 0421      CONTINUE
CT043*  TEST 43
           IVTNUM = 43
           IVCOMP = 0
           IF (A8VK.EQ.'12345678') IVCOMP = 1
           IF (IVCOMP - 1) 20430, 10430, 20430
10430      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0431
20430      IVFAIL = IVFAIL + 1
           CVCORR = '12345678'
           WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
 0431      CONTINUE
C*****
        WRITE (NUVI, 90002)
        WRITE (NUVI, 90013)
        WRITE (NUVI, 90014)
C*****
C*****  TESTS 44 THRU 48 - READ 5 RECORD FROM ARRAY POSITION 1X BEYOND
C*****                     ARRAY ELEMENT
C*****
CT044*  TEST 44
           IVTNUM = 44
        READ(UNIT=M291K,FMT=39230) KVI, AVD, AVB, AVC, A8VK
39230   FORMAT(I5,/,D10.5,//,1X,L6,1X,2(E10.3,1X),/,A8)
           IF (KVI - 98) 20440, 10440, 20440
10440      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0441
20440      IVFAIL = IVFAIL + 1
           IVCORR = 98
           WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
 0441      CONTINUE
CT045*  TEST 45
           IVTNUM = 45
           IF (AVD - 0.8404849995D+03) 20450, 10450, 40450
40450      IF (AVD - 0.8404850004D+03) 10450, 10450, 20450
10450      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0451
20450      IVFAIL = IVFAIL + 1
           DVCORR = 84.0485D1
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0451      CONTINUE
CT046*  TEST 46
           IVTNUM = 46
           IVCOMP = 0
           IF (AVB) IVCOMP = 1
           IF (IVCOMP - 1) 20460, 10460, 20460
10460      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0461
20460      IVFAIL = IVFAIL + 1
           LVCORR = 1
           REMRKS = '1 = TRUE ;  0 = FALSE'
           WRITE (NUVI, 80008) IVTNUM, REMRKS
           WRITE (NUVI, 80024) IVCOMP
           WRITE (NUVI, 80026) LVCORR
 0461      CONTINUE
CT047*  TEST 47
           IVTNUM = 47
           IF (R2E(1) - 0.34041E+02) 20470, 40472, 40471
40471      IF (R2E(1) - 0.34046E+02) 40472, 40472, 20470
40472      IF (R2E(2) - 0.34938E+02) 20470, 10470, 40470
40470      IF (R2E(2) - 0.34942E+02) 10470, 10470, 20470
10470      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0471
20470      IVFAIL = IVFAIL + 1
           ZVCORR = (34.0435, 34.94)
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
 0471      CONTINUE
CT048*  TEST 48
           IVTNUM = 48
           IVCOMP = 0
           IF (A8VK.EQ.'87654321') IVCOMP = 1
           IF (IVCOMP - 1) 20480, 10480, 20480
10480      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0481
20480      IVFAIL = IVFAIL + 1
           CVCORR = '87654321'
           WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
 0481      CONTINUE
C*****
C***** TESTS 49 THRU 54 - MIXED TYPES, NX, AND :
C*****
CT049*  TEST 49
           IVTNUM = 49
        READ(UNIT=N43VK,FMT=39232)JVI,AVS,AVD,AVB,A8VK,BVS
39232   FORMAT(I2,1X,F6.3,D10.5,L2,A8,E10.5,:,I5,2X,F10.4)
           IF (JVI - 34) 20490, 10490, 20490
10490      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0491
20490      IVFAIL = IVFAIL + 1
           IVCORR = 34
           WRITE (NUVI, 80010) IVTNUM, JVI, IVCORR
 0491      CONTINUE
CT050*  TEST 50
           IVTNUM = 50
           IF (AVS - 0.34981E+02) 20500, 10500, 40500
40500      IF (AVS - 0.34985E+02) 10500, 10500, 20500
10500      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0501
20500      IVFAIL = IVFAIL + 1
           RVCORR = 34.983
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
 0501      CONTINUE
CT051*  TEST 51
           IVTNUM = 51
           IF (AVD - 0.9582999995D+04) 20510, 10510, 40510
40510      IF (AVD - 0.9583000005D+04) 10510, 10510, 20510
10510      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0511
20510      IVFAIL = IVFAIL + 1
           DVCORR = 95.83D2
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
 0511      CONTINUE
CT052*  TEST 52
           IVTNUM = 52
           IVCOMP = 0
           IF (AVB) IVCOMP = 1
           IF (IVCOMP - 0) 20520, 10520, 20520
10520      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0521
20520      IVFAIL = IVFAIL + 1
           LVCORR = 0
           REMRKS = '1 = TRUE ;  0 = FALSE'
           WRITE (NUVI, 80008) IVTNUM, REMRKS
           WRITE (NUVI, 80024) IVCOMP
           WRITE (NUVI, 80026) LVCORR
 0521      CONTINUE
CT053*  TEST 53
           IVTNUM = 53
           IVCOMP = 0
           IF (A8VK.EQ.'.FALSE.1') IVCOMP = 1
           IF (IVCOMP - 1) 20530, 10530, 20530
10530      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0531
20530      IVFAIL = IVFAIL + 1
           CVCORR = '.FALSE.1'
           WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
 0531      CONTINUE
CT054*  TEST 54
           IVTNUM = 54
           IF (BVS - 0.34528E+03) 20540, 10540, 40540
40540      IF (BVS - 0.34532E+03) 10540, 10540, 20540
10540      IVPASS = IVPASS + 1
           WRITE (NUVI, 80002) IVTNUM
           GO TO 0541
20540      IVFAIL = IVFAIL + 1
           RVCORR = 345.3
           WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
 0541      CONTINUE
C*****
CBB** ********************** BBCSUM0  **********************************
C**** WRITE OUT TEST SUMMARY
C****
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
      WRITE (I02, 90004)
      WRITE (I02, 90014)
      WRITE (I02, 90004)
      WRITE (I02, 90020) IVPASS
      WRITE (I02, 90022) IVFAIL
      WRITE (I02, 90024) IVDELE
      WRITE (I02, 90026) IVINSP
      WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0  **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
      WRITE (I02,90016) ZPROG, ZPROG
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
      WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS  ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL  ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,15X,10HCOMPUTED= ,
     1I6,/,1H ,15X,10HCORRECT=  ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,
     1E12.5,/,1H ,16X,10HCORRECT=  ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,
     1A21,/,1H ,16X,10HCORRECT=  ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT=  ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT=  ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT=  ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,
     1D17.10,/,1H ,16X,10HCORRECT=  ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT=  ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT=  ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT=  ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,
     11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT=  ,
     21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H  -  COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST   ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
     1       7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
     1        33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H   *   ,A10,1H/,
     1        A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY     ,35X,15HCOPYRIGHT  1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C*****    END OF TEST SEGMENT 392
      STOP
      END