      PROGRAM FM910

C***********************************************************************00010910
C*****   FM910                                                          00020910
C*****                       DIRAF2 - (411)                             00030910
C*****   THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911              00040910
C***********************************************************************00050910
C*****  TESTING OF DIRECT ACCESS FILES                         ANS REF  00060910
C*****          UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT     12.5    00070910
C*****          ACCESS TO THE SAME FILE                                 00080910
C*****          NAMED FILE AND SCRATCH FILE                             00090910
C*****                                                                  00100910
C*****          USES SUBROUTINE SN911                                   00110910
C*****                                                                  00120910
CBB** ********************** BBCCOMNT **********************************00130910
C****                                                                   00140910
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00150910
C****                          VERSION 2.1                              00160910
C****                                                                   00170910
C****                                                                   00180910
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00190910
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00200910
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00210910
C****                      BUILDING 225  RM A266                        00220910
C****                     GAITHERSBURG, MD  20899                       00230910
C****                                                                   00240910
C****                                                                   00250910
C****                                                                   00260910
CBE** ********************** BBCCOMNT **********************************00270910
C*****                                                                  00280910
C*****  S P E C I F I C A T I O N S  SEGMENT 910                        00290910
        DIMENSION L1I(10), N1I(15), F1S(10), H1S(15)                    00300910
        CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15)                00310910
        LOGICAL AVB, BVB, C1B(10), E1B(15)                              00320910
        DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15)                     00330910
        COMPLEX AVC, BVC, C1C(10), D1C(15)                              00340910
C*****                                                                  00350910
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.   00360910
CX20   REPLACED BY FEXEC X-20  CONTROL CARD.  X-20  IS FOR REPLACING    00370910
        CHARACTER*15 CDIR                                               00380910
C      THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100     00390910
C      (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR.          00400910
CBB** ********************** BBCINITA **********************************00410910
C**** SPECIFICATION STATEMENTS                                          00420910
C****                                                                   00430910
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00440910
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00450910
CBE** ********************** BBCINITA **********************************00460910
CBB** ********************** BBCINITB **********************************00470910
C**** INITIALIZE SECTION                                                00480910
      DATA  ZVERS,                  ZVERSD,             ZDATE           00490910
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00500910
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00510910
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00520910
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00530910
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00540910
      DATA   REMRKS /'                               '/                 00550910
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00560910
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00570910
C****                                                                   00580910
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00590910
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00600910
CZ03  ZPROG  = 'PROGRAM NAME'                                           00610910
CZ04  ZDATE  = 'DATE OF TEST'                                           00620910
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00630910
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00640910
CZ07  ZNAME  = 'NAME OF USER'                                           00650910
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00660910
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00670910
C                                                                       00680910
      IVPASS = 0                                                        00690910
      IVFAIL = 0                                                        00700910
      IVDELE = 0                                                        00710910
      IVINSP = 0                                                        00720910
      IVTOTL = 0                                                        00730910
      IVTOTN = 0                                                        00740910
      ICZERO = 0                                                        00750910
C                                                                       00760910
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00770910
      I01 = 05                                                          00780910
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00790910
      I02 = 06                                                          00800910
C                                                                       00810910
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00820910
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00830910
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00840910
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00850910
C                                                                       00860910
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00870910
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00880910
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00890910
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00900910
C                                                                       00910910
CBE** ********************** BBCINITB **********************************00920910
C*****                                                                  00930910
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF THE                00940910
C*****    UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED.     00950910
C*****                                                                  00960910
C     I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE.      00970910
      I10 = 786                                                         00980910
CX100   REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER).   00990910
C     SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24.               01000910
C*****                                                                  01010910
C     I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE.    01020910
      I11 = 785                                                         01030910
CX110   REPLACED BY FEXEC X-110 CONTROL CARD (DIR. FILE UNIT NUMBER).   01040910
C     SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25.               01050910
C*****                                                                  01060910
C*****  THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME             01070910
C*****  GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,               01080910
C*****  UNFORMATTED FILE.                                               01090910
C*****                                                                  01100910
C     CDIR CONTAINS THE FILE NAME FOR UNIT I10.                         01110910
      CDIR = '     DIRFILE910'                                          01120910
