*********** 00010911 FM911 00020911 * 00030911 * SN911 EAQ - (806) 00040911 * THIS SUBROUTINE IS CALLED BY FM910 00050911 ********** 00060911
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 = 24 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 = 25 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 = ' DIRFILE' 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