*********** 00010913 FORTRAN 77 00020913 * FM913 00030913 * SN913 FAQ - (807) 00040913 * THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913 ********** 00060913
PROGRAM FM912 C***********************************************************************00010912 C***** FORTRAN 77 00020912 C***** FM912 00030912 C***** DIRAF3 - (412) 00040912 C***** THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913 00050912 C***********************************************************************00060912 C***** TESTING OF DIRECT ACCESS FILES ANS REF 00070912 C***** FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT 12.5 00080912 C***** ACCESS TO THE SAME FILE 00090912 C***** 00100912 C***** USES SUBROUTINE SN913 FAQ 00110912 C***** 00120912 C***** S P E C I F I C A T I O N S SEGMENT 412 00130912 C***********************************************************************00140912 DIMENSION F1S(10), G1S(10) 00150912 CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10) 00160912 CHARACTER*47 A47VK, B47VK, C47VK 00170912 CHARACTER*51 A51VK 00180912 CHARACTER*12 A12VK 00190912 CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4 00200912 CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45 00210912 LOGICAL AVB, BVB, CVB, C1B(10), D1B(10) 00220912 DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15) 00230912 C***** 00240912 C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00250912 CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00260912 CHARACTER*15 CDIR 00270912 C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130 00280912 C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00290912 CBB** ********************** BBCINITA **********************************00300912 C**** SPECIFICATION STATEMENTS 00310912 C**** 00320912 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330912 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340912 CBE** ********************** BBCINITA **********************************00350912 CBB** ********************** BBCINITB **********************************00360912 C**** INITIALIZE SECTION 00370912 DATA ZVERS, ZVERSD, ZDATE 00380912 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390912 DATA ZCOMPL, ZNAME, ZTAPE 00400912 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410912 DATA ZPROJ, ZTAPED, ZPROG 00420912 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430912 DATA REMRKS /' '/ 00440912 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450912 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460912 C**** 00470912 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480912 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490912 CZ03 ZPROG = 'PROGRAM NAME' 00500912 CZ04 ZDATE = 'DATE OF TEST' 00510912 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520912 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530912 CZ07 ZNAME = 'NAME OF USER' 00540912 CZ08 ZTAPE = 'TAPE OWNER/ID' 00550912 CZ09 ZTAPED = 'DATE TAPE COPIED' 00560912 C 00570912 IVPASS = 0 00580912 IVFAIL = 0 00590912 IVDELE = 0 00600912 IVINSP = 0 00610912 IVTOTL = 0 00620912 IVTOTN = 0 00630912 ICZERO = 0 00640912 C 00650912 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660912 I01 = 05 00670912 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680912 I02 = 06 00690912 C 00700912 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710912 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720912 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730912 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740912 C 00750912 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760912 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770912 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780912 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790912 C 00800912 CBE** ********************** BBCINITB **********************************00810912 C***** 00820912 C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00830912 C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00840912 C***** 00850912 C I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00860912 I13 = 24 00870912 CX130 REPLACED BY FEXEC X-130 CONTROL CARD (DIR. FILE UNIT NUMBER). 00880912 C SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24. 00890912 C 00900912 C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00910912 C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00920912 C***** FORMATTED FILE. 00930912 C***** 00940912 C CDIR CONTAINS THE FILE NAME FOR UNIT I13. 00950912 CDIR = ' DIRFILE' 00960912 C 00970912 CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 00980912 C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 00990912 C X-130 THAN THE DEFAULT CDIR = ' DIRFILE'. 01000912 C 01010912 C***** FILE NUMBER AND NAME ASSIGNMENT 01020912 NUVI = I02 01030912 KUVI = I13 01040912 IVTOTL = 26 01050912 ZPROG = 'FM912' 01060912 C***** 01070912 C***** FILE NUMBER AND NAME ASSIGNMENT 01080912 C***** 01090912 REMK1='RECORD 1 - ERR PATH TAKEN' 01100912 REMK2='RECORD 2 - ERR PATH TAKEN' 01110912 REMK3='RECORD 3 - ERR PATH TAKEN' 01120912 REMK4='RECORD 4 - ERR PATH TAKEN' 01130912 REMK5='RECORD 5 - ERR PATH TAKEN' 01140912 REMK45='RECORD 4 + 5 - ERR PATH TAKEN' 01150912 CBB** ********************** BBCHED0A **********************************01160912 C**** 01170912 C**** WRITE REPORT TITLE 01180912 C**** 01190912 WRITE (I02, 90002) 01200912 WRITE (I02, 90006) 01210912 WRITE (I02, 90007) 01220912 WRITE (I02, 90008) ZVERS, ZVERSD 01230912 WRITE (I02, 90009) ZPROG, ZPROG 01240912 WRITE (I02, 90010) ZDATE, ZCOMPL 01250912 CBE** ********************** BBCHED0A **********************************01260912 WRITE(NUVI,41200) 01270912 41200 FORMAT( " ",/" DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE" / 01280912 1 " WITH OPTION TO OPEN AS A SEQUENTIAL FILE" / 01290912 2 " ANS REF. - 12.5" ) 01300912 CBB** ********************** BBCHED0B **********************************01310912 C**** WRITE DETAIL REPORT HEADERS 01320912 C**** 01330912 WRITE (I02,90004) 01340912 WRITE (I02,90004) 01350912 WRITE (I02,90013) 01360912 WRITE (I02,90014) 01370912 WRITE (I02,90015) IVTOTL 01380912 CBE** ********************** BBCHED0B **********************************01390912 C***** 01400912 C***** PLUS OR MINUS VALUES 01410912 C***** 01420912 CVS = 0.0001 01430912 CVD = 0.0001D0 01440912 C***** 01450912 C***** INITIALIZE DATA ARRAYS 01460912 C***** 01470912 CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K) 01480912 C***** 01490912 C***** OPEN DIRECT ACCESS FILE - STATUS=NEW 01500912 C***** 01510912 OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120, 01520912 1 FORM='FORMATTED',STATUS='NEW') 01530912 C***** 01540912 CT001* TEST 1 - CHECKS RECL AND NEXTREC 01550912 C***** FOR JUST OPENED DIRECT ACCESS FILE 01560912 C***** 01570912 IVTNUM=1 01580912 INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 01590912 IF (IVI .NE. 120) GO TO 33020 01600912 IF (KVI .NE. 1) GO TO 33020 01610912 WRITE(NUVI,80002)IVTNUM 01620912 IVPASS=IVPASS+1 01630912 GO TO 33030 01640912 33020 REMK='ERROR IN INQUIRE' 01650912 WRITE(NUVI,55010)IVTNUM,REMK 01660912 55010 FORMAT(" ","TEST ",I3,1X," FAIL",34X,A31) 01670912 IVFAIL=IVFAIL+1 01680912 WRITE(NUVI,55020)IVI,KVI 01690912 55020 FORMAT(" ",/,11X,"COMPUTED: RECL=" ,I6,5X,"NEXTREC=",I6) 01700912 WRITE(NUVI,55030) 01710912 55030 FORMAT(" ",10X,"CORRECT: RECL= 120" ,5X,"NEXTREC= 1" /) 01720912 C***** 01730912 CT002* TEST 2 - WRITES RECORD 1 01740912 C***** 01750912 33030 IVTNUM=2 01760912 IVI = 1 01770912 AVS = F1S (IVI) 01780912 BVS = F1S(IVI + 1) 01790912 A20VK = A201K (IVI) 01800912 AVB = C1B (IVI) 01810912 AVD = D1D (IVI) 01820912 WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD, 01830912 1 AVB, A20VK 01840912 41204 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD') 01850912 WRITE(NUVI,80002)IVTNUM 01860912 IVPASS=IVPASS+1 01870912 GO TO 33050 01880912 33040 WRITE(NUVI,55010)IVTNUM,REMK1 01890912 IVFAIL=IVFAIL+1 01900912 C***** 01910912 CT003* TEST 3 - WRITES RECORD 2 01920912 C***** 01930912 33050 IVTNUM=3 01940912 IVI = IVI + 1 01950912 AVS = F1S (IVI) 01960912 BVS = F1S(IVI + 1) 01970912 A20VK = A201K (IVI) 01980912 AVB = C1B (IVI) 01990912 AVD = D1D (IVI) 02000912 WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS, 02010912 1 AVB, A20VK 02020912 41205 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD') 02030912 WRITE(NUVI,80002)IVTNUM 02040912 IVPASS=IVPASS+1 02050912 GO TO 33070 02060912 33060 WRITE(NUVI,55010)IVTNUM,REMK2 02070912 IVFAIL=IVFAIL+1 02080912 C***** 02090912 CT004* TEST 4 - WRITES RECORD 3 02100912 C***** 02110912 33070 IVTNUM=4 02120912 IVI = IVI + 1 02130912 AVS = F1S (IVI) 02140912 BVS = F1S(IVI + 1) 02150912 A20VK = A201K (IVI) 02160912 AVB = C1B (IVI) 02170912 AVD = D1D (IVI) 02180912 WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD, 02190912 1 AVB, A20VK 02200912 41206 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC') 02210912 WRITE(NUVI,80002)IVTNUM 02220912 IVPASS=IVPASS+1 02230912 GO TO 33090 02240912 02250912 33080 WRITE(NUVI,55010)IVTNUM,REMK3 02260912 IVFAIL=IVFAIL+1 02270912 C***** 02280912 CT005* TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE 02290912 C***** 02300912 33090 IVTNUM=5 02310912 IVI = IVI + 1 02320912 AVS = F1S (IVI) 02330912 BVS = F1S(IVI + 1) 02340912 A20VK = A201K (IVI) 02350912 AVB = C1B (IVI) 02360912 AVD = D1D (IVI) 02370912 WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB, 02380912 1 A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK 02390912 41207 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/ 02400912 1 E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END') 02410912 WRITE(NUVI,80002)IVTNUM 02420912 IVPASS=IVPASS+1 02430912 GO TO 33290 02440912 33100 WRITE(NUVI,55010)IVTNUM,REMK45 02450912 IVFAIL=IVFAIL+1 02460912 C***** 02470912 CT006* TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE 02480912 C***** 02490912 33290 IVTNUM=6 02500912 INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 02510912 IF (IVI .NE. 120)GO TO 33300 02520912 IF(KVI .NE. 6)GO TO 33300 02530912 WRITE(NUVI,80002)IVTNUM 02540912 IVPASS=IVPASS+1 02550912 GO TO 33110 02560912 33300 REMK='ERROR IN INQUIRE' 02570912 WRITE(NUVI,55010)IVTNUM,REMK 02580912 IVFAIL=IVFAIL+1 02590912 WRITE(NUVI,55020)IVI,KVI 02600912 WRITE(NUVI,55040) 02610912 55040 FORMAT(" ",10X,"CORRECT: RECL= 120" ,5X,"NEXTREC= 6" /) 02620912 C***** 02630912 CT007* TEST 7 - READS RECORD 1 02640912 C***** 02650912 33110 IVTNUM=7 02660912 IVI = 1 02670912 READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD, 02680912 1 AVB, A20VK, A47VK 02690912 41210 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47) 02700912 ISWT=1 02710912 GO TO 33220 02720912 02730912 33120 WRITE(NUVI,55010)IVTNUM,REMK1 02740912 IVFAIL=IVFAIL+1 02750912 C***** 02760912 CT008* TEST 8 - READS RECORD 2 02770912 C***** 02780912 33130 IVTNUM=8 02790912 IVI = 2 02800912 READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS, 02810912 1 AVB, A20VK, A51VK 02820912 41238 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51) 02830912 ISWT=2 02840912 GO TO 33230 02850912 02860912 33140 WRITE(NUVI,55010)IVTNUM,REMK2 02870912 IVFAIL=IVFAIL+1 02880912 C***** 02890912 CT009* TEST 9 - READS RECORD 3 02900912 C***** 02910912 33150 IVTNUM=9 02920912 IVI = 3 02930912 READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD, 02940912 1 BVB, B20VK, B47VK 02950912 ISWT=3 02960912 GO TO 33240 02970912 02980912 33160 WRITE(NUVI,55010)IVTNUM,REMK3 02990912 IVFAIL=IVFAIL+1 03000912 C***** 03010912 CT010* TEST 10 - READS RECORD 4 03020912 C***** 03030912 33170 IVTNUM=10 03040912 IVI = 4 03050912 READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB, 03060912 1 C20VK, FVS, C47VK 03070912 41241 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47) 03080912 ISWT=4 03090912 GO TO 33250 03100912 03110912 33180 WRITE(NUVI,55010)IVTNUM,REMK4 03120912 IVFAIL=IVFAIL+1 03130912 C***** 03140912 CT011* TEST 11 - READS RECORD 5 03150912 C***** 03160912 33190 IVTNUM=11 03170912 IVI = 5 03180912 JVI = 4 03190912 READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI, 03200912 1 AVS, A20VK, A51VK 03210912 41218 FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51) 03220912 ISWT=5 03230912 GO TO 33260 03240912 03250912 33200 WRITE(NUVI,55010)IVTNUM,REMK5 03260912 IVFAIL=IVFAIL+1 03270912 C***** 03280912 CT012* TEST 12 - OVERWRITES RECORD 3 03290912 C***** 03300912 33210 IVTNUM=12 03310912 IVI = 3 03320912 AVS = G1S (IVI) 03330912 BVS = G1S(IVI + 1) 03340912 A20VK = B201K (IVI) 03350912 AVB = D1B (IVI) 03360912 AVD = B1D (IVI) 03370912 WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD, 03380912 1 A20VK, AVB 03390912 41251 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW RECORD ') 03400912 WRITE(NUVI,80002)IVTNUM 03410912 IVPASS=IVPASS+1 03420912 GO TO 33320 03430912 03440912 33310 WRITE(NUVI,55010)IVTNUM,REMK3 03450912 IVFAIL=IVFAIL+1 03460912 C***** 03470912 CT013* TEST 13 - OVERWRITES RECORD 5 03480912 C***** 03490912 33320 IVTNUM=13 03500912 IVI = 5 03510912 AVS = G1S (IVI) 03520912 BVS = G1S(IVI - 1) 03530912 A20VK = B201K (IVI) 03540912 AVB = D1B (IVI) 03550912 AVD = B1D (IVI) 03560912 WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,03570912 1 BVS, AVB 03580912 41252 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP RECORD') 03590912 WRITE(NUVI,80002)IVTNUM 03600912 IVPASS=IVPASS+1 03610912 GO TO 33340 03620912 03630912 33330 WRITE(NUVI,55010)IVTNUM,REMK5 03640912 IVFAIL=IVFAIL+1 03650912 C***** 03660912 C***** CLOSE AND REOPEN DIRECT ACCESS FILE 03670912 C***** 03680912 33340 CLOSE(UNIT=KUVI) 03690912 OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 03700912 1 FORM='FORMATTED',RECL=120) 03710912 C***** 03720912 CT014* TEST 14 - READS RECORD 4 03730912 C***** 03740912 IVTNUM=14 03750912 IVI = 4 03760912 READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB, 03770912 1 C20VK, FVS, C47VK 03780912 ISWT=6 03790912 GO TO 33250 03800912 03810912 33350 WRITE(NUVI,55010)IVTNUM,REMK4 03820912 IVFAIL=IVFAIL+1 03830912 C***** 03840912 CT015* TEST 15 - READS THE CHANGED RECORD 5 03850912 C***** 03860912 33360 IVTNUM=15 03870912 IVI = 5 03880912 READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK, 03890912 1 AVD, BVS, AVB, A47VK03900912 41254 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47) 03910912 ISWT=7 03920912 IF (KVI .NE. IVI) GOTO 41221 03930912 IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122303940912 IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 4122503950912 IF (A20VK .NE. B201K(IVI)) GOTO 41229 03960912 IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 03970912 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 03980912 IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122703990912 IF (A47VK .NE. 04000912 1 ' STOP RECORD') GOTO 41231 04010912 WRITE(NUVI,80002)IVTNUM 04020912 IVPASS=IVPASS+1 04030912 GO TO 33380 04040912 33370 WRITE(NUVI,55010)IVTNUM,REMK5 04050912 IVFAIL=IVFAIL+1 04060912 C***** 04070912 CT016* TEST 16 - READS RECORD 2 04080912 C***** 04090912 33380 IVTNUM=16 04100912 IVI = 2 04110912 READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS, 04120912 1 AVB, A20VK, A51VK 04130912 ISWT=8 04140912 GO TO 33230 04150912 04160912 33390 WRITE(NUVI,55010)IVTNUM,REMK2 04170912 IVFAIL=IVFAIL+1 04180912 C***** 04190912 CT017* TEST 17 - READS THE CHANGED RECORD 3 04200912 C***** 04210912 33400 IVTNUM=17 04220912 IVI = 3 04230912 READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD, 04240912 1 A20VK, AVB, A47VK 04250912 41256 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47) 04260912 ISWT=9 04270912 IF (KVI .NE. IVI) GOTO 41221 04280912 IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122304290912 IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 4122504300912 IF (A20VK .NE. B201K(IVI)) GOTO 41229 04310912 IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 04320912 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 04330912 IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122704340912 IF (A47VK .NE. 04350912 1 ' NEW RECORD ') GOTO 41231 04360912 WRITE(NUVI,80002)IVTNUM 04370912 IVPASS=IVPASS+1 04380912 GO TO 33420 04390912 04400912 33410 WRITE(NUVI,55010)IVTNUM,REMK3 04410912 IVFAIL=IVFAIL+1 04420912 C***** 04430912 CT018* TEST 18 - READS RECORD 1 04440912 C***** 04450912 33420 IVTNUM=18 04460912 IVI = 1 04470912 READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD, 04480912 1 AVB, A20VK, A47VK 04490912 ISWT=10 04500912 GO TO 33220 04510912 04520912 33430 WRITE(NUVI,55010)IVTNUM,REMK1 04530912 IVFAIL=IVFAIL+1 04540912 C***** 04550912 CT019* TEST 19 - OVERWRITES RECORD 4 04560912 C***** 04570912 33440 IVTNUM=19 04580912 41258 IVI = 4 04590912 KVI = IVI + 1 04600912 AVS = F1S (IVI) 04610912 BVS = F1S(IVI + 1) 04620912 EVS = F1S(IVI) + 2.34 04630912 AVD = D1D (IVI) 04640912 WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS, 04650912 1 EVS, AVD 04660912 41259 FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8) 04670912 WRITE(NUVI,80002)IVTNUM 04680912 IVPASS=IVPASS+1 04690912 GO TO 33460 04700912 04710912 33450 WRITE(NUVI,55010)IVTNUM,REMK4 04720912 IVFAIL=IVFAIL+1 04730912 C***** 04740912 CT020* TEST 20 - OVERWRITES RECORDS 1, 2, AND 3 04750912 C***** 04760912 33460 IVTNUM=20 04770912 IVI = 1 04780912 A1VK = 'A' 04790912 A4VK = A201K (IVI) (1:4) 04800912 AVB = C1B (IVI) 04810912 AVD = D1D (IVI) 04820912 BVD = D1D (IVI) + 3.234D2 04830912 WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK, 04840912 1 A4VK 04850912 41260 FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//, 04860912 1 "HOLLERITH " , T15, 'ONE', 10X, TL5, 'TWO', TR5, 04870912 2 'THREE', :, 'LAST') 04880912 WRITE(NUVI,80002)IVTNUM 04890912 IVPASS=IVPASS+1 04900912 GO TO 33480 04910912 04920912 33470 WRITE(NUVI,55010)IVTNUM,REMK1 04930912 IVFAIL=IVFAIL+1 04940912 C***** 04950912 CT021* TEST 21 - OVERWRITES RECORD 5 04960912 C***** 04970912 33480 IVTNUM=21 04980912 IVI = 5 04990912 BVS = F1S(IVI - 1) 05000912 AVD = B1D (4) 05010912 WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD 05020912 41261 FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2) 05030912 WRITE(NUVI,80002)IVTNUM 05040912 IVPASS=IVPASS+1 05050912 GO TO 33500 05060912 05070912 33490 WRITE(NUVI,55010)IVTNUM,REMK5 05080912 IVFAIL=IVFAIL+1 05090912 C***** 05100912 C***** CLOSE AND REOPEN DIRECT ACCESS FILE 05110912 C***** 05120912 33500 CLOSE(UNIT=KUVI) 05130912 OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 05140912 1 FORM='FORMATTED',RECL=120) 05150912 C***** 05160912 CT022* TEST 22 - READS RECORD 1 05170912 C***** 05180912 IVTNUM=22 05190912 IVI = 1 05200912 READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB, 05210912 1 A1VK, A4VK, A12VK 05220912 41262 FORMAT(G14.8, A20, L2, A, A4, A12) 05230912 ISWT=1 05240912 IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4127705250912 IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279 05260912 IF ((A1VK .NE. 'A') .OR. 05270912 1 (A4VK .NE. A201K(IVI)(1:4)) .OR. 05280912 2 (A12VK .NE. 'TSAL DROCER')) GOTO 41279 05290912 WRITE(NUVI,80002)IVTNUM 05300912 IVPASS=IVPASS+1 05310912 GO TO 33520 05320912 05330912 33510 WRITE(NUVI,55010)IVTNUM,REMK1 05340912 IVFAIL=IVFAIL+1 05350912 C***** RECORD # 4 05360912 CT023* TEST 23 - READS RECORD 4 05370912 C***** 05380912 33520 IVTNUM=23 05390912 IVI = 4 05400912 READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS, 05410912 1 BVS, B20VK, AVD 05420912 41266 FORMAT(I5, A5, F10.5, E14.6, A20, D14.8) 05430912 ISWT=2 05440912 IF (A20VK(3:5) .NE. '005') GOTO 41293 05450912 IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR. 05460912 1 (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR. 05470912 2 (B20VK(13:20) .NE. '.6E+0001')) GOTO 41293 05480912 WRITE(NUVI,80002)IVTNUM 05490912 IVPASS=IVPASS+1 05500912 GO TO 33540 05510912 05520912 33530 WRITE(NUVI,55010)IVTNUM,REMK4 05530912 IVFAIL=IVFAIL+1 05540912 C***** 05550912 CT024* TEST 24 - READS RECORD 2 TESTS FOR BLANK RECORD 05560912 C***** 05570912 33540 IVTNUM=24 05580912 B120VK = ' ' 05590912 IVI = 2 05600912 READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK 05610912 41269 FORMAT(A120) 05620912 ISWT=3 05630912 IF (A120VK .NE. B120VK) GOTO 41281 05640912 WRITE(NUVI,80002)IVTNUM 05650912 IVPASS=IVPASS+1 05660912 GO TO 33560 05670912 05680912 33550 WRITE(NUVI,55010)IVTNUM,REMK2 05690912 IVFAIL=IVFAIL+1 05700912 C***** 05710912 CT025* TEST 25 - READS RECORD 5 05720912 C***** 05730912 33560 IVTNUM=25 05740912 IVI = 5 05750912 READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS, 05760912 1 B20VK, C20VK 05770912 41271 FORMAT(A5, F10.5, BZ, A5, BN, A20) 05780912 ISWT=4 05790912 IF (A20VK(1:5) .NE. ' +5') GOTO 41283 05800912 IF (B20VK(1:5) .NE. ' 5') GOTO 41285 05810912 IF (C20VK(1:14) .NE. ' 625.0000E-03') GOTO 41287 05820912 WRITE(NUVI,80002)IVTNUM 05830912 IVPASS=IVPASS+1 05840912 GO TO 33580 05850912 05860912 33570 WRITE(NUVI,55010)IVTNUM,REMK5 05870912 IVFAIL=IVFAIL+1 05880912 C***** 05890912 CT026* TEST 26 - READS RECORD 3 05900912 C***** 05910912 33580 IVTNUM=26 05920912 IVI = 3 05930912 READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK 05940912 41275 FORMAT(A120) 05950912 ISWT=5 05960912 IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289 05970912 IF (A120VK(11:40) .NE. 05980912 1 ' ONE TWO THREE ') GOTO 41291 05990912 WRITE(NUVI,80002)IVTNUM 06000912 IVPASS=IVPASS+1 06010912 GO TO 33600 06020912 06030912 33590 WRITE(NUVI,55010)IVTNUM,REMK3 06040912 IVFAIL=IVFAIL+1 06050912 C***** 06060912 C***** CLOSE DIRECT ACCESS FILE 06070912 C***** 06080912 33600 CLOSE(UNIT=KUVI,STATUS='DELETE') 06090912 GO TO 33610 06100912 C***** 06110912 C***** CHECKING RECORD 1 06120912 C***** 06130912 33220 IF (KVI .NE. IVI) GOTO 41221 06140912 IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306150912 IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506160912 IF (A20VK .NE. A201K(IVI)) GOTO 41229 06170912 IF (A47VK .NE. 06180912 1 ' LAST RECORD') GOTO 41231 06190912 IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06200912 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06210912 IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706220912 WRITE(NUVI,80002)IVTNUM 06230912 IVPASS=IVPASS+1 06240912 IF (ISWT .EQ. 10)GO TO 33440 06250912 GO TO 33130 06260912 06270912 41221 WRITE(NUVI,41222)IVTNUM,IVI 06280912 IVFAIL=IVFAIL+1 06290912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06300912 1 33420,33440)ISWT 06310912 06320912 41223 WRITE(NUVI,41224)IVTNUM,IVI 06330912 IVFAIL=IVFAIL+1 06340912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06350912 1 33420,33440)ISWT 06360912 06370912 41225 WRITE(NUVI,41226)IVTNUM,IVI 06380912 IVFAIL=IVFAIL+1 06390912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06400912 1 33420,33440)ISWT 06410912 06420912 41227 WRITE(NUVI,41228)IVTNUM,IVI 06430912 IVFAIL=IVFAIL+1 06440912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06450912 1 33420,33440)ISWT 06460912 06470912 41229 WRITE(NUVI,41230)IVTNUM,IVI 06480912 IVFAIL=IVFAIL+1 06490912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06500912 1 33420,33440)ISWT 06510912 06520912 41231 WRITE(NUVI,41232)IVTNUM,IVI 06530912 IVFAIL=IVFAIL+1 06540912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06550912 1 33420,33440)ISWT 06560912 06570912 41233 WRITE(NUVI,41234)IVTNUM,IVI 06580912 IVFAIL=IVFAIL+1 06590912 GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06600912 1 33420,33440)ISWT 06610912 C***** 06620912 C***** CHECKING RECORD 2 06630912 C***** 06640912 33230 IF (KVI .NE. IVI) GOTO 41221 06650912 IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306660912 IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506670912 IF (A20VK .NE. A201K(IVI)) GOTO 41229 06680912 IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06690912 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06700912 IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706710912 IF (A51VK .NE. 06720912 1 ' LASTS RECORD ')GOTO 41231 06730912 WRITE(NUVI,80002)IVTNUM 06740912 IVPASS=IVPASS+1 06750912 IF (ISWT .EQ. 8)GO TO 33400 06760912 GO TO 33150 06770912 C***** 06780912 C***** CHECKING RECORD 3 06790912 C***** 06800912 33240 IF (LVI .NE. IVI) GOTO 41221 06810912 IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 4122306820912 IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 4122506830912 IF (B20VK .NE. A201K(IVI)) GOTO 41229 06840912 IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 06850912 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 41233 06860912 IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 4122706870912 IF (B47VK .NE. 06880912 1 ' THE LAST REC ') GOTO 41231 06890912 WRITE(NUVI,80002)IVTNUM 06900912 IVPASS=IVPASS+1 06910912 GO TO 33170 06920912 C***** 06930912 C***** CHECKING RECORD 4 06940912 C***** 06950912 33250 IF (NVI .NE. IVI) GOTO 41221 06960912 IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 4122306970912 IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 4122506980912 IF (C20VK .NE. A201K(IVI)) GOTO 41229 06990912 IF ((CVB .AND. .NOT. C1B(IVI)) .OR. 07000912 1 (.NOT. CVB .AND. C1B(IVI))) GOTO 41233 07010912 IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 4122707020912 IF (C47VK .NE. 07030912 1 ' NEXT TO LAST') GOTO 41231 07040912 WRITE(NUVI,80002)IVTNUM 07050912 IVPASS=IVPASS+1 07060912 IF (ISWT .EQ. 6)GO TO 33360 07070912 GO TO 33190 07080912 C***** 07090912 C***** CHECKING RECORD 5 07100912 C***** 07110912 33260 IF (KVI .NE. JVI) GOTO 41221 07120912 IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 4122307130912 IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 4122507140912 IF (A20VK .NE. A201K(JVI)) GOTO 41229 07150912 IF ((AVB .AND. .NOT. C1B(JVI)) .OR. 07160912 1 (.NOT. AVB .AND. C1B(JVI))) GOTO 41233 07170912 IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 4122707180912 IF (A51VK .NE. 07190912 1 ' THE END ') GOTO 4123107200912 WRITE(NUVI,80002)IVTNUM 07210912 IVPASS=IVPASS+1 07220912 GO TO 33210 07230912 C***** 07240912 C***** 07250912 C***** 07260912 41277 WRITE(NUVI,41278)IVTNUM,IVI 07270912 IVFAIL=IVFAIL+1 07280912 GO TO(33520,33540,33560,33580,33600)ISWT 07290912 07300912 41279 WRITE(NUVI,41280)IVTNUM,IVI 07310912 IVFAIL=IVFAIL+1 07320912 GO TO(33520,33540,33560,33580,33600)ISWT 07330912 07340912 41281 WRITE(NUVI,41282)IVTNUM,IVI 07350912 IVFAIL=IVFAIL+1 07360912 GO TO(33520,33540,33560,33580,33600)ISWT 07370912 07380912 41283 WRITE(NUVI,41284)IVTNUM,IVI 07390912 IVFAIL=IVFAIL+1 07400912 GO TO(33520,33540,33560,33580,33600)ISWT 07410912 07420912 41285 WRITE(NUVI,41286)IVTNUM,IVI 07430912 IVFAIL=IVFAIL+1 07440912 GO TO(33520,33540,33560,33580,33600)ISWT 07450912 07460912 41287 WRITE(NUVI,41288)IVTNUM,IVI 07470912 IVFAIL=IVFAIL+1 07480912 GO TO(33520,33540,33560,33580,33600)ISWT 07490912 07500912 41289 WRITE(NUVI,41290)IVTNUM,IVI 07510912 IVFAIL=IVFAIL+1 07520912 GO TO(33520,33540,33560,33580,33600)ISWT 07530912 07540912 41291 WRITE(NUVI,41292)IVTNUM,IVI 07550912 IVFAIL=IVFAIL+1 07560912 GO TO(33520,33540,33560,33580,33600)ISWT 07570912 07580912 41293 WRITE(NUVI,41294)IVTNUM,IVI 07590912 IVFAIL=IVFAIL+1 07600912 GO TO(33520,33540,33560,33580,33600)ISWT 07610912 C***** 07620912 C***** 07630912 C***** 07640912 41222 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07650912 1 " - ON I FORMAT" ) 07660912 41224 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07670912 1 " - ON F FORMAT" ) 07680912 41226 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07690912 1 " - ON E FORMAT" ) 07700912 41228 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07710912 1 " - ON D FORMAT" ) 07720912 41230 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07730912 1 " - ON A FORMAT" ) 07740912 41232 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07750912 1 " - ON X AND ' FORMAT" ) 07760912 41234 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07770912 1 " - ON L FORMAT" ) 07780912 41278 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07790912 1 " - ON GW.D FORMAT" ) 07800912 41280 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07810912 1 " - ON GW.DEN FORMAT" ) 07820912 41282 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07830912 1 " - ON BLANK RECORD " ) 07840912 41284 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07850912 1 " - ON SP FORMAT " ) 07860912 41286 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07870912 1 " - ON BZ OR SS FORMAT" ) 07880912 41288 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07890912 1 " - ON NP FORMAT " ) 07900912 41290 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07910912 1 " - ON H FORMAT " ) 07920912 41292 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07930912 1 " - ON TR, TLC, T FORMAT" ) 07940912 41294 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07950912 1 " - ON IN.N FORMAT " ) 07960912 C***** 07970912 C***** END OF TEST SEGMENT 412 07980912 C***** 07990912 33610 CONTINUE 08000912 CBB** ********************** BBCSUM0 **********************************08010912 C**** WRITE OUT TEST SUMMARY 08020912 C**** 08030912 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08040912 WRITE (I02, 90004) 08050912 WRITE (I02, 90014) 08060912 WRITE (I02, 90004) 08070912 WRITE (I02, 90020) IVPASS 08080912 WRITE (I02, 90022) IVFAIL 08090912 WRITE (I02, 90024) IVDELE 08100912 WRITE (I02, 90026) IVINSP 08110912 WRITE (I02, 90028) IVTOTN, IVTOTL 08120912 CBE** ********************** BBCSUM0 **********************************08130912 CBB** ********************** BBCFOOT0 **********************************08140912 C**** WRITE OUT REPORT FOOTINGS 08150912 C**** 08160912 WRITE (I02,90016) ZPROG, ZPROG 08170912 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08180912 WRITE (I02,90019) 08190912 CBE** ********************** BBCFOOT0 **********************************08200912 CBB** ********************** BBCFMT0A **********************************08210912 C**** FORMATS FOR TEST DETAIL LINES 08220912 C**** 08230912 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08240912 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08250912 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08260912 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08270912 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08280912 1I6,/," ",15X,"CORRECT= " ,I6) 08290912 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08300912 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08310912 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08320912 1A21,/," ",16X,"CORRECT= " ,A21) 08330912 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08340912 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08350912 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08360912 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08370912 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08380912 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 08390912 80050 FORMAT (" ",48X,A31) 08400912 CBE** ********************** BBCFMT0A **********************************08410912 CBB** ********************** BBCFMAT1 **********************************08420912 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08430912 C**** 08440912 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08450912 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 08460912 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 08470912 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 08480912 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08490912 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08500912 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08510912 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08520912 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08530912 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 08540912 2"(",F12.5,", ",F12.5,")") 08550912 CBE** ********************** BBCFMAT1 **********************************08560912 CBB** ********************** BBCFMT0B **********************************08570912 C**** FORMAT STATEMENTS FOR PAGE HEADERS 08580912 C**** 08590912 90002 FORMAT ("1") 08600912 90004 FORMAT (" ") 08610912 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08620912 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08630912 90008 FORMAT (" ",21X,A13,A17) 08640912 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08650912 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08660912 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08670912 1 7X,"REMARKS",24X) 08680912 90014 FORMAT (" ","----------------------------------------------" , 08690912 1 "---------------------------------" ) 08700912 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08710912 C**** 08720912 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08730912 C**** 08740912 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08750912 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08760912 1 A13) 08770912 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08780912 C**** 08790912 C**** FORMAT STATEMENTS FOR RUN SUMMARY 08800912 C**** 08810912 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08820912 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08830912 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08840912 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08850912 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08860912 CBE** ********************** BBCFMT0B **********************************08870912 STOP 08880912 END 08890912 C********************************************************************** 00010913 C***** FORTRAN 77 00020913 C***** FM913 00030913 C***** SN913 FAQ - (807) 00040913 C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913 C********************************************************************** 00060913 SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D, 00070913 1 A20W1K, B20W1K) 00080913 C***** 00090913 C***** SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES 00100913 C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110913 C***** 00120913 REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5) 00130913 LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5) 00140913 DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5) 00150913 CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5) 00160913 DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/ 00170913 DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/ 00180913 DATA A20T1K / 'AAAALKJHGFASERTYUIOP', 'KDJFLKJEOITMNV E CJF', 00190913 1 'CDFEJHFKLM CNB FHGDC', 'LKJHNHBJMVK,FIJ NVHD', 00200913 2 'JHGFKDJJSLDKFJDKJFSL'/ 00210913 DATA B20T1K / 'AAAALSDEFCASERTYUIOP', 'KDDFFEJEOITMNV E CJF', 00220913 1 'CDFEJHFKLM DHGDC', 'L...NHBJMVK,FIJ NVHD', 00230913 2 'LKJHDNMVHNEUYHBDGHCJ'/ 00240913 DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./ 00250913 DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./ 00260913 DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/ 00270913 DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/ 00280913 C***** 00290913 C***** 00300913 C***** 00310913 DO 1 IVI = 1, 5 00320913 FW1S(IVI) = FT1S(IVI) 00330913 GW1S(IVI) = GT1S(IVI) 00340913 CW1B(IVI) = CT1B(IVI) 00350913 DW1B(IVI) = DT1B(IVI) 00360913 DW1D(IVI) = DT1D(IVI) 00370913 BW1D(IVI) = BT1D(IVI) 00380913 A20W1K(IVI) = A20T1K(IVI) 00390913 B20W1K(IVI) = B20T1K(IVI) 00400913 1 CONTINUE 00410913 C***** 00420913 C***** 00430913 C***** 00440913 RETURN 00450913 END 00460913