      PROGRAM FM917

C***********************************************************************00010917
C*****  FORTRAN 77                                                      00020917
C*****   FM917                                                          00030917
C*****                       INQU4 - (433)                              00040917
C*****                                                                  00050917
C***********************************************************************00060917
C*****  GENERAL PURPOSE                                         ANS REF 00070917
C*****    TEST INQUIRE BY UNIT ON DIRECT, UNFORMATTED FILE      12.10.3 00080917
C*****                                                                  00090917
C*****    THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A                 00100917
C*****    UNIT THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS         00110917
C*****    (ANS REF. 12.2.4.2 AND 12.9.5.1)                              00120917
C*****    THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS             00130917
C*****    A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.       00140917
C*****    THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY     00150917
C*****    BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO       00160917
C*****    THE FILE, AND AFTER READING FROM THE FILE.                    00170917
C*****                                                                  00180917
C*****  NOTE:                                                           00190917
C*****    AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND           00200917
C*****    WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO     00210917
C*****    DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT      00220917
C*****    NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).00230917
C*****    THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST        00240917
C*****    DIRECT ACCESS FILES - SEGMENT DIRAF3 (412).                   00250917
C***********************************************************************00260917
C*****                                                                  00270917
CBB** ********************** BBCCOMNT **********************************00280917
C****                                                                   00290917
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00300917
C****                          VERSION 2.1                              00310917
C****                                                                   00320917
C****                                                                   00330917
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00340917
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00350917
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00360917
C****                      BUILDING 225  RM A266                        00370917
C****                     GAITHERSBURG, MD  20899                       00380917
C****                                                                   00390917
C****                                                                   00400917
C****                                                                   00410917
CBE** ********************** BBCCOMNT **********************************00420917
C*****                                                                  00430917
        LOGICAL AVB, BVB                                                00440917
        CHARACTER*10  B10VK, D10VK, E11VK*11, G10VK                     00450917
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.   00460917
CBB** ********************** BBCINITA **********************************00470917
C**** SPECIFICATION STATEMENTS                                          00480917
C****                                                                   00490917
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00500917
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00510917
CBE** ********************** BBCINITA **********************************00520917
CBB** ********************** BBCINITB **********************************00530917
C**** INITIALIZE SECTION                                                00540917
      DATA  ZVERS,                  ZVERSD,             ZDATE           00550917
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00560917
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00570917
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00580917
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00590917
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00600917
      DATA   REMRKS /'                               '/                 00610917
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00620917
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00630917
C****                                                                   00640917
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00650917
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00660917
CZ03  ZPROG  = 'PROGRAM NAME'                                           00670917
CZ04  ZDATE  = 'DATE OF TEST'                                           00680917
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00690917
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00700917
CZ07  ZNAME  = 'NAME OF USER'                                           00710917
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00720917
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00730917
C                                                                       00740917
      IVPASS = 0                                                        00750917
      IVFAIL = 0                                                        00760917
      IVDELE = 0                                                        00770917
      IVINSP = 0                                                        00780917
      IVTOTL = 0                                                        00790917
      IVTOTN = 0                                                        00800917
      ICZERO = 0                                                        00810917
C                                                                       00820917
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00830917
      I01 = 05                                                          00840917
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00850917
      I02 = 06                                                          00860917
C                                                                       00870917
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00880917
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00890917
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00900917
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00910917
C                                                                       00920917
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00930917
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00940917
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00950917
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00960917
C                                                                       00970917
CBE** ********************** BBCINITB **********************************00980917
C*****                                                                  00990917
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF                    01000917
C*****    THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A            01010917
C*****    DIRECT, UNFORMATTED FILE.                                     01020917
C*****                                                                  01030917
C     I12 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE.      01040917
      I12 = 931                                                         01050917
