FM912.f Source File

*********** 00010913 FORTRAN 77 00020913 * FM913 00030913 * SN913 FAQ - (807) 00040913 * THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913 ********** 00060913



Contents

Source Code


Source Code

      PROGRAM FM912

C***********************************************************************00010912
C*****  FORTRAN 77                                                      00020912
C*****   FM912                                                          00030912
C*****                       DIRAF3 - (412)                             00040912
C*****   THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913              00050912
C***********************************************************************00060912
C*****  TESTING OF DIRECT ACCESS FILES                         ANS REF  00070912
C*****          FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT       12.5   00080912
C*****          ACCESS TO THE SAME FILE                                 00090912
C*****                                                                  00100912
C*****          USES SUBROUTINE SN913    FAQ                            00110912
C*****                                                                  00120912
C*****  S P E C I F I C A T I O N S  SEGMENT 412                        00130912
C***********************************************************************00140912
        DIMENSION F1S(10), G1S(10)                                      00150912
        CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10)          00160912
        CHARACTER*47 A47VK, B47VK, C47VK                                00170912
        CHARACTER*51 A51VK                                              00180912
        CHARACTER*12 A12VK                                              00190912
        CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4                00200912
        CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45          00210912
        LOGICAL AVB, BVB, CVB, C1B(10), D1B(10)                         00220912
        DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15)           00230912
C*****                                                                  00240912
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.   00250912
CX20   REPLACED BY FEXEC X-20  CONTROL CARD.  X-20  IS FOR REPLACING    00260912
        CHARACTER*15 CDIR                                               00270912
C      THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130     00280912
C      (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR.          00290912
CBB** ********************** BBCINITA **********************************00300912
C**** SPECIFICATION STATEMENTS                                          00310912
C****                                                                   00320912
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00330912
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00340912
CBE** ********************** BBCINITA **********************************00350912
CBB** ********************** BBCINITB **********************************00360912
C**** INITIALIZE SECTION                                                00370912
      DATA  ZVERS,                  ZVERSD,             ZDATE           00380912
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00390912
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00400912
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00410912
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00420912
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00430912
      DATA   REMRKS /'                               '/                 00440912
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00450912
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00460912
C****                                                                   00470912
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00480912
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00490912
CZ03  ZPROG  = 'PROGRAM NAME'                                           00500912
CZ04  ZDATE  = 'DATE OF TEST'                                           00510912
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00520912
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00530912
CZ07  ZNAME  = 'NAME OF USER'                                           00540912
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00550912
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00560912
C                                                                       00570912
      IVPASS = 0                                                        00580912
      IVFAIL = 0                                                        00590912
      IVDELE = 0                                                        00600912
      IVINSP = 0                                                        00610912
      IVTOTL = 0                                                        00620912
      IVTOTN = 0                                                        00630912
      ICZERO = 0                                                        00640912
C                                                                       00650912
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00660912
      I01 = 05                                                          00670912
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00680912
      I02 = 06                                                          00690912
C                                                                       00700912
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710912
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00720912
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00730912
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00740912
C                                                                       00750912
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00760912
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00770912
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00780912
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00790912
C                                                                       00800912
CBE** ********************** BBCINITB **********************************00810912
C*****                                                                  00820912
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF THE                00830912
C*****    UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED.     00840912
C*****                                                                  00850912
C     I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE.      00860912
      I13 = 24                                                          00870912
CX130   REPLACED BY FEXEC X-130 CONTROL CARD (DIR. FILE UNIT NUMBER).   00880912
C     SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24.               00890912
C                                                                       00900912
C*****  THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME             00910912
C*****  GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,               00920912
C*****  FORMATTED FILE.                                                 00930912
C*****                                                                  00940912
C     CDIR CONTAINS THE FILE NAME FOR UNIT I13.                         00950912
      CDIR = '        DIRFILE'                                          00960912
C                                                                       00970912
CX201   REPLACED BY FEXEC X-201 CONTROL CARD.  CX201 IS FOR SYSTEMS     00980912
C     REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH    00990912
C     X-130 THAN THE DEFAULT CDIR = '        DIRFILE'.                  01000912
C                                                                       01010912
C*****                          FILE NUMBER AND NAME ASSIGNMENT         01020912
        NUVI = I02                                                      01030912
        KUVI = I13                                                      01040912
        IVTOTL = 26                                                     01050912
        ZPROG = 'FM912'                                                 01060912
C*****                                                                  01070912
C*****  FILE NUMBER AND NAME ASSIGNMENT                                 01080912
C*****                                                                  01090912
        REMK1='RECORD 1 - ERR PATH TAKEN'                               01100912
        REMK2='RECORD 2 - ERR PATH TAKEN'                               01110912
        REMK3='RECORD 3 - ERR PATH TAKEN'                               01120912
        REMK4='RECORD 4 - ERR PATH TAKEN'                               01130912
        REMK5='RECORD 5 - ERR PATH TAKEN'                               01140912
        REMK45='RECORD 4 + 5 - ERR PATH TAKEN'                          01150912
CBB** ********************** BBCHED0A **********************************01160912
C****                                                                   01170912
C**** WRITE REPORT TITLE                                                01180912
C****                                                                   01190912
      WRITE (I02, 90002)                                                01200912
      WRITE (I02, 90006)                                                01210912
      WRITE (I02, 90007)                                                01220912
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01230912
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01240912
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01250912
CBE** ********************** BBCHED0A **********************************01260912
        WRITE(NUVI,41200)                                               01270912
41200   FORMAT( " ",/"  DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE" /  01280912
     1          "  WITH OPTION TO OPEN AS A SEQUENTIAL FILE" /          01290912
     2          "  ANS REF. - 12.5" )                                   01300912
CBB** ********************** BBCHED0B **********************************01310912
C**** WRITE DETAIL REPORT HEADERS                                       01320912
C****                                                                   01330912
      WRITE (I02,90004)                                                 01340912
      WRITE (I02,90004)                                                 01350912
      WRITE (I02,90013)                                                 01360912
      WRITE (I02,90014)                                                 01370912
      WRITE (I02,90015) IVTOTL                                          01380912
CBE** ********************** BBCHED0B **********************************01390912
C*****                                                                  01400912
C*****  PLUS OR MINUS VALUES                                            01410912
C*****                                                                  01420912
        CVS = 0.0001                                                    01430912
        CVD = 0.0001D0                                                  01440912
C*****                                                                  01450912
C*****  INITIALIZE DATA ARRAYS                                          01460912
C*****                                                                  01470912
        CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K)                 01480912