C                                                                       01130910
CX201   REPLACED BY FEXEC X-201 CONTROL CARD.  CX201 IS FOR SYSTEMS     01140910
C     REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH    01150910
C     X-100 THAN THE DEFAULT CDIR = '        DIRFILE'.                  01160910
C*****                          FILE NUMBER AND NAME ASSIGNMENT         01170910
      NUVI = I02                                                        01180910
      IMVI = I10                                                        01190910
      KMVI = I11                                                        01200910
      IVTOTL = 6                                                        01210910
      ZPROG = 'FM910'                                                   01220910
CBB** ********************** BBCHED0A **********************************01230910
C****                                                                   01240910
C**** WRITE REPORT TITLE                                                01250910
C****                                                                   01260910
      WRITE (I02, 90002)                                                01270910
      WRITE (I02, 90006)                                                01280910
      WRITE (I02, 90007)                                                01290910
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01300910
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01310910
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01320910
CBE** ********************** BBCHED0A **********************************01330910
C*****                                                                  01340910
C*****    HEADER FOR SEGMENT 910                                        01350910
        WRITE(NUVI,41100)                                               01360910
41100   FORMAT(" ",/" DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE" // 01370910
     1          " WITH OPTION TO OPEN AS A SEQUENTIAL FILE" //          01380910
     2          " ANS REF. - 12.5" )                                    01390910
CBB** ********************** BBCHED0B **********************************01400910
C**** WRITE DETAIL REPORT HEADERS                                       01410910
C****                                                                   01420910
      WRITE (I02,90004)                                                 01430910
      WRITE (I02,90004)                                                 01440910
      WRITE (I02,90013)                                                 01450910
      WRITE (I02,90014)                                                 01460910
      WRITE (I02,90015) IVTOTL                                          01470910
CBE** ********************** BBCHED0B **********************************01480910
C*****                                  INITIALIZE DATA                 01490910
        CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K)   01500910
        MMVI = 0                                                        01510910
C*****                                                                  01520910
        OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132,            01530910
     1           STATUS='NEW')                                          01540910
C*****                          WRITE DIRECT FILE IN SEQUENTIAL ORDER   01550910
        DO 41101 IVI = 1,10                                             01560910
        AVS = F1S (IVI)                                                 01570910
        A4VK = A41K (IVI)                                               01580910
        AVB = C1B (IVI)                                                 01590910
        AVD = D1D (IVI)                                                 01600910
        AVC = C1C (IVI)                                                 01610910
        WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC        01620910
41101   CONTINUE                                                        01630910
C*****                        CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL 01640910
        INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK)                              01650910
        CLOSE(UNIT=IMVI)                                                01660910
        IF(D4VK .EQ. 'YES ') GOTO 41103                                 01670910
        WRITE(NUVI,41102)                                               01680910
41102   FORMAT(" ",48X,"TESTS 2 THRU 6 ARE EXPECTED TO " /              01690910
     1         " ",48X,"EXECUTE                        " /              01700910
     2         " ",48X,"TEST 1 IS OPTIONAL AND IS NOT  " /              01710910
     3         " ",48X,"EXECUTED IF DIRECT ACCESS      " /              01720910
     4         " ",48X,"FILE CANNOT BE REOPENED AS     " /              01730910
     5         " ",48X,"A SEQUENTIAL FILE              " )              01740910
        GOTO 41119                                                      01750910