CX120   REPLACED BY FEXEC X-120 CONTROL CARD (DIR. FILE UNIT NUMBER).   01060917
C     SPECIFYING I12 = NN OVERRIDES THE DEFAULT I12 = 14.               01070917
C*****                                                                  01080917
C*****  THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME             01090917
C*****  GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,               01100917
C*****  UNFORMATTED FILE.                                               01110917
C*****                                                                  01120917
C*****                                                                  01130917
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS              01140917
C*****    NOT A VALID RECORD LENGTH.                                    01150917
      MVI = 40                                                          01160917
C*****                                                                  01170917
      NUVI = I02                                                        01180917
      IOVI = I12                                                        01190917
      ZPROG = 'FM917'                                                   01200917
      IVTOTL = 3                                                        01210917
CBB** ********************** BBCHED0A **********************************01220917
C****                                                                   01230917
C**** WRITE REPORT TITLE                                                01240917
C****                                                                   01250917
      WRITE (I02, 90002)                                                01260917
      WRITE (I02, 90006)                                                01270917
      WRITE (I02, 90007)                                                01280917
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01290917
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01300917
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01310917
CBE** ********************** BBCHED0A **********************************01320917
C*****                                                                  01330917
        WRITE(NUVI,43300)                                               01340917
43300   FORMAT(" ", / " INQU4 - (433) INQUIRE BY UNIT" //               01350917
     1         " DIRECT ACCESS UNFORMATTED FILE" //                     01360917
     2         " ANS REF. - 12.10.3" )                                  01370917
CBB** ********************** BBCHED0B **********************************01380917
C**** WRITE DETAIL REPORT HEADERS                                       01390917
C****                                                                   01400917
      WRITE (I02,90004)                                                 01410917
      WRITE (I02,90004)                                                 01420917
      WRITE (I02,90013)                                                 01430917
      WRITE (I02,90014)                                                 01440917
      WRITE (I02,90015) IVTOTL                                          01450917
CBE** ********************** BBCHED0B **********************************01460917
C*****                                                                  01470917
C*****    OPEN FILE                                                     01480917
        OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='UNFORMATTED')  01490917
C*****                                                                  01500917
CT001*  TEST 1 - FIRST INQUIRE (AFTER OPEN)                             01510917
           IVTNUM = 1                                                   01520917
        INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,           01530917
     1          ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,      01540917
     2          FORM=E11VK, UNFORMATTED=G10VK, ERR=20014,IOSTAT=IVI)    01550917
C*****                                                                  01560917
        IF (IVI .NE. 0) GO TO 20010                                     01570917
        IF (.NOT. AVB) GO TO 20010                                      01580917
        IF (.NOT. BVB) GO TO 20010                                      01590917
        IF (JVI .NE. IOVI) GO TO 20010                                  01600917
        IF (B10VK .NE. 'DIRECT') GO TO 20010                            01610917
        IF (D10VK .NE. 'YES') GO TO 20010                               01620917
        IF (KVI .NE. MVI) GO TO 20010                                   01630917
        IF (LVI .NE. 1) GO TO 20010                                     01640917
        IF (E11VK .NE. 'UNFORMATTED') GO TO 20010                       01650917
        IF (G10VK .NE. 'YES' ) GO TO 20010                              01660917
           WRITE (NUVI, 80002) IVTNUM                                   01670917
           IVPASS = IVPASS + 1                                          01680917
           GO TO 0011                                                   01690917
20014      CONTINUE                                                     01700917
           WRITE (NUVI, 20015) IVTNUM                                   01710917