C*****                                                                  01490912
C*****  OPEN DIRECT ACCESS FILE - STATUS=NEW                            01500912
C*****                                                                  01510912
        OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120,            01520912
     1            FORM='FORMATTED',STATUS='NEW')                        01530912
C*****                                                                  01540912
CT001*  TEST 1 - CHECKS RECL AND NEXTREC                                01550912
C*****           FOR JUST OPENED DIRECT ACCESS FILE                     01560912
C*****                                                                  01570912
        IVTNUM=1                                                        01580912
        INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI)                       01590912
        IF (IVI .NE. 120) GO TO 33020                                   01600912
        IF (KVI .NE. 1) GO TO 33020                                     01610912
        WRITE(NUVI,80002)IVTNUM                                         01620912
        IVPASS=IVPASS+1                                                 01630912
        GO TO 33030                                                     01640912
33020   REMK='ERROR IN INQUIRE'                                         01650912
        WRITE(NUVI,55010)IVTNUM,REMK                                    01660912
55010   FORMAT(" ","TEST ",I3,1X," FAIL",34X,A31)                       01670912
        IVFAIL=IVFAIL+1                                                 01680912
        WRITE(NUVI,55020)IVI,KVI                                        01690912
55020   FORMAT(" ",/,11X,"COMPUTED:  RECL=" ,I6,5X,"NEXTREC=",I6)       01700912
        WRITE(NUVI,55030)                                               01710912
55030   FORMAT(" ",10X,"CORRECT:   RECL=   120" ,5X,"NEXTREC=     1" /) 01720912
C*****                                                                  01730912
CT002*  TEST 2 - WRITES RECORD 1                                        01740912
C*****                                                                  01750912
33030   IVTNUM=2                                                        01760912
        IVI = 1                                                         01770912
        AVS = F1S (IVI)                                                 01780912
        BVS = F1S(IVI + 1)                                              01790912
        A20VK = A201K (IVI)                                             01800912
        AVB = C1B (IVI)                                                 01810912
        AVD = D1D (IVI)                                                 01820912
        WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD,  01830912
     1                                             AVB, A20VK           01840912
41204   FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD')  01850912
        WRITE(NUVI,80002)IVTNUM                                         01860912
        IVPASS=IVPASS+1                                                 01870912
        GO TO 33050                                                     01880912
33040   WRITE(NUVI,55010)IVTNUM,REMK1                                   01890912
        IVFAIL=IVFAIL+1                                                 01900912
C*****                                                                  01910912
CT003*  TEST 3 - WRITES RECORD 2                                        01920912
C*****                                                                  01930912
33050   IVTNUM=3                                                        01940912
        IVI = IVI + 1                                                   01950912
        AVS = F1S (IVI)                                                 01960912
        BVS = F1S(IVI + 1)                                              01970912
        A20VK = A201K (IVI)                                             01980912
        AVB = C1B (IVI)                                                 01990912
        AVD = D1D (IVI)                                                 02000912
        WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS,  02010912
     1                                             AVB, A20VK           02020912
41205   FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD')  02030912
        WRITE(NUVI,80002)IVTNUM                                         02040912
        IVPASS=IVPASS+1                                                 02050912
        GO TO 33070                                                     02060912
33060   WRITE(NUVI,55010)IVTNUM,REMK2                                   02070912
        IVFAIL=IVFAIL+1                                                 02080912
C*****                                                                  02090912
CT004*  TEST 4 - WRITES RECORD 3                                        02100912
C*****                                                                  02110912
33070   IVTNUM=4                                                        02120912
        IVI = IVI + 1                                                   02130912
        AVS = F1S (IVI)                                                 02140912
        BVS = F1S(IVI + 1)                                              02150912
        A20VK = A201K (IVI)                                             02160912
        AVB = C1B (IVI)                                                 02170912
        AVD = D1D (IVI)                                                 02180912
        WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD,  02190912
     1                                             AVB, A20VK           02200912
41206   FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC')  02210912
        WRITE(NUVI,80002)IVTNUM                                         02220912
        IVPASS=IVPASS+1                                                 02230912
        GO TO 33090                                                     02240912
                                                                        02250912
33080   WRITE(NUVI,55010)IVTNUM,REMK3                                   02260912
        IVFAIL=IVFAIL+1                                                 02270912
