C*********************************************************************** C***** FM910 C***** DIRAF2 - (411) C***** THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911 C*********************************************************************** C***** TESTING OF DIRECT ACCESS FILES ANS REF C***** UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT 12.5 C***** ACCESS TO THE SAME FILE C***** NAMED FILE AND SCRATCH FILE C***** C***** USES SUBROUTINE SN911 C***** CBB** ********************** BBCCOMNT ********************************** C**** C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM C**** VERSION 2.0 C**** C**** C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C**** GENERAL SERVICES ADMINISTRATION C**** FEDERAL SOFTWARE TESTING CENTER C**** 5203 LEESBURG PIKE, SUITE 1100 C**** FALLS CHURCH, VA. 22041 C**** C**** (703) 756-6153 C**** CBE** ********************** BBCCOMNT ********************************** C***** C***** S P E C I F I C A T I O N S SEGMENT 910 DIMENSION L1I(10), N1I(15), F1S(10), H1S(15) CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15) LOGICAL AVB, BVB, C1B(10), E1B(15) DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15) COMPLEX AVC, BVC, C1C(10), D1C(15) C***** C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING CHARACTER*15 CDIR C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100 C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. CBB** ********************** BBCINITA ********************************** C**** SPECIFICATION STATEMENTS C**** CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 CBE** ********************** BBCINITA ********************************** CBB** ********************** BBCINITB ********************************** C**** INITIALIZE SECTION DATA ZVERS, ZVERSD, ZDATE 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ DATA ZCOMPL, ZNAME, ZTAPE 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ DATA ZPROJ, ZTAPED, ZPROG 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ DATA REMRKS /' '/ C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED C**** FOR IDENTIFYING THE TEST ENVIRONMENT C**** CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' CZ03 ZPROG = 'PROGRAM NAME' ZDATE = ' DEC. 1983 ' ZCOMPL = ' ICL VME FORTRAN77 ' ZPROJ = ' LANG. CENTRE' ZNAME = 'ICL ' ZTAPE = 'M999 ' ZTAPED = '831005 ' C IVPASS = 0 IVFAIL = 0 IVDELE = 0 IVINSP = 0 IVTOTL = 0 IVTOTN = 0 ICZERO = 0 C C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 05 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 06 C CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. C CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. C CBE** ********************** BBCINITB ********************************** C***** C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. C***** C I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. I10 = 24 CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER). C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. C***** C I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE. I11 = 25 CX110 REPLACED BY FEXEC X-110 CONTROL CARD (DIR. FILE UNIT NUMBER). C SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25. C***** C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, C***** UNFORMATTED FILE. C***** C CDIR CONTAINS THE FILE NAME FOR UNIT I10. CDIR = 'DIRFILE' C CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'. C***** FILE NUMBER AND NAME ASSIGNMENT NUVI = I02 IMVI = I10 KMVI = I11 IVTOTL = 6 ZPROG = 'FM910' CBB** ********************** BBCHED0A ********************************** C**** C**** WRITE REPORT TITLE C**** WRITE (I02, 90002) WRITE (I02, 90006) WRITE (I02, 90007) WRITE (I02, 90008) ZVERS, ZVERSD WRITE (I02, 90009) ZPROG, ZPROG WRITE (I02, 90010) ZDATE, ZCOMPL CBE** ********************** BBCHED0A ********************************** C***** C***** HEADER FOR SEGMENT 910 WRITE(NUVI,41100) 41100 FORMAT(1H ,/46H DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE// 1 41H WITH OPTION TO OPEN AS A SEQUENTIAL FILE// 2 16H ANS REF. - 12.5) CBB** ********************** BBCHED0B ********************************** C**** WRITE DETAIL REPORT HEADERS C**** WRITE (I02,90004) WRITE (I02,90004) WRITE (I02,90013) WRITE (I02,90014) WRITE (I02,90015) IVTOTL CBE** ********************** BBCHED0B ********************************** C***** INITIALIZE DATA CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K) MMVI = 0 C***** OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132, 1 STATUS='NEW',nrec=500) C***** WRITE DIRECT FILE IN SEQUENTIAL ORDER DO 41101 IVI = 1,10 AVS = F1S (IVI) A4VK = A41K (IVI) AVB = C1B (IVI) AVD = D1D (IVI) AVC = C1C (IVI) WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC 41101 CONTINUE C***** CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK) CLOSE(UNIT=IMVI) IF(D4VK .EQ. 'YES ') GOTO 41103 WRITE(NUVI,41102) 41102 FORMAT(1H ,48X,31HTESTS 2 THRU 6 ARE EXPECTED TO / 1 1H ,48X,31HEXECUTE / 2 1H ,48X,31HTEST 1 IS OPTIONAL AND IS NOT / 3 1H ,48X,31HEXECUTED IF DIRECT ACCESS / 4 1H ,48X,31HFILE CANNOT BE REOPENED AS / 5 1H ,48X,31HA SEQUENTIAL FILE ) GOTO 41119 CT001* TEST 1 READ IT SEQUENTIALY 41103 IVTNUM = 1 IVCOMP = 0 OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD', 1 FORM='UNFORMATTED') REWIND(UNIT=IMVI) DO 41104 IVI = 1, 10 READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC IF (IVI .NE. KVI) GOTO 20010 IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010 IF (B4VK .NE. A41K(IVI)) GOTO 20010 IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010 IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010 GO TO 41104 20010 IVCOMP = IVCOMP + 1 IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 WRITE (NUVI, 70010) IVTNUM, IVI WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 1 C1C(IVI) 70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2) 70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H)/ 1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H)) 41104 CONTINUE IF (IVCOMP - 0) 0011, 10010, 0011 10010 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM 0011 CONTINUE C***** 41118 CLOSE(UNIT=IMVI) CT002* TEST 2 REOPEN AS DIRECT FILE, C***** AND READ IN SEQUENTIAL ORDER 41119 IVTNUM = 2 IVCOMP = 0 C***** OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 1 RECL=132) DO 41120 IVI = 1, 10 READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC IF (IVI .NE. KVI) GOTO 20020 IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020 IF (B4VK .NE. A41K(IVI)) GOTO 20020 IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20020 IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020 IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020 GO TO 41120 20020 IVCOMP = IVCOMP + 1 IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 WRITE (NUVI, 70010) IVTNUM, IVI WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 1 C1C(IVI) 41120 CONTINUE IF (IVCOMP - 0) 0021, 10020, 0021 10020 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM 0021 CONTINUE C***** 41121 CLOSE(UNIT=IMVI) CT003* TEST 3 READ IT AS DIRECT C***** FILE IN NONSEQUENTIAL ORDER IVTNUM = 3 IVCOMP = 0 C***** OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 1 RECL=132) DO 41122 IVI = 1, 10 JVI = L1I(IVI) READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC IF (KVI .NE. JVI) GOTO 20030 IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030 IF (B4VK .NE. A41K(JVI)) GOTO 20030 IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20030 IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030 IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT. 1 REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI))) 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030 GO TO 41122 20030 IVCOMP = IVCOMP + 1 IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 WRITE (NUVI, 70010) IVTNUM, JVI WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 1 F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI), 1 C1C(JVI) 41122 CONTINUE IF (IVCOMP - 0) 0031, 10030, 0031 10030 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM 0031 CONTINUE C***** 41123 OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH') C***** CT004* TEST 4 CHECK RECL AND NEXTREC ON SCRATCH FILE IVTNUM = 4 INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) IF (IVI .NE. 80) GOTO 20040 IF (KVI .NE. 1) GOTO 20040 10040 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM GO TO 0041 20040 IVFAIL = IVFAIL + 1 WRITE (NUVI, 70030) IVTNUM WRITE (NUVI, 70040) IVI, KVI 70030 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 70040 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 1) 0041 CONTINUE C***** C***** WRITE DIRECT ACCESS C***** SCRATCH FILE IN NONSEQUENTIAL ORDER DO 41126 IVI = 1,15 JVI = N1I (IVI) AVS = H1S (JVI) A4VK = C41K (JVI) AVB = E1B (JVI) AVC = D1C(JVI) AVD = B1D(JVI) WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS 41126 CONTINUE CT005* TEST 5 CHECK DIRECT ACCESS SCRATCH FILE C***** BY READING IT IN NONSEQUENTIAL ORDER IVTNUM = 5 IVCOMP = 0 MMVI = -1 DO 41127 IVI = 15,1,-1 JVI = N1I (IVI) READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS IF (KVI .NE. JVI) GOTO 20050 IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050 IF (B4VK .NE. C41K(JVI)) GOTO 20050 IF ((BVB .AND. .NOT. E1B(JVI)) .OR. 1 (.NOT. BVB .AND. E1B(JVI))) GOTO 20050 IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050 IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT. 1 REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI))) 2 .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050 GO TO 41127 20050 IVCOMP = IVCOMP + 1 IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 WRITE (NUVI, 70010) IVTNUM, JVI WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 1 H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI), 1 D1C(JVI) 41127 CONTINUE IF (IVCOMP - 0) 0051, 10050, 0051 10050 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM 0051 CONTINUE C***** CT006* TEST 6 CHECK RECL AND NEXTREC AFTER READING IVTNUM = 6 INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) IF (IVI .NE. 80) GOTO 20060 IF (KVI .NE. 6) GOTO 20060 10060 IVPASS = IVPASS + 1 WRITE (NUVI, 80002) IVTNUM GO TO 0061 20060 IVFAIL = IVFAIL + 1 WRITE (NUVI, 70050) IVTNUM WRITE (NUVI, 70060) IVI, KVI 70050 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 70060 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 6) 0061 CONTINUE C***** CLOSE (UNIT=IMVI,STATUS='DELETE') C***** C**** CBB** ********************** BBCSUM0 ********************************** C**** WRITE OUT TEST SUMMARY C**** IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP WRITE (I02, 90004) WRITE (I02, 90014) WRITE (I02, 90004) WRITE (I02, 90020) IVPASS WRITE (I02, 90022) IVFAIL WRITE (I02, 90024) IVDELE WRITE (I02, 90026) IVINSP WRITE (I02, 90028) IVTOTN, IVTOTL CBE** ********************** BBCSUM0 ********************************** CBB** ********************** BBCFOOT0 ********************************** C**** WRITE OUT REPORT FOOTINGS C**** WRITE (I02,90016) ZPROG, ZPROG WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED WRITE (I02,90019) CBE** ********************** BBCFOOT0 ********************************** CBB** ********************** BBCFMT0A ********************************** C**** FORMATS FOR TEST DETAIL LINES C**** 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 1I6,/,1H ,15X,10HCORRECT= ,I6) 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 1A21,/,1H ,16X,10HCORRECT= ,A21) 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 80050 FORMAT (1H ,48X,A31) CBE** ********************** BBCFMT0A ********************************** CBB** ********************** BBCFMAT1 ********************************** C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE C**** 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 21H(,F12.5,2H, ,F12.5,1H)) CBE** ********************** BBCFMAT1 ********************************** CBB** ********************** BBCFMT0B ********************************** C**** FORMAT STATEMENTS FOR PAGE HEADERS C**** 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,A13,A17) 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 1 7X,7HREMARKS,24X) 90014 FORMAT (1H ,46H----------------------------------------------, 1 33H---------------------------------) 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) C**** C**** FORMAT STATEMENTS FOR REPORT FOOTINGS C**** 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 1 A13) 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) C**** C**** FORMAT STATEMENTS FOR RUN SUMMARY C**** 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) CBE** ********************** BBCFMT0B ********************************** C***** C***** END OF TEST SEGMENT 910 STOP END C********************************************************************** C***** FM911 C***** C***** SN911 EAQ - (806) C***** THIS SUBROUTINE IS CALLED BY FM910 C********************************************************************** SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D, 1 BW1D,CW1C, DW1C, A4W1K, C4W1K) C***** C***** SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST C***** DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15) REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15) LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15) DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15) COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15) CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15) C***** DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/ DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/ DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1, 1 3.4, 5.60, 34.9, 3.48, 23.8/ DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD' 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ DATA C4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM' 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL', 'KDFJ', 'ABCD' 2 , 'ASDF', 'GHJK', 'QWER'/ DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 1 .FALSE., .TRUE., .TRUE., .FALSE./ DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 1 .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE., 2 .FALSE., .TRUE., .FALSE./ DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1, 1 2.34D1, 398.0D0, 3.49D-1, 0.99D1/ DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1, 1 34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3, 2 389.098D1, 483.98D0, 3456.0D-4/ DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 1 (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 2 (2.56, 2.1), (3.4, 4.5)/ DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 1 (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9), 2 (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 3 (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/ C***** DO 1 IVI = 1, 10 LW1I(IVI) = LT1I(IVI) FW1S(IVI) = FT1S(IVI) CW1B(IVI) = CT1B(IVI) DW1D(IVI) = DT1D(IVI) CW1C(IVI) = CT1C(IVI) A4W1K(IVI) = A4T1K(IVI) 1 CONTINUE C***** DO 2 IVI = 1, 15 NW1I(IVI) = NT1I(IVI) HW1S(IVI) = HT1S(IVI) EW1B(IVI) = ET1B(IVI) BW1D(IVI) = BT1D(IVI) DW1C(IVI) = DT1C(IVI) C4W1K(IVI) = C4T1K(IVI) 2 CONTINUE C***** RETURN END