FM916.f Source File


Contents

Source Code


Source Code

      PROGRAM FM916

C***********************************************************************00010916
C*****  FORTRAN 77                                                      00020916
C*****   FM916                                                          00030916
C*****                       INQU3 - (432)                              00040916
C*****                                                                  00050916
C***********************************************************************00060916
C*****  GENERAL PURPOSE                                         ANS REF 00070916
C*****    TEST INQUIRE BY UNIT ON DIRECT, FORMATTED FILE        12.10.3 00080916
C*****                                                                  00090916
C*****    THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A                 00100916
C*****    UNIT THAT IS CONNECTED FOR FORMATTED, DIRECT ACCESS           00110916
C*****    (ANS REF. 12.2.4.2 AND 12.9.5.2)                              00120916
C*****    THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS             00130916
C*****    A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.       00140916
C*****                                                                  00150916
CBB** ********************** BBCCOMNT **********************************00160916
C****                                                                   00170916
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00180916
C****                          VERSION 2.1                              00190916
C****                                                                   00200916
C****                                                                   00210916
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00220916
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00230916
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00240916
C****                      BUILDING 225  RM A266                        00250916
C****                     GAITHERSBURG, MD  20899                       00260916
C****                                                                   00270916
C****                                                                   00280916
C****                                                                   00290916
CBE** ********************** BBCCOMNT **********************************00300916
C*****                                                                  00310916
        LOGICAL AVB, BVB                                                00320916
        CHARACTER*10  B10VK, D10VK, E11VK*11, F10VK, H10VK              00330916
CBB** ********************** BBCINITA **********************************00340916
C**** SPECIFICATION STATEMENTS                                          00350916
C****                                                                   00360916
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00370916
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00380916
CBE** ********************** BBCINITA **********************************00390916
CBB** ********************** BBCINITB **********************************00400916
C**** INITIALIZE SECTION                                                00410916
      DATA  ZVERS,                  ZVERSD,             ZDATE           00420916
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00430916
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00440916
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00450916
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00460916
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00470916
      DATA   REMRKS /'                               '/                 00480916
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00490916
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00500916
C****                                                                   00510916
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00520916
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00530916
CZ03  ZPROG  = 'PROGRAM NAME'                                           00540916
CZ04  ZDATE  = 'DATE OF TEST'                                           00550916
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00560916
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00570916
CZ07  ZNAME  = 'NAME OF USER'                                           00580916
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00590916
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00600916
C                                                                       00610916
      IVPASS = 0                                                        00620916
      IVFAIL = 0                                                        00630916
      IVDELE = 0                                                        00640916
      IVINSP = 0                                                        00650916
      IVTOTL = 0                                                        00660916
      IVTOTN = 0                                                        00670916
      ICZERO = 0                                                        00680916
C                                                                       00690916
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00700916
      I01 = 05                                                          00710916
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00720916
      I02 = 06                                                          00730916
C                                                                       00740916
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750916
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00760916
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00770916
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00780916
C                                                                       00790916
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00800916
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00810916
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00820916
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00830916
C                                                                       00840916
CBE** ********************** BBCINITB **********************************00850916
C*****                                                                  00860916
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF                    00870916
C*****    THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A            00880916
C*****    DIRECT, FORMATTED FILE.                                       00890916
C*****    S C R A T C H  D I R E C T  A C C E S S  U N I T              00900916
      I14 = 14                                                          00910916
CX140 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-140               00920916
C     X-140  I14 = NN   WILL OVERRIDE I14 = 14                          00930916
C*****                                                                  00940916
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS              00950916
C*****    NOT A VALID RECORD LENGTH.                                    00960916
      MVI = 40                                                          00970916
C*****                                                                  00980916
      NUVI = I02                                                        00990916
      IOVI = I14                                                        01000916
      ZPROG = 'FM916'                                                   01010916
      IVTOTL = 1                                                        01020916
CBB** ********************** BBCHED0A **********************************01030916
C****                                                                   01040916
C**** WRITE REPORT TITLE                                                01050916
C****                                                                   01060916
      WRITE (I02, 90002)                                                01070916
      WRITE (I02, 90006)                                                01080916
      WRITE (I02, 90007)                                                01090916
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01100916
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01110916
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01120916
CBE** ********************** BBCHED0A **********************************01130916
C*****                                                                  01140916
        WRITE(NUVI,43200)                                               01150916
43200   FORMAT(" ", / " INQU3 - (432) INQUIRE BY UNIT" //               01160916
     1         " DIRECT ACCESS FORMATTED FILE" //                       01170916
     2         " ANS REF. - 12.10.3" )                                  01180916
CBB** ********************** BBCHED0B **********************************01190916
C**** WRITE DETAIL REPORT HEADERS                                       01200916
C****                                                                   01210916
      WRITE (I02,90004)                                                 01220916
      WRITE (I02,90004)                                                 01230916
      WRITE (I02,90013)                                                 01240916
      WRITE (I02,90014)                                                 01250916
      WRITE (I02,90015) IVTOTL                                          01260916
CBE** ********************** BBCHED0B **********************************01270916
C*****                                                                  01280916
C*****    OPEN FILE                                                     01290916
        OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='FORMATTED',    01300916
     1       BLANK='NULL')                                              01310916
C*****                                                                  01320916
C*****  TEST 1 -  FIRST INQUIRE (AFTER OPEN)                            01330916
           IVTNUM = 1                                                   01340916
        INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,           01350916
     1          ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,      01360916
     2          FORM=E11VK, FORMATTED=F10VK, BLANK=H10VK, ERR=20014,    01370916
     3          IOSTAT=NVI)                                             01380916