20015      FORMAT (" ",2X,I3,4X," FAIL",12X,                            01720917
     1     "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /)          01730917
           GO TO 20016                                                  01740917
20010      CONTINUE                                                     01750917
           WRITE (NUVI, 20011) IVTNUM                                   01760917
20011      FORMAT(" ",2X,I3,4X," FAIL",12X,                             01770917
     1     "ERROR IN AN INQUIRE SPECIFIER" /)                           01780917
20016      IVFAIL = IVFAIL + 1                                          01790917
           WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK,             01800917
     1                         KVI,LVI,E11VK,G10VK                      01810917
20012      FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1,    01820917
     1             " ,OPENED=",L1,", NUMBER=",I4,","/                   01830917
     2             " ",26X,"ACCESS=",A10,", DIRECT=",A3,", RECL=",      01840917
     3             I4,","/" ",26X,"NEXTREC=",I4,", FORM=",              01850917
     4             A11,","/" ",26X,"UNFORMATTED=" ,A3)                  01860917
           WRITE (NUVI, 20013) IOVI, MVI                                01870917
20013      FORMAT (" ",16X,"CORRECT:  " ,"IOSTAT=0, EXIST=T, " ,        01880917
     1             "OPENED=T, NUMBER=" ,I4,","/                         01890917
     2             " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" ,         01900917
     3             I4,","/" ",26X,"NEXTREC=1, FORM=UNFORMATTED," /      01910917
     4             " ",26X,"UNFORMATTED=YES" )                          01920917
 0011   CONTINUE                                                        01930917
C*****                                                                  01940917
C*****    WRITE A RECORD TO FILE                                        01950917
        WRITE(IOVI, REC=1) JVI                                          01960917
C*****                                                                  01970917
CT002*  TEST 2 - SECOND INQUIRE (AFTER WRITE)                           01980917
           IVTNUM = 2                                                   01990917
C*****    THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC         02000917
C*****    AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED           02010917
        INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,         02020917
     1          ERR=20024, IOSTAT=IVI)                                  02030917
C*****                                                                  02040917
        IF (IVI .NE. 0) GO TO 20020                                     02050917
        IF (D10VK .NE. 'YES') GO TO 20020                               02060917
        IF (KVI .NE. MVI) GO TO 20020                                   02070917
        IF (LVI .NE. 2) GO TO 20020                                     02080917
           WRITE (NUVI, 80002) IVTNUM                                   02090917
           IVPASS = IVPASS + 1                                          02100917
           GO TO 0021                                                   02110917
20024      CONTINUE                                                     02120917
           WRITE (NUVI, 20025) IVTNUM                                   02130917
20025      FORMAT (" ",2X,I3,4X," FAIL",12X,                            02140917
     1     "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /)          02150917
           GO TO 20026                                                  02160917
20020      CONTINUE                                                     02170917
           WRITE (NUVI, 20021) IVTNUM                                   02180917
20021      FORMAT(" ",2X,I3,4X," FAIL",12X,                             02190917
     1     "ERROR IN AN INQUIRE SPECIFIER" /)                           02200917
20026      IVFAIL = IVFAIL + 1                                          02210917
           WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI                        02220917
20022      FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3,   02230917
     1             " ,RECL=",I4,", NEXTREC=" ,I4)                       02240917
           WRITE (NUVI, 20023) MVI                                      02250917
20023      FORMAT (" ",16X,"CORRECT:  " ,"IOSTAT=0, DIRECT=YES, " ,     02260917
     1             "RECL=",I4,", NEXTREC=   2" )                        02270917
 0021   CONTINUE                                                        02280917
C*****                                                                  02290917
C*****    READ A RECORD FROM FILE                                       02300917
C*****                                                                  02310917
        READ(IOVI, REC=1) JVI                                           02320917
C*****                                                                  02330917
CT003*  TEST 3 -  THIRD INQUIRE (AFTER READ)                            02340917
           IVTNUM = 3                                                   02350917
C*****    THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC         02360917
C*****    AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED           02370917
        INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,         02380917
     1          ERR=20034, IOSTAT=IVI)                                  02390917
C*****                                                                  02400917
        IF (IVI .NE. 0) GO TO 20030                                     02410917
        IF (D10VK .NE. 'YES') GO TO 20030                               02420917
        IF (KVI .NE. MVI) GO TO 20030                                   02430917
        IF (LVI .NE. 2) GO TO 20030                                     02440917
           WRITE (NUVI, 80002) IVTNUM                                   02450917
           IVPASS = IVPASS + 1                                          02460917
           GO TO 0031                                                   02470917