CT001*  TEST 1                          READ IT SEQUENTIALY             01760910
41103      IVTNUM = 1                                                   01770910
           IVCOMP = 0                                                   01780910
        OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD',   01790910
     1      FORM='UNFORMATTED')                                         01800910
        REWIND(UNIT=IMVI)                                               01810910
        DO 41104 IVI = 1, 10                                            01820910
        READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC                   01830910
        IF (IVI .NE. KVI) GOTO 20010                                    01840910
        IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010        01850910
        IF (B4VK .NE. A41K(IVI)) GOTO 20010                             01860910
        IF ((BVB .AND. .NOT. C1B(IVI)) .OR.                             01870910
     1      (.NOT. BVB .AND. C1B(IVI))) GOTO 20010                      01880910
        IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010        01890910
        IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT.        01900910
     1    REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI)))        01910910
     2    .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010            01920910
           GO TO 41104                                                  01930910
20010      IVCOMP = IVCOMP + 1                                          01940910
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       01950910
           WRITE (NUVI, 70010) IVTNUM, IVI                              01960910
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI,      01970910
     1                         F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 01980910
     1                         C1C(IVI)                                 01990910
70010      FORMAT (" ",2X,I3,4X," FAIL ON REC " ,I2)                    02000910
70020      FORMAT (" ",16X,"COMPUTED: " ,I2,1X,F5.2,1X,A4,1X,L1,1X,     02010910
     1                                  D10.3,1X,"(",F6.3,", ",F6.3,")"/02020910
     1             " ",16X,"CORRECT:  " ,I2,1X,F5.2,1X,A4,1X,L1,1X,     02030910
     1                                  D10.3,1X,"(",F6.3,", ",F6.3,")")02040910
41104   CONTINUE                                                        02050910
           IF (IVCOMP - 0) 0011, 10010, 0011                            02060910
10010      IVPASS = IVPASS + 1                                          02070910
           WRITE (NUVI, 80002) IVTNUM                                   02080910
 0011      CONTINUE                                                     02090910
C*****                                                                  02100910
41118   CLOSE(UNIT=IMVI)                                                02110910
CT002*  TEST 2                             REOPEN AS DIRECT FILE,       02120910
C*****                                  AND READ IN SEQUENTIAL ORDER    02130910
41119      IVTNUM = 2                                                   02140910
           IVCOMP = 0                                                   02150910
C*****                                                                  02160910
        OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD',       02170910
     1       RECL=132)                                                  02180910
        DO 41120 IVI = 1, 10                                            02190910
        READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC        02200910
        IF (IVI .NE. KVI) GOTO 20020                                    02210910
        IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020        02220910
        IF (B4VK .NE. A41K(IVI)) GOTO 20020                             02230910
        IF ((BVB .AND. .NOT. C1B(IVI)) .OR.                             02240910
     1      (.NOT. BVB .AND. C1B(IVI))) GOTO 20020                      02250910
        IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020        02260910
        IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT.        02270910
     1    REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI)))        02280910
     2    .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020            02290910
           GO TO 41120                                                  02300910
20020      IVCOMP = IVCOMP + 1                                          02310910
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       02320910
           WRITE (NUVI, 70010) IVTNUM, IVI                              02330910
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI,      02340910
     1                         F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 02350910
     1                         C1C(IVI)                                 02360910
41120   CONTINUE                                                        02370910
           IF (IVCOMP - 0) 0021, 10020, 0021                            02380910
10020      IVPASS = IVPASS + 1                                          02390910
           WRITE (NUVI, 80002) IVTNUM                                   02400910
 0021      CONTINUE                                                     02410910
C*****                                                                  02420910
41121   CLOSE(UNIT=IMVI)                                                02430910
CT003*  TEST 3                                  READ IT AS DIRECT       02440910
C*****                                      FILE IN NONSEQUENTIAL ORDER 02450910
           IVTNUM = 3                                                   02460910
           IVCOMP = 0                                                   02470910
C*****                                                                  02480910
        OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD',       02490910
     1       RECL=132)                                                  02500910
        DO 41122 IVI = 1, 10                                            02510910
        JVI = L1I(IVI)                                                  02520910
        READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC        02530910
        IF (KVI .NE. JVI) GOTO 20030                                    02540910
        IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030        02550910
        IF (B4VK .NE. A41K(JVI)) GOTO 20030                             02560910
        IF ((BVB .AND. .NOT. C1B(JVI)) .OR.                             02570910
     1      (.NOT. BVB .AND. C1B(JVI))) GOTO 20030                      02580910
        IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030        02590910
        IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT.        02600910
     1    REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI)))        02610910
     2    .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030            02620910
           GO TO 41122                                                  02630910