C*****                                                                  02280912
CT005*  TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE                  02290912
C*****                                                                  02300912
33090   IVTNUM=5                                                        02310912
        IVI = IVI + 1                                                   02320912
        AVS = F1S (IVI)                                                 02330912
        BVS = F1S(IVI + 1)                                              02340912
        A20VK = A201K (IVI)                                             02350912
        AVB = C1B (IVI)                                                 02360912
        AVD = D1D (IVI)                                                 02370912
        WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB,  02380912
     1                     A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK   02390912
41207   FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/ 02400912
     1         E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END')        02410912
        WRITE(NUVI,80002)IVTNUM                                         02420912
        IVPASS=IVPASS+1                                                 02430912
        GO TO 33290                                                     02440912
33100   WRITE(NUVI,55010)IVTNUM,REMK45                                  02450912
        IVFAIL=IVFAIL+1                                                 02460912
C*****                                                                  02470912
CT006*  TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE                  02480912
C*****                                                                  02490912
33290   IVTNUM=6                                                        02500912
        INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI)                       02510912
        IF (IVI .NE. 120)GO TO 33300                                    02520912
        IF(KVI .NE. 6)GO TO 33300                                       02530912
        WRITE(NUVI,80002)IVTNUM                                         02540912
        IVPASS=IVPASS+1                                                 02550912
        GO TO 33110                                                     02560912
33300   REMK='ERROR IN INQUIRE'                                         02570912
        WRITE(NUVI,55010)IVTNUM,REMK                                    02580912
        IVFAIL=IVFAIL+1                                                 02590912
        WRITE(NUVI,55020)IVI,KVI                                        02600912
        WRITE(NUVI,55040)                                               02610912
55040   FORMAT(" ",10X,"CORRECT:   RECL=   120" ,5X,"NEXTREC=     6" /) 02620912
C*****                                                                  02630912
CT007*  TEST 7 - READS RECORD 1                                         02640912
C*****                                                                  02650912
33110   IVTNUM=7                                                        02660912
        IVI = 1                                                         02670912
        READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD, 02680912
     1                                              AVB, A20VK, A47VK   02690912
41210   FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47)                  02700912
        ISWT=1                                                          02710912
        GO TO 33220                                                     02720912
                                                                        02730912
33120   WRITE(NUVI,55010)IVTNUM,REMK1                                   02740912
        IVFAIL=IVFAIL+1                                                 02750912
C*****                                                                  02760912
CT008*  TEST 8 - READS RECORD 2                                         02770912
C*****                                                                  02780912
33130   IVTNUM=8                                                        02790912
        IVI = 2                                                         02800912
        READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS, 02810912
     1                                              AVB, A20VK, A51VK   02820912
41238   FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51)                   02830912
        ISWT=2                                                          02840912
        GO TO 33230                                                     02850912
                                                                        02860912
33140   WRITE(NUVI,55010)IVTNUM,REMK2                                   02870912
        IVFAIL=IVFAIL+1                                                 02880912
C*****                                                                  02890912
CT009*  TEST 9 - READS RECORD 3                                         02900912
C*****                                                                  02910912
33150   IVTNUM=9                                                        02920912
        IVI = 3                                                         02930912
        READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD, 02940912
     1                                              BVB, B20VK, B47VK   02950912
        ISWT=3                                                          02960912
        GO TO 33240                                                     02970912
                                                                        02980912
33160   WRITE(NUVI,55010)IVTNUM,REMK3                                   02990912
        IVFAIL=IVFAIL+1                                                 03000912
C*****                                                                  03010912
CT010*  TEST 10 - READS RECORD 4                                        03020912
C*****                                                                  03030912
33170   IVTNUM=10                                                       03040912
        IVI = 4                                                         03050912
        READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB, 03060912
     1                                              C20VK, FVS, C47VK   03070912
41241   FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47)                  03080912
        ISWT=4                                                          03090912
        GO TO 33250                                                     03100912
                                                                        03110912
33180   WRITE(NUVI,55010)IVTNUM,REMK4                                   03120912
        IVFAIL=IVFAIL+1                                                 03130912
C*****                                                                  03140912
CT011*  TEST 11 - READS RECORD 5                                        03150912
C*****                                                                  03160912
33190   IVTNUM=11                                                       03170912
        IVI = 5                                                         03180912
        JVI = 4                                                         03190912
        READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI, 03200912
     1                                              AVS, A20VK, A51VK   03210912
41218   FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51)                   03220912
        ISWT=5                                                          03230912
        GO TO 33260                                                     03240912
                                                                        03250912
33200   WRITE(NUVI,55010)IVTNUM,REMK5                                   03260912
        IVFAIL=IVFAIL+1                                                 03270912
C*****                                                                  03280912
CT012*  TEST 12 - OVERWRITES RECORD 3                                   03290912
C*****                                                                  03300912
33210   IVTNUM=12                                                       03310912
        IVI = 3                                                         03320912
        AVS = G1S (IVI)                                                 03330912
        BVS = G1S(IVI + 1)                                              03340912
        A20VK = B201K (IVI)                                             03350912
        AVB = D1B (IVI)                                                 03360912
        AVD = B1D (IVI)                                                 03370912
        WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD,  03380912
     1                                             A20VK, AVB           03390912
41251   FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW  RECORD ')  03400912
        WRITE(NUVI,80002)IVTNUM                                         03410912
        IVPASS=IVPASS+1                                                 03420912
        GO TO 33320                                                     03430912
                                                                        03440912
33310   WRITE(NUVI,55010)IVTNUM,REMK3                                   03450912
        IVFAIL=IVFAIL+1                                                 03460912