C*****                                                                  01390916
        IF (NVI .NE. 0) GO TO 20010                                     01400916
        IF (.NOT. AVB) GO TO 20010                                      01410916
        IF (.NOT. BVB) GO TO 20010                                      01420916
        IF (JVI .NE. IOVI) GO TO 20010                                  01430916
        IF (B10VK .NE. 'DIRECT') GO TO 20010                            01440916
        IF (D10VK .NE. 'YES') GO TO 20010                               01450916
        IF (KVI .NE. MVI) GO TO 20010                                   01460916
        IF (LVI .NE. 1) GO TO 20010                                     01470916
        IF (E11VK .NE. 'FORMATTED') GO TO 20010                         01480916
        IF (F10VK .NE. 'YES' ) GO TO 20010                              01490916
        IF (H10VK .NE. 'NULL') GO TO 20010                              01500916
           WRITE (NUVI, 80002) IVTNUM                                   01510916
           IVPASS = IVPASS + 1                                          01520916
           GO TO 0011                                                   01530916
20014      CONTINUE                                                     01540916
           WRITE (NUVI, 20015) IVTNUM                                   01550916
20015      FORMAT (" ",2X,I3,4X," FAIL",12X,                            01560916
     1     "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /)          01570916
           GO TO 20016                                                  01580916
20010      CONTINUE                                                     01590916
           WRITE (NUVI, 20011) IVTNUM                                   01600916
20011      FORMAT(" ",2X,I3,4X," FAIL",12X,                             01610916
     1     "ERROR IN AN INQUIRE SPECIFIER" /)                           01620916
20016      IVFAIL = IVFAIL + 1                                          01630916
           WRITE (NUVI, 20012) NVI,AVB,BVB,JVI,B10VK,D10VK,             01640916
     1                         KVI,LVI,E11VK,F10VK,H10VK                01650916
20012      FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1,    01660916
     1             " ,OPENED=",L1,", NUMBER=",I4,","/                   01670916
     2             " ",26X,"ACCESS=",A10,", DIRECT=",A3,", RECL=",      01680916
     3             I4,","/" ",26X,"NEXTREC=",I4,", FORM=",              01690916
     4             A9,","/" ",26X,"FORMATTED=" ,A3,", BLANK=",A4)       01700916
           WRITE (NUVI, 20013) IOVI,MVI                                 01710916
20013      FORMAT (" ",16X,"CORRECT:  " ,"IOSTAT=0, EXIST=T, " ,        01720916
     1             "OPENED=T, NUMBER=" ,I4,","/                         01730916
     2             " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" ,         01740916
     3             I4,","/" ",26X,"NEXTREC=1, FORM=FORMATTED," /        01750916
     4             " ",26X,"FORMATTED=YES, BLANK=NULL" )                01760916
 0011   CONTINUE                                                        01770916
C*****                                                                  01780916
        CLOSE(UNIT=IOVI, STATUS='DELETE')                               01790916
C*****                                                                  01800916
CBB** ********************** BBCSUM0  **********************************01810916
C**** WRITE OUT TEST SUMMARY                                            01820916
C****                                                                   01830916
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        01840916
      WRITE (I02, 90004)                                                01850916
      WRITE (I02, 90014)                                                01860916
      WRITE (I02, 90004)                                                01870916
      WRITE (I02, 90020) IVPASS                                         01880916
      WRITE (I02, 90022) IVFAIL                                         01890916
      WRITE (I02, 90024) IVDELE                                         01900916
      WRITE (I02, 90026) IVINSP                                         01910916
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 01920916
CBE** ********************** BBCSUM0  **********************************01930916
CBB** ********************** BBCFOOT0 **********************************01940916
C**** WRITE OUT REPORT FOOTINGS                                         01950916
C****                                                                   01960916
      WRITE (I02,90016) ZPROG, ZPROG                                    01970916
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     01980916
      WRITE (I02,90019)                                                 01990916
CBE** ********************** BBCFOOT0 **********************************02000916
CBB** ********************** BBCFMT0A **********************************02010916
C**** FORMATS FOR TEST DETAIL LINES                                     02020916
C****                                                                   02030916
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02040916
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02050916
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02060916
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02070916
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02080916
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02090916
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02100916
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02110916
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02120916
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02130916
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02140916
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02150916
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02160916
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02170916
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02180916
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02190916
80050 FORMAT (" ",48X,A31)                                              02200916
CBE** ********************** BBCFMT0A **********************************02210916
CBB** ********************** BBCFMT0B **********************************02220916
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02230916
C****                                                                   02240916
90002 FORMAT ("1")                                                      02250916
90004 FORMAT (" ")                                                      02260916
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02270916
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02280916
90008 FORMAT (" ",21X,A13,A17)                                          02290916
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02300916
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02310916
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02320916
     1       7X,"REMARKS",24X)                                          02330916
90014 FORMAT (" ","----------------------------------------------" ,    02340916
     1        "---------------------------------" )                     02350916
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               02360916
C****                                                                   02370916
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02380916
C****                                                                   02390916
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          02400916
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        02410916
     1        A13)                                                      02420916
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 02430916
C****                                                                   02440916
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 02450916
C****                                                                   02460916
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              02470916
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              02480916
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             02490916
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  02500916
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  02510916
CBE** ********************** BBCFMT0B **********************************02520916
C*****                                                                  02530916
C*****    END OF TEST SEGMENT 432                                       02540916
        STOP                                                            02550916
        END                                                             02560916