20030      IVCOMP = IVCOMP + 1                                          02640910
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       02650910
           WRITE (NUVI, 70010) IVTNUM, JVI                              02660910
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI,      02670910
     1                         F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI), 02680910
     1                         C1C(JVI)                                 02690910
41122   CONTINUE                                                        02700910
           IF (IVCOMP - 0) 0031, 10030, 0031                            02710910
10030      IVPASS = IVPASS + 1                                          02720910
           WRITE (NUVI, 80002) IVTNUM                                   02730910
 0031      CONTINUE                                                     02740910
C*****                                                                  02750910
41123   OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH')     02760910
C*****                                                                  02770910
CT004*  TEST 4                  CHECK RECL AND NEXTREC ON SCRATCH FILE  02780910
           IVTNUM = 4                                                   02790910
        INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI)                         02800910
        IF (IVI .NE. 80) GOTO 20040                                     02810910
        IF (KVI .NE. 1) GOTO 20040                                      02820910
10040      IVPASS = IVPASS + 1                                          02830910
           WRITE (NUVI, 80002) IVTNUM                                   02840910
           GO TO 0041                                                   02850910
20040      IVFAIL = IVFAIL + 1                                          02860910
           WRITE (NUVI, 70030) IVTNUM                                   02870910
           WRITE (NUVI, 70040) IVI, KVI                                 02880910
70030      FORMAT (" ",2X,I3,4X," FAIL ON RECL AND/OR NEXTREC" )        02890910
70040      FORMAT (" ",16X,"COMPUTED:  RECL=" ,I4,", NEXTREC=" ,I4/     02900910
     1             " ",16X,"CORRECT:   RECL=  80, NEXTREC=   1" )       02910910
 0041      CONTINUE                                                     02920910
C*****                                                                  02930910
C*****                                 WRITE DIRECT ACCESS              02940910
C*****                          SCRATCH FILE IN NONSEQUENTIAL ORDER     02950910
        DO 41126 IVI = 1,15                                             02960910
        JVI = N1I (IVI)                                                 02970910
        AVS = H1S (JVI)                                                 02980910
        A4VK = C41K (JVI)                                               02990910
        AVB = E1B (JVI)                                                 03000910
        AVC = D1C(JVI)                                                  03010910
        AVD = B1D(JVI)                                                  03020910
        WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS        03030910
41126   CONTINUE                                                        03040910
CT005*  TEST 5                  CHECK DIRECT ACCESS SCRATCH FILE        03050910
C*****                        BY READING IT IN NONSEQUENTIAL ORDER      03060910
           IVTNUM = 5                                                   03070910
           IVCOMP = 0                                                   03080910
        MMVI = -1                                                       03090910
        DO 41127 IVI = 15,1,-1                                          03100910
        JVI = N1I (IVI)                                                 03110910
        READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS        03120910
        IF (KVI .NE. JVI) GOTO 20050                                    03130910
        IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050        03140910
        IF (B4VK .NE. C41K(JVI)) GOTO 20050                             03150910
        IF ((BVB .AND. .NOT. E1B(JVI)) .OR.                             03160910
     1      (.NOT. BVB .AND. E1B(JVI))) GOTO 20050                      03170910
        IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050        03180910
        IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT.        03190910
     1    REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI)))        03200910
     2    .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050            03210910
           GO TO 41127                                                  03220910
20050      IVCOMP = IVCOMP + 1                                          03230910
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       03240910
           WRITE (NUVI, 70010) IVTNUM, JVI                              03250910
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI,      03260910
     1                         H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI), 03270910
     1                         D1C(JVI)                                 03280910