C*****                                                                  03470912
CT013*  TEST 13 - OVERWRITES RECORD 5                                   03480912
C*****                                                                  03490912
33320   IVTNUM=13                                                       03500912
        IVI = 5                                                         03510912
        AVS = G1S (IVI)                                                 03520912
        BVS = G1S(IVI - 1)                                              03530912
        A20VK = B201K (IVI)                                             03540912
        AVB = D1B (IVI)                                                 03550912
        AVD = B1D (IVI)                                                 03560912
        WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,03570912
     1                                             BVS, AVB             03580912
41252   FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP  RECORD')  03590912
        WRITE(NUVI,80002)IVTNUM                                         03600912
        IVPASS=IVPASS+1                                                 03610912
        GO TO 33340                                                     03620912
                                                                        03630912
33330   WRITE(NUVI,55010)IVTNUM,REMK5                                   03640912
        IVFAIL=IVFAIL+1                                                 03650912
C*****                                                                  03660912
C*****  CLOSE AND REOPEN DIRECT ACCESS FILE                             03670912
C*****                                                                  03680912
33340   CLOSE(UNIT=KUVI)                                                03690912
        OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD',        03700912
     1       FORM='FORMATTED',RECL=120)                                 03710912
C*****                                                                  03720912
CT014*  TEST 14 - READS RECORD 4                                        03730912
C*****                                                                  03740912
        IVTNUM=14                                                       03750912
        IVI = 4                                                         03760912
        READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB, 03770912
     1                                              C20VK, FVS, C47VK   03780912
        ISWT=6                                                          03790912
        GO TO 33250                                                     03800912
                                                                        03810912
33350   WRITE(NUVI,55010)IVTNUM,REMK4                                   03820912
        IVFAIL=IVFAIL+1                                                 03830912
C*****                                                                  03840912
CT015*  TEST 15 - READS THE CHANGED RECORD 5                            03850912
C*****                                                                  03860912
33360   IVTNUM=15                                                       03870912
        IVI = 5                                                         03880912
        READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK,    03890912
     1                                              AVD, BVS, AVB, A47VK03900912
41254   FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47)                  03910912
        ISWT=7                                                          03920912
        IF (KVI .NE. IVI) GOTO 41221                                    03930912
        IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122303940912
        IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 4122503950912
        IF (A20VK .NE. B201K(IVI)) GOTO 41229                           03960912
        IF ((AVB .AND. .NOT. D1B(IVI)) .OR.                             03970912
     1      (.NOT. AVB .AND. D1B(IVI))) GOTO 41233                      03980912
        IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122703990912
        IF (A47VK .NE.                                                  04000912
     1  '                                   STOP  RECORD') GOTO 41231   04010912
        WRITE(NUVI,80002)IVTNUM                                         04020912
        IVPASS=IVPASS+1                                                 04030912
        GO TO 33380                                                     04040912
33370   WRITE(NUVI,55010)IVTNUM,REMK5                                   04050912
        IVFAIL=IVFAIL+1                                                 04060912
C*****                                                                  04070912
CT016*  TEST 16 - READS RECORD 2                                        04080912
C*****                                                                  04090912
33380   IVTNUM=16                                                       04100912
        IVI = 2                                                         04110912
        READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS, 04120912
     1                                              AVB, A20VK, A51VK   04130912
        ISWT=8                                                          04140912
        GO TO 33230                                                     04150912
                                                                        04160912
33390   WRITE(NUVI,55010)IVTNUM,REMK2                                   04170912
        IVFAIL=IVFAIL+1                                                 04180912
C*****                                                                  04190912
CT017*  TEST 17 - READS THE CHANGED RECORD 3                            04200912
C*****                                                                  04210912
33400   IVTNUM=17                                                       04220912
        IVI = 3                                                         04230912
        READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD,   04240912
     1                                            A20VK, AVB, A47VK     04250912
41256   FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47)                  04260912
        ISWT=9                                                          04270912
        IF (KVI .NE. IVI) GOTO 41221                                    04280912
        IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122304290912
        IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 4122504300912
        IF (A20VK .NE. B201K(IVI)) GOTO 41229                           04310912
        IF ((AVB .AND. .NOT. D1B(IVI)) .OR.                             04320912
     1      (.NOT. AVB .AND. D1B(IVI))) GOTO 41233                      04330912
        IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122704340912
        IF (A47VK .NE.                                                  04350912
     1  '                                   NEW  RECORD ') GOTO 41231   04360912
        WRITE(NUVI,80002)IVTNUM                                         04370912
        IVPASS=IVPASS+1                                                 04380912
        GO TO 33420                                                     04390912
                                                                        04400912
33410   WRITE(NUVI,55010)IVTNUM,REMK3                                   04410912
        IVFAIL=IVFAIL+1                                                 04420912
C*****                                                                  04430912
CT018*  TEST 18 - READS RECORD 1                                        04440912
C*****                                                                  04450912
33420   IVTNUM=18                                                       04460912
        IVI = 1                                                         04470912
        READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD, 04480912
     1                                              AVB, A20VK, A47VK   04490912
        ISWT=10                                                         04500912
        GO TO 33220                                                     04510912
                                                                        04520912
33430   WRITE(NUVI,55010)IVTNUM,REMK1                                   04530912
        IVFAIL=IVFAIL+1                                                 04540912
C*****                                                                  04550912
CT019*  TEST 19 - OVERWRITES RECORD 4                                   04560912
C*****                                                                  04570912
33440   IVTNUM=19                                                       04580912
41258   IVI = 4                                                         04590912
        KVI = IVI + 1                                                   04600912
        AVS = F1S (IVI)                                                 04610912
        BVS = F1S(IVI + 1)                                              04620912
        EVS = F1S(IVI) + 2.34                                           04630912
        AVD = D1D (IVI)                                                 04640912
        WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS,  04650912
     1                                             EVS, AVD             04660912