20034      CONTINUE                                                     02480917
           WRITE (NUVI, 20035) IVTNUM                                   02490917
20035      FORMAT (" ",2X,I3,4X," FAIL",12X,                            02500917
     1     "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /)          02510917
           GO TO 20036                                                  02520917
20030      CONTINUE                                                     02530917
           WRITE (NUVI, 20031) IVTNUM                                   02540917
20031      FORMAT(" ",2X,I3,4X," FAIL",12X,                             02550917
     1     "ERROR IN AN INQUIRE SPECIFIER" /)                           02560917
20036      IVFAIL = IVFAIL + 1                                          02570917
           WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI                        02580917
20032      FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3,   02590917
     1             " ,RECL=",I4,", NEXTREC=" ,I4)                       02600917
           WRITE (NUVI, 20023) MVI                                      02610917
20033      FORMAT (" ",16X,"CORRECT:  " ,"IOSTAT=0, DIRECT=YES, " ,     02620917
     1             "RECL=",I4,", NEXTREC=   2" )                        02630917
 0031   CONTINUE                                                        02640917
C*****                                                                  02650917
        CLOSE(UNIT=IOVI, STATUS='DELETE')                               02660917
C*****                                                                  02670917
CBB** ********************** BBCSUM0  **********************************02680917
C**** WRITE OUT TEST SUMMARY                                            02690917
C****                                                                   02700917
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02710917
      WRITE (I02, 90004)                                                02720917
      WRITE (I02, 90014)                                                02730917
      WRITE (I02, 90004)                                                02740917
      WRITE (I02, 90020) IVPASS                                         02750917
      WRITE (I02, 90022) IVFAIL                                         02760917
      WRITE (I02, 90024) IVDELE                                         02770917
      WRITE (I02, 90026) IVINSP                                         02780917
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02790917
CBE** ********************** BBCSUM0  **********************************02800917
CBB** ********************** BBCFOOT0 **********************************02810917
C**** WRITE OUT REPORT FOOTINGS                                         02820917
C****                                                                   02830917
      WRITE (I02,90016) ZPROG, ZPROG                                    02840917
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02850917
      WRITE (I02,90019)                                                 02860917
CBE** ********************** BBCFOOT0 **********************************02870917
CBB** ********************** BBCFMT0A **********************************02880917
C**** FORMATS FOR TEST DETAIL LINES                                     02890917
C****                                                                   02900917
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02910917
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02920917
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02930917
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02940917
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02950917
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02960917
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02970917
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02980917
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02990917
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  03000917
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03010917
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03020917
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03030917
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03040917
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03050917
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03060917
80050 FORMAT (" ",48X,A31)                                              03070917
CBE** ********************** BBCFMT0A **********************************03080917
CBB** ********************** BBCFMT0B **********************************03090917
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03100917
C****                                                                   03110917
90002 FORMAT ("1")                                                      03120917
90004 FORMAT (" ")                                                      03130917
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03140917
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03150917
90008 FORMAT (" ",21X,A13,A17)                                          03160917
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03170917
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03180917
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03190917
     1       7X,"REMARKS",24X)                                          03200917
90014 FORMAT (" ","----------------------------------------------" ,    03210917
     1        "---------------------------------" )                     03220917
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03230917
C****                                                                   03240917
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03250917
C****                                                                   03260917
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03270917
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03280917
     1        A13)                                                      03290917
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03300917
C****                                                                   03310917
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03320917
C****                                                                   03330917
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03340917
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03350917
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03360917
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03370917
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03380917
CBE** ********************** BBCFMT0B **********************************03390917
C*****                                                                  03400917
C*****    END OF TEST SEGMENT 433                                       03410917
        STOP                                                            03420917
        END                                                             03430917