41127   CONTINUE                                                        03290910
           IF (IVCOMP - 0) 0051, 10050, 0051                            03300910
10050      IVPASS = IVPASS + 1                                          03310910
           WRITE (NUVI, 80002) IVTNUM                                   03320910
 0051      CONTINUE                                                     03330910
C*****                                                                  03340910
CT006*  TEST 6                     CHECK RECL AND NEXTREC AFTER READING 03350910
           IVTNUM = 6                                                   03360910
        INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI)                         03370910
        IF (IVI .NE. 80) GOTO 20060                                     03380910
        IF (KVI .NE. 6) GOTO 20060                                      03390910
10060      IVPASS = IVPASS + 1                                          03400910
           WRITE (NUVI, 80002) IVTNUM                                   03410910
           GO TO 0061                                                   03420910
20060      IVFAIL = IVFAIL + 1                                          03430910
           WRITE (NUVI, 70050) IVTNUM                                   03440910
           WRITE (NUVI, 70060) IVI, KVI                                 03450910
70050      FORMAT (" ",2X,I3,4X," FAIL ON RECL AND/OR NEXTREC" )        03460910
70060      FORMAT (" ",16X,"COMPUTED:  RECL=" ,I4,", NEXTREC=" ,I4/     03470910
     1             " ",16X,"CORRECT:   RECL=  80, NEXTREC=   6" )       03480910
 0061      CONTINUE                                                     03490910
C*****                                                                  03500910
           CLOSE (UNIT=IMVI,STATUS='DELETE')                            03510910
C*****                                                                  03520910
C****                                                                   04070910
CBB** ********************** BBCSUM0  **********************************04080910
C**** WRITE OUT TEST SUMMARY                                            04090910
C****                                                                   04100910
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        04110910
      WRITE (I02, 90004)                                                04120910
      WRITE (I02, 90014)                                                04130910
      WRITE (I02, 90004)                                                04140910
      WRITE (I02, 90020) IVPASS                                         04150910
      WRITE (I02, 90022) IVFAIL                                         04160910
      WRITE (I02, 90024) IVDELE                                         04170910
      WRITE (I02, 90026) IVINSP                                         04180910
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 04190910
CBE** ********************** BBCSUM0  **********************************04200910
CBB** ********************** BBCFOOT0 **********************************04210910
C**** WRITE OUT REPORT FOOTINGS                                         04220910
C****                                                                   04230910
      WRITE (I02,90016) ZPROG, ZPROG                                    04240910
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     04250910
      WRITE (I02,90019)                                                 04260910
CBE** ********************** BBCFOOT0 **********************************04270910
CBB** ********************** BBCFMT0A **********************************04280910
C**** FORMATS FOR TEST DETAIL LINES                                     04290910
C****                                                                   04300910
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           04310910
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           04320910
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           04330910
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           04340910
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           04350910
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    04360910
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04370910
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              04380910
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04390910
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  04400910
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         04410910
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         04420910
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         04430910
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         04440910
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      04450910
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      04460910
80050 FORMAT (" ",48X,A31)                                              04470910
CBE** ********************** BBCFMT0A **********************************04480910
CBB** ********************** BBCFMAT1 **********************************04490910
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     04500910
C****                                                                   04510910
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04520910
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            04530910
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     04540910
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     04550910
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    04560910
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    04570910
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    04580910
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    04590910
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04600910
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  04610910
     2"(",F12.5,", ",F12.5,")")                                         04620910
CBE** ********************** BBCFMAT1 **********************************04630910
CBB** ********************** BBCFMT0B **********************************04640910
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                04650910
C****                                                                   04660910
90002 FORMAT ("1")                                                      04670910
90004 FORMAT (" ")                                                      04680910
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04690910
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            04700910
90008 FORMAT (" ",21X,A13,A17)                                          04710910
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       04720910
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    04730910
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     04740910
     1       7X,"REMARKS",24X)                                          04750910