41259   FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8)                  04670912
        WRITE(NUVI,80002)IVTNUM                                         04680912
        IVPASS=IVPASS+1                                                 04690912
        GO TO 33460                                                     04700912
                                                                        04710912
33450   WRITE(NUVI,55010)IVTNUM,REMK4                                   04720912
        IVFAIL=IVFAIL+1                                                 04730912
C*****                                                                  04740912
CT020*  TEST 20 - OVERWRITES RECORDS 1, 2, AND 3                        04750912
C*****                                                                  04760912
33460   IVTNUM=20                                                       04770912
        IVI = 1                                                         04780912
        A1VK = 'A'                                                      04790912
        A4VK = A201K (IVI) (1:4)                                        04800912
        AVB = C1B (IVI)                                                 04810912
        AVD = D1D (IVI)                                                 04820912
        BVD = D1D (IVI) + 3.234D2                                       04830912
        WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK, 04840912
     1                                             A4VK                 04850912
41260   FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//,             04860912
     1         "HOLLERITH " , T15, 'ONE', 10X, TL5, 'TWO', TR5,         04870912
     2         'THREE', :, 'LAST')                                      04880912
        WRITE(NUVI,80002)IVTNUM                                         04890912
        IVPASS=IVPASS+1                                                 04900912
        GO TO 33480                                                     04910912
                                                                        04920912
33470   WRITE(NUVI,55010)IVTNUM,REMK1                                   04930912
        IVFAIL=IVFAIL+1                                                 04940912
C*****                                                                  04950912
CT021*  TEST 21 - OVERWRITES RECORD 5                                   04960912
C*****                                                                  04970912
33480   IVTNUM=21                                                       04980912
        IVI = 5                                                         04990912
        BVS = F1S(IVI - 1)                                              05000912
        AVD = B1D (4)                                                   05010912
        WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD   05020912
41261   FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2)                     05030912
        WRITE(NUVI,80002)IVTNUM                                         05040912
        IVPASS=IVPASS+1                                                 05050912
        GO TO 33500                                                     05060912
                                                                        05070912
33490   WRITE(NUVI,55010)IVTNUM,REMK5                                   05080912
        IVFAIL=IVFAIL+1                                                 05090912
C*****                                                                  05100912
C*****  CLOSE AND REOPEN DIRECT ACCESS FILE                             05110912
C*****                                                                  05120912
33500   CLOSE(UNIT=KUVI)                                                05130912
        OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD',        05140912
     1       FORM='FORMATTED',RECL=120)                                 05150912
C*****                                                                  05160912
CT022*  TEST 22 - READS RECORD 1                                        05170912
C*****                                                                  05180912
        IVTNUM=22                                                       05190912
        IVI = 1                                                         05200912
        READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB,    05210912
     1                                              A1VK, A4VK, A12VK   05220912
41262   FORMAT(G14.8, A20, L2, A, A4, A12)                              05230912
        ISWT=1                                                          05240912
        IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4127705250912
        IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279                   05260912
        IF ((A1VK .NE. 'A') .OR.                                        05270912
     1     (A4VK .NE. A201K(IVI)(1:4)) .OR.                             05280912
     2     (A12VK .NE. 'TSAL DROCER')) GOTO 41279                       05290912
        WRITE(NUVI,80002)IVTNUM                                         05300912
        IVPASS=IVPASS+1                                                 05310912
        GO TO 33520                                                     05320912
                                                                        05330912
33510   WRITE(NUVI,55010)IVTNUM,REMK1                                   05340912
        IVFAIL=IVFAIL+1                                                 05350912
C*****                                                  RECORD # 4      05360912
CT023*  TEST 23 - READS RECORD 4                                        05370912
C*****                                                                  05380912
33520   IVTNUM=23                                                       05390912
        IVI = 4                                                         05400912
        READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS,    05410912
     1                                              BVS, B20VK, AVD     05420912
41266   FORMAT(I5, A5, F10.5, E14.6, A20, D14.8)                        05430912
        ISWT=2                                                          05440912
        IF (A20VK(3:5) .NE. '005') GOTO 41293                           05450912
        IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR.     05460912
     1     (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR.      05470912
     2     (B20VK(13:20) .NE. '.6E+0001')) GOTO 41293                   05480912
        WRITE(NUVI,80002)IVTNUM                                         05490912
        IVPASS=IVPASS+1                                                 05500912
        GO TO 33540                                                     05510912
                                                                        05520912
33530   WRITE(NUVI,55010)IVTNUM,REMK4                                   05530912
        IVFAIL=IVFAIL+1                                                 05540912
C*****                                                                  05550912
CT024*  TEST 24 - READS RECORD 2   TESTS FOR BLANK RECORD               05560912
C*****                                                                  05570912
33540   IVTNUM=24                                                       05580912
        B120VK = ' '                                                    05590912
        IVI = 2                                                         05600912
        READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK              05610912
41269   FORMAT(A120)                                                    05620912
        ISWT=3                                                          05630912
        IF (A120VK .NE. B120VK) GOTO 41281                              05640912
        WRITE(NUVI,80002)IVTNUM                                         05650912
        IVPASS=IVPASS+1                                                 05660912
        GO TO 33560                                                     05670912
                                                                        05680912
33550   WRITE(NUVI,55010)IVTNUM,REMK2                                   05690912
        IVFAIL=IVFAIL+1                                                 05700912
C*****                                                                  05710912
CT025*  TEST 25 - READS RECORD 5                                        05720912
C*****                                                                  05730912
33560   IVTNUM=25                                                       05740912
        IVI = 5                                                         05750912
        READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS,    05760912
     1                                              B20VK, C20VK        05770912
41271   FORMAT(A5, F10.5, BZ, A5, BN, A20)                              05780912
        ISWT=4                                                          05790912
        IF (A20VK(1:5) .NE. '   +5') GOTO 41283                         05800912
        IF (B20VK(1:5) .NE. '    5') GOTO 41285                         05810912
        IF (C20VK(1:14) .NE. '  625.0000E-03') GOTO 41287               05820912
        WRITE(NUVI,80002)IVTNUM                                         05830912
        IVPASS=IVPASS+1                                                 05840912
        GO TO 33580                                                     05850912
                                                                        05860912
33570   WRITE(NUVI,55010)IVTNUM,REMK5                                   05870912
        IVFAIL=IVFAIL+1                                                 05880912
C*****                                                                  05890912
CT026*  TEST 26 - READS RECORD 3                                        05900912
C*****                                                                  05910912
33580   IVTNUM=26                                                       05920912
        IVI = 3                                                         05930912
        READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK              05940912
41275   FORMAT(A120)                                                    05950912
        ISWT=5                                                          05960912
        IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289                   05970912
        IF (A120VK(11:40) .NE.                                          05980912
     1   '    ONE     TWO     THREE     ') GOTO 41291                   05990912
        WRITE(NUVI,80002)IVTNUM                                         06000912
        IVPASS=IVPASS+1                                                 06010912
        GO TO 33600                                                     06020912
                                                                        06030912
33590   WRITE(NUVI,55010)IVTNUM,REMK3                                   06040912
        IVFAIL=IVFAIL+1                                                 06050912
C*****                                                                  06060912
C*****  CLOSE DIRECT ACCESS FILE                                        06070912
C*****                                                                  06080912
33600   CLOSE(UNIT=KUVI,STATUS='DELETE')                                06090912
        GO TO 33610                                                     06100912
C*****                                                                  06110912
C*****  CHECKING RECORD 1                                               06120912
C*****                                                                  06130912
33220   IF (KVI .NE. IVI) GOTO 41221                                    06140912
        IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306150912
        IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506160912
        IF (A20VK .NE. A201K(IVI)) GOTO 41229                           06170912
        IF (A47VK .NE.                                                  06180912
     1  '                                    LAST RECORD') GOTO 41231   06190912
        IF ((AVB .AND. .NOT. C1B(IVI)) .OR.                             06200912
     1      (.NOT. AVB .AND. C1B(IVI))) GOTO 41233                      06210912
        IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706220912
        WRITE(NUVI,80002)IVTNUM                                         06230912
        IVPASS=IVPASS+1                                                 06240912
        IF (ISWT .EQ. 10)GO TO 33440                                    06250912
        GO TO 33130                                                     06260912
                                                                        06270912
41221   WRITE(NUVI,41222)IVTNUM,IVI                                     06280912
        IVFAIL=IVFAIL+1                                                 06290912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06300912
     1         33420,33440)ISWT                                         06310912
                                                                        06320912
41223   WRITE(NUVI,41224)IVTNUM,IVI                                     06330912
        IVFAIL=IVFAIL+1                                                 06340912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06350912
     1         33420,33440)ISWT                                         06360912
                                                                        06370912
41225   WRITE(NUVI,41226)IVTNUM,IVI                                     06380912
        IVFAIL=IVFAIL+1                                                 06390912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06400912
     1         33420,33440)ISWT                                         06410912
                                                                        06420912
41227   WRITE(NUVI,41228)IVTNUM,IVI                                     06430912
        IVFAIL=IVFAIL+1                                                 06440912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06450912
     1         33420,33440)ISWT                                         06460912
                                                                        06470912
41229   WRITE(NUVI,41230)IVTNUM,IVI                                     06480912
        IVFAIL=IVFAIL+1                                                 06490912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06500912
     1         33420,33440)ISWT                                         06510912
                                                                        06520912
41231   WRITE(NUVI,41232)IVTNUM,IVI                                     06530912
        IVFAIL=IVFAIL+1                                                 06540912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06550912
     1         33420,33440)ISWT                                         06560912
                                                                        06570912
41233   WRITE(NUVI,41234)IVTNUM,IVI                                     06580912
        IVFAIL=IVFAIL+1                                                 06590912
        GO TO (33130,33150,33170,33190,33210,33360,33380,33400,         06600912
     1         33420,33440)ISWT                                         06610912
C*****                                                                  06620912
C*****  CHECKING RECORD 2                                               06630912
C*****                                                                  06640912
33230   IF (KVI .NE. IVI) GOTO 41221                                    06650912
        IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306660912
        IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506670912
        IF (A20VK .NE. A201K(IVI)) GOTO 41229                           06680912
        IF ((AVB .AND. .NOT. C1B(IVI)) .OR.                             06690912
     1      (.NOT. AVB .AND. C1B(IVI))) GOTO 41233                      06700912
        IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706710912
        IF (A51VK .NE.                                                  06720912
     1 '                               LASTS RECORD        ')GOTO 41231 06730912
        WRITE(NUVI,80002)IVTNUM                                         06740912
        IVPASS=IVPASS+1                                                 06750912
        IF (ISWT .EQ. 8)GO TO 33400                                     06760912
        GO TO 33150                                                     06770912
C*****                                                                  06780912
C*****  CHECKING RECORD 3                                               06790912
C*****                                                                  06800912
33240   IF (LVI .NE. IVI) GOTO 41221                                    06810912
        IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 4122306820912
        IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 4122506830912
        IF (B20VK .NE. A201K(IVI)) GOTO 41229                           06840912
        IF ((BVB .AND. .NOT. C1B(IVI)) .OR.                             06850912
     1      (.NOT. BVB .AND. C1B(IVI))) GOTO 41233                      06860912
        IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 4122706870912
        IF (B47VK .NE.                                                  06880912
     1  '                              THE LAST REC     ') GOTO 41231   06890912
        WRITE(NUVI,80002)IVTNUM                                         06900912
        IVPASS=IVPASS+1                                                 06910912
        GO TO 33170                                                     06920912
C*****                                                                  06930912
C*****  CHECKING RECORD 4                                               06940912
C*****                                                                  06950912
33250   IF (NVI .NE. IVI) GOTO 41221                                    06960912
        IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 4122306970912
        IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 4122506980912
        IF (C20VK .NE. A201K(IVI)) GOTO 41229                           06990912
        IF ((CVB .AND. .NOT. C1B(IVI)) .OR.                             07000912
     1      (.NOT. CVB .AND. C1B(IVI))) GOTO 41233                      07010912
        IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 4122707020912
        IF (C47VK .NE.                                                  07030912
     1  '                                   NEXT TO LAST') GOTO 41231   07040912
        WRITE(NUVI,80002)IVTNUM                                         07050912
        IVPASS=IVPASS+1                                                 07060912
        IF (ISWT .EQ. 6)GO TO 33360                                     07070912
        GO TO 33190                                                     07080912
C*****                                                                  07090912
C*****  CHECKING RECORD 5                                               07100912
C*****                                                                  07110912
33260   IF (KVI .NE. JVI) GOTO 41221                                    07120912
        IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 4122307130912
        IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 4122507140912
        IF (A20VK .NE. A201K(JVI)) GOTO 41229                           07150912
        IF ((AVB .AND. .NOT. C1B(JVI)) .OR.                             07160912
     1      (.NOT. AVB .AND. C1B(JVI))) GOTO 41233                      07170912
        IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 4122707180912
        IF (A51VK .NE.                                                  07190912
     1 '                              THE END              ') GOTO 4123107200912
        WRITE(NUVI,80002)IVTNUM                                         07210912
        IVPASS=IVPASS+1                                                 07220912
        GO TO 33210                                                     07230912
C*****                                                                  07240912
C*****                                                                  07250912
C*****                                                                  07260912
41277   WRITE(NUVI,41278)IVTNUM,IVI                                     07270912
        IVFAIL=IVFAIL+1                                                 07280912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07290912
                                                                        07300912
41279   WRITE(NUVI,41280)IVTNUM,IVI                                     07310912
        IVFAIL=IVFAIL+1                                                 07320912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07330912
                                                                        07340912
41281   WRITE(NUVI,41282)IVTNUM,IVI                                     07350912
        IVFAIL=IVFAIL+1                                                 07360912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07370912
                                                                        07380912
41283   WRITE(NUVI,41284)IVTNUM,IVI                                     07390912
        IVFAIL=IVFAIL+1                                                 07400912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07410912
                                                                        07420912
41285   WRITE(NUVI,41286)IVTNUM,IVI                                     07430912
        IVFAIL=IVFAIL+1                                                 07440912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07450912
                                                                        07460912
41287   WRITE(NUVI,41288)IVTNUM,IVI                                     07470912
        IVFAIL=IVFAIL+1                                                 07480912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07490912
                                                                        07500912
41289   WRITE(NUVI,41290)IVTNUM,IVI                                     07510912
        IVFAIL=IVFAIL+1                                                 07520912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07530912
                                                                        07540912
41291   WRITE(NUVI,41292)IVTNUM,IVI                                     07550912
        IVFAIL=IVFAIL+1                                                 07560912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07570912
                                                                        07580912
41293   WRITE(NUVI,41294)IVTNUM,IVI                                     07590912
        IVFAIL=IVFAIL+1                                                 07600912
        GO TO(33520,33540,33560,33580,33600)ISWT                        07610912
C*****                                                                  07620912
C*****                                                                  07630912
C*****                                                                  07640912
41222   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07650912
     1         " - ON I FORMAT" )                                       07660912
41224   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07670912
     1         " - ON F FORMAT" )                                       07680912
41226   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07690912
     1         " - ON E FORMAT" )                                       07700912
41228   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07710912
     1         " - ON D FORMAT" )                                       07720912
41230   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07730912
     1         " - ON A FORMAT" )                                       07740912
41232   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07750912
     1         " - ON X AND ' FORMAT" )                                 07760912
41234   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07770912
     1         " - ON L FORMAT" )                                       07780912
41278   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07790912
     1         " - ON GW.D FORMAT" )                                    07800912
41280   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07810912
     1         " - ON GW.DEN FORMAT" )                                  07820912
41282   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07830912
     1         " - ON BLANK RECORD " )                                  07840912
41284   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07850912
     1         " - ON SP FORMAT    " )                                  07860912
41286   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07870912
     1         " - ON BZ OR SS FORMAT" )                                07880912
41288   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07890912
     1         " - ON NP FORMAT    " )                                  07900912
41290   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07910912
     1         " - ON H FORMAT     " )                                  07920912
41292   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07930912
     1         " - ON TR, TLC, T FORMAT" )                              07940912
41294   FORMAT(" ","TEST ",I3,"  FAIL",34X,"RECORD",I2,                 07950912
     1         " - ON IN.N FORMAT  " )                                  07960912
C*****                                                                  07970912
C*****  END OF TEST SEGMENT 412                                         07980912
C*****                                                                  07990912
33610   CONTINUE                                                        08000912
CBB** ********************** BBCSUM0  **********************************08010912
C**** WRITE OUT TEST SUMMARY                                            08020912
C****                                                                   08030912
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        08040912
      WRITE (I02, 90004)                                                08050912
      WRITE (I02, 90014)                                                08060912
      WRITE (I02, 90004)                                                08070912
      WRITE (I02, 90020) IVPASS                                         08080912
      WRITE (I02, 90022) IVFAIL                                         08090912
      WRITE (I02, 90024) IVDELE                                         08100912
      WRITE (I02, 90026) IVINSP                                         08110912
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 08120912
CBE** ********************** BBCSUM0  **********************************08130912
CBB** ********************** BBCFOOT0 **********************************08140912
C**** WRITE OUT REPORT FOOTINGS                                         08150912
C****                                                                   08160912
      WRITE (I02,90016) ZPROG, ZPROG                                    08170912
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     08180912
      WRITE (I02,90019)                                                 08190912
CBE** ********************** BBCFOOT0 **********************************08200912
CBB** ********************** BBCFMT0A **********************************08210912
C**** FORMATS FOR TEST DETAIL LINES                                     08220912
C****                                                                   08230912
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           08240912
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           08250912
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           08260912
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           08270912
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           08280912
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    08290912
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08300912
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              08310912
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08320912
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  08330912
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         08340912
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         08350912
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         08360912
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         08370912
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      08380912
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      08390912
80050 FORMAT (" ",48X,A31)                                              08400912
CBE** ********************** BBCFMT0A **********************************08410912
CBB** ********************** BBCFMAT1 **********************************08420912
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     08430912
C****                                                                   08440912
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08450912
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            08460912
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     08470912
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     08480912
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    08490912
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    08500912
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    08510912
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    08520912
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           08530912
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  08540912
     2"(",F12.5,", ",F12.5,")")                                         08550912
CBE** ********************** BBCFMAT1 **********************************08560912
CBB** ********************** BBCFMT0B **********************************08570912
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                08580912
C****                                                                   08590912
90002 FORMAT ("1")                                                      08600912
90004 FORMAT (" ")                                                      08610912
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08620912
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            08630912
90008 FORMAT (" ",21X,A13,A17)                                          08640912
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       08650912
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    08660912
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     08670912
     1       7X,"REMARKS",24X)                                          08680912
90014 FORMAT (" ","----------------------------------------------" ,    08690912
     1        "---------------------------------" )                     08700912
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               08710912
C****                                                                   08720912
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             08730912
C****                                                                   08740912
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          08750912
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        08760912
     1        A13)                                                      08770912
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 08780912
C****                                                                   08790912
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 08800912
C****                                                                   08810912
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              08820912
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              08830912
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             08840912
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  08850912
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  08860912
CBE** ********************** BBCFMT0B **********************************08870912
        STOP                                                            08880912
        END                                                             08890912

C********************************************************************** 00010913
C*****  FORTRAN 77                                                      00020913
C*****   FM913                                                          00030913
C*****    SN913                 FAQ - (807)                             00040913
C*****  THIS SUBROUTINE IS CALLED BY PROGRAM FM912                      00050913
C********************************************************************** 00060913
        SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D,            00070913
     1                 A20W1K, B20W1K)                                  00080913
C*****                                                                  00090913
C*****  SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES      00100913
C*****  TO ARRAYS THRU THE DUMMY ARGUMENT LIST                          00110913
C*****                                                                  00120913
        REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5)                            00130913
        LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5)                         00140913
        DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5)                00150913
        CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5)            00160913
        DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/                             00170913
        DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/                           00180913
        DATA A20T1K / 'AAAALKJHGFASERTYUIOP',  'KDJFLKJEOITMNV E CJF',  00190913
     1           'CDFEJHFKLM CNB FHGDC',  'LKJHNHBJMVK,FIJ NVHD',       00200913
     2           'JHGFKDJJSLDKFJDKJFSL'/                                00210913
        DATA B20T1K / 'AAAALSDEFCASERTYUIOP',  'KDDFFEJEOITMNV E CJF',  00220913
     1           'CDFEJHFKLM     DHGDC',  'L...NHBJMVK,FIJ NVHD',       00230913
     2           'LKJHDNMVHNEUYHBDGHCJ'/                                00240913
        DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./            00250913
        DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./            00260913
        DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/            00270913
        DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/          00280913
C*****                                                                  00290913
C*****                                                                  00300913
C*****                                                                  00310913
        DO 1  IVI = 1, 5                                                00320913
        FW1S(IVI) = FT1S(IVI)                                           00330913
        GW1S(IVI) = GT1S(IVI)                                           00340913
        CW1B(IVI) = CT1B(IVI)                                           00350913
        DW1B(IVI) = DT1B(IVI)                                           00360913
        DW1D(IVI) = DT1D(IVI)                                           00370913
        BW1D(IVI) = BT1D(IVI)                                           00380913
        A20W1K(IVI) = A20T1K(IVI)                                       00390913
        B20W1K(IVI) = B20T1K(IVI)                                       00400913
1       CONTINUE                                                        00410913
C*****                                                                  00420913
C*****                                                                  00430913
C*****                                                                  00440913
        RETURN                                                          00450913
        END                                                             00460913