90014 FORMAT (" ","----------------------------------------------" ,    04760910
     1        "---------------------------------" )                     04770910
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               04780910
C****                                                                   04790910
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             04800910
C****                                                                   04810910
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          04820910
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        04830910
     1        A13)                                                      04840910
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 04850910
C****                                                                   04860910
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 04870910
C****                                                                   04880910
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              04890910
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              04900910
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             04910910
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  04920910
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  04930910
CBE** ********************** BBCFMT0B **********************************04940910
C*****                                                                  04950910
C*****    END OF TEST SEGMENT 910                                       04960910
      STOP                                                              04970910
      END                                                               04980910

C********************************************************************** 00010911
C*****   FM911                                                          00020911
C*****                                                                  00030911
C*****    SN911                 EAQ - (806)                             00040911
C*****  THIS SUBROUTINE IS CALLED BY FM910                              00050911
C********************************************************************** 00060911
        SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D,      00070911
     1      BW1D,CW1C, DW1C, A4W1K, C4W1K)                              00080911
C*****                                                                  00090911
C*****  SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES      00100911
C*****  TO ARRAYS THRU THE DUMMY ARGUMENT LIST                          00110911
C*****                                                                  00120911
        DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15)                   00130911
        REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15)                        00140911
        LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15)                     00150911
        DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15)            00160911
        COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15)                     00170911
        CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15)             00180911
C*****                                                                  00190911
        DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/                       00200911
        DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/   00210911
        DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/   00220911
        DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1,   00230911
     1           3.4, 5.60, 34.9, 3.48, 23.8/                           00240911
        DATA A4T1K / 'AAAA',  'BBBB',  'CCCC',  'DDDD',  'EDFG',  'JLKD'00250911
     1             , 'CDFE',  'LKJH',  'JHGF',  'LLLL'/                 00260911
        DATA C4T1K / 'HDFK',  'LKJH',  'ASDF',  'LKJH',  'XMNC',  'ALXM'00270911
     1             , 'IEOW',  'IERU',  'DJNC',  'DJAL',  'KDFJ',  'ABCD'00280911
     2             , 'ASDF',  'GHJK',  'QWER'/                          00290911
        DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE.,    00300911
     1            .FALSE., .TRUE., .TRUE., .FALSE./                     00310911
        DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00320911
     1            .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE.,      00330911
     2            .FALSE., .TRUE., .FALSE./                             00340911
        DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1,    00350911
     1            2.34D1, 398.0D0, 3.49D-1, 0.99D1/                     00360911
        DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1,     00370911
     1            34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3,      00380911
     2            389.098D1, 483.98D0, 3456.0D-4/                       00390911
        DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9),   00400911
     1            (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2),    00410911
     2            (2.56, 2.1), (3.4, 4.5)/                              00420911
        DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2),   00430911
     1            (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9),    00440911
     2            (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9),    00450911
     3            (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/               00460911
                                                                        00470911
C*****                                                                  00480911
        DO 1  IVI = 1, 10                                               00490911
        LW1I(IVI) = LT1I(IVI)                                           00500911
        FW1S(IVI) = FT1S(IVI)                                           00510911
        CW1B(IVI) = CT1B(IVI)                                           00520911
        DW1D(IVI) = DT1D(IVI)                                           00530911
        CW1C(IVI) = CT1C(IVI)                                           00540911
        A4W1K(IVI) = A4T1K(IVI)                                         00550911
1       CONTINUE                                                        00560911
C*****                                                                  00570911
        DO 2 IVI = 1, 15                                                00580911
        NW1I(IVI) = NT1I(IVI)                                           00590911
        HW1S(IVI) = HT1S(IVI)                                           00600911
        EW1B(IVI) = ET1B(IVI)                                           00610911
        BW1D(IVI) = BT1D(IVI)                                           00620911
        DW1C(IVI) = DT1C(IVI)                                           00630911
        C4W1K(IVI) = C4T1K(IVI)                                         00640911
2       CONTINUE                                                        00650911
C*****                                                                  00660911
        RETURN                                                          00670911
        END                                                             00680911