![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM912.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM912.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C***********************************************************************00010912 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C***** FORTRAN 77 00020912 ! 6: C***** FM912 00030912 ! 7: C***** DIRAF3 - (412) 00040912 ! 8: C***** THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913 00050912 ! 9: C***********************************************************************00060912 ! 10: C***** TESTING OF DIRECT ACCESS FILES ANS REF 00070912 ! 11: C***** FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT 12.5 00080912 ! 12: C***** ACCESS TO THE SAME FILE 00090912 ! 13: C***** 00100912 ! 14: C***** USES SUBROUTINE SN913 FAQ 00110912 ! 15: C***** 00120912 ! 16: C***** S P E C I F I C A T I O N S SEGMENT 412 00130912 ! 17: C***********************************************************************00140912 ! 18: DIMENSION F1S(10), G1S(10) 00150912 ! 19: CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10) 00160912 ! 20: CHARACTER*47 A47VK, B47VK, C47VK 00170912 ! 21: CHARACTER*51 A51VK 00180912 ! 22: CHARACTER*12 A12VK 00190912 ! 23: CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4 00200912 ! 24: CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45 00210912 ! 25: LOGICAL AVB, BVB, CVB, C1B(10), D1B(10) 00220912 ! 26: DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15) 00230912 ! 27: C***** 00240912 ! 28: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00250912 ! 29: CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00260912 ! 30: CHARACTER*15 CDIR 00270912 ! 31: C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130 00280912 ! 32: C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00290912 ! 33: CBB** ********************** BBCINITA **********************************00300912 ! 34: C**** SPECIFICATION STATEMENTS 00310912 ! 35: C**** 00320912 ! 36: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330912 ! 37: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340912 ! 38: CBE** ********************** BBCINITA **********************************00350912 ! 39: CBB** ********************** BBCINITB **********************************00360912 ! 40: C**** INITIALIZE SECTION 00370912 ! 41: DATA ZVERS, ZVERSD, ZDATE 00380912 ! 42: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00390912 ! 43: DATA ZCOMPL, ZNAME, ZTAPE 00400912 ! 44: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410912 ! 45: DATA ZPROJ, ZTAPED, ZPROG 00420912 ! 46: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430912 ! 47: DATA REMRKS /' '/ 00440912 ! 48: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450912 ! 49: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460912 ! 50: C**** 00470912 ! 51: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480912 ! 52: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490912 ! 53: CZ03 ZPROG = 'PROGRAM NAME' 00500912 ! 54: ZDATE = '07-Nov-85 ' *RP ! 55: ZCOMPL = 'CCI 5.2 ' *RP ! 56: ZPROJ = 'TC-85- -410' *RP ! 57: ZNAME = ' ' *RP ! 58: ZTAPE = ' ' *RP ! 59: ZTAPED = '850703 ' *RP ! 60: C 00570912 ! 61: IVPASS = 0 00580912 ! 62: IVFAIL = 0 00590912 ! 63: IVDELE = 0 00600912 ! 64: IVINSP = 0 00610912 ! 65: IVTOTL = 0 00620912 ! 66: IVTOTN = 0 00630912 ! 67: ICZERO = 0 00640912 ! 68: C 00650912 ! 69: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660912 ! 70: I01 = 05 00670912 ! 71: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680912 ! 72: I02 = 06 00690912 ! 73: C 00700912 ! 74: I01 = 5 00710912 ! 75: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720912 ! 76: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730912 ! 77: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740912 ! 78: C 00750912 ! 79: I02 = 6 00760912 ! 80: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770912 ! 81: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780912 ! 82: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790912 ! 83: C 00800912 ! 84: CBE** ********************** BBCINITB **********************************00810912 ! 85: C***** 00820912 ! 86: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00830912 ! 87: C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00840912 ! 88: C***** 00850912 ! 89: C I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00860912 ! 90: I13 = 24 00870912 ! 91: OPEN(UNIT=I13,ACCESS='DIRECT',FORM='FORMATTED',RECL=80) 00880912 ! 92: C SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24. 00890912 ! 93: C 00900912 ! 94: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00910912 ! 95: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00920912 ! 96: C***** FORMATTED FILE. 00930912 ! 97: C***** 00940912 ! 98: C CDIR CONTAINS THE FILE NAME FOR UNIT I13. 00950912 ! 99: CDIR = ' DIRFILE' 00960912 ! 100: C 00970912 ! 101: CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 00980912 ! 102: C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 00990912 ! 103: C X-130 THAN THE DEFAULT CDIR = ' DIRFILE'. 01000912 ! 104: C 01010912 ! 105: C***** FILE NUMBER AND NAME ASSIGNMENT 01020912 ! 106: NUVI = I02 01030912 ! 107: KUVI = I13 01040912 ! 108: IVTOTL = 26 01050912 ! 109: ZPROG = 'FM912' 01060912 ! 110: C***** 01070912 ! 111: C***** FILE NUMBER AND NAME ASSIGNMENT 01080912 ! 112: C***** 01090912 ! 113: REMK1='RECORD 1 - ERR PATH TAKEN' 01100912 ! 114: REMK2='RECORD 2 - ERR PATH TAKEN' 01110912 ! 115: REMK3='RECORD 3 - ERR PATH TAKEN' 01120912 ! 116: REMK4='RECORD 4 - ERR PATH TAKEN' 01130912 ! 117: REMK5='RECORD 5 - ERR PATH TAKEN' 01140912 ! 118: REMK45='RECORD 4 + 5 - ERR PATH TAKEN' 01150912 ! 119: CBB** ********************** BBCHED0A **********************************01160912 ! 120: C**** 01170912 ! 121: C**** WRITE REPORT TITLE 01180912 ! 122: C**** 01190912 ! 123: WRITE (I02, 90002) 01200912 ! 124: WRITE (I02, 90006) 01210912 ! 125: WRITE (I02, 90007) 01220912 ! 126: WRITE (I02, 90008) ZVERS, ZVERSD 01230912 ! 127: WRITE (I02, 90009) ZPROG, ZPROG 01240912 ! 128: WRITE (I02, 90010) ZDATE, ZCOMPL 01250912 ! 129: CBE** ********************** BBCHED0A **********************************01260912 ! 130: WRITE(NUVI,41200) 01270912 ! 131: 41200 FORMAT( 1H ,/45H DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE/ 01280912 ! 132: 1 42H WITH OPTION TO OPEN AS A SEQUENTIAL FILE/ 01290912 ! 133: 2 17H ANS REF. - 12.5) 01300912 ! 134: CBB** ********************** BBCHED0B **********************************01310912 ! 135: C**** WRITE DETAIL REPORT HEADERS 01320912 ! 136: C**** 01330912 ! 137: WRITE (I02,90004) 01340912 ! 138: WRITE (I02,90004) 01350912 ! 139: WRITE (I02,90013) 01360912 ! 140: WRITE (I02,90014) 01370912 ! 141: WRITE (I02,90015) IVTOTL 01380912 ! 142: CBE** ********************** BBCHED0B **********************************01390912 ! 143: C***** 01400912 ! 144: C***** PLUS OR MINUS VALUES 01410912 ! 145: C***** 01420912 ! 146: CVS = 0.0001 01430912 ! 147: CVD = 0.0001D0 01440912 ! 148: C***** 01450912 ! 149: C***** INITIALIZE DATA ARRAYS 01460912 ! 150: C***** 01470912 ! 151: CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K) 01480912 ! 152: C***** 01490912 ! 153: C***** OPEN DIRECT ACCESS FILE - STATUS=NEW 01500912 ! 154: C***** 01510912 ! 155: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120, 01520912 ! 156: 1 FORM='FORMATTED',STATUS='NEW') 01530912 ! 157: C***** 01540912 ! 158: CT001* TEST 1 - CHECKS RECL AND NEXTREC 01550912 ! 159: C***** FOR JUST OPENED DIRECT ACCESS FILE 01560912 ! 160: C***** 01570912 ! 161: IVTNUM=1 01580912 ! 162: INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 01590912 ! 163: IF (IVI .NE. 120) GO TO 33020 01600912 ! 164: IF (KVI .NE. 1) GO TO 33020 01610912 ! 165: WRITE(NUVI,80002)IVTNUM 01620912 ! 166: IVPASS=IVPASS+1 01630912 ! 167: GO TO 33030 01640912 ! 168: 33020 REMK='ERROR IN INQUIRE' 01650912 ! 169: WRITE(NUVI,55010)IVTNUM,REMK 01660912 ! 170: 55010 FORMAT(1H ,5HTEST ,I3,1X,5H FAIL,34X,A31) 01670912 ! 171: IVFAIL=IVFAIL+1 01680912 ! 172: WRITE(NUVI,55020)IVI,KVI 01690912 ! 173: 55020 FORMAT(1H ,/,11X,16HCOMPUTED: RECL=,I6,5X,8HNEXTREC=,I6) 01700912 ! 174: WRITE(NUVI,55030) 01710912 ! 175: 55030 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 1/) 01720912 ! 176: C***** 01730912 ! 177: CT002* TEST 2 - WRITES RECORD 1 01740912 ! 178: C***** 01750912 ! 179: 33030 IVTNUM=2 01760912 ! 180: IVI = 1 01770912 ! 181: AVS = F1S (IVI) 01780912 ! 182: BVS = F1S(IVI + 1) 01790912 ! 183: A20VK = A201K (IVI) 01800912 ! 184: AVB = C1B (IVI) 01810912 ! 185: AVD = D1D (IVI) 01820912 ! 186: WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD, 01830912 ! 187: 1 AVB, A20VK 01840912 ! 188: 41204 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD') 01850912 ! 189: WRITE(NUVI,80002)IVTNUM 01860912 ! 190: IVPASS=IVPASS+1 01870912 ! 191: GO TO 33050 01880912 ! 192: 33040 WRITE(NUVI,55010)IVTNUM,REMK1 01890912 ! 193: IVFAIL=IVFAIL+1 01900912 ! 194: C***** 01910912 ! 195: CT003* TEST 3 - WRITES RECORD 2 01920912 ! 196: C***** 01930912 ! 197: 33050 IVTNUM=3 01940912 ! 198: IVI = IVI + 1 01950912 ! 199: AVS = F1S (IVI) 01960912 ! 200: BVS = F1S(IVI + 1) 01970912 ! 201: A20VK = A201K (IVI) 01980912 ! 202: AVB = C1B (IVI) 01990912 ! 203: AVD = D1D (IVI) 02000912 ! 204: WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS, 02010912 ! 205: 1 AVB, A20VK 02020912 ! 206: 41205 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD') 02030912 ! 207: WRITE(NUVI,80002)IVTNUM 02040912 ! 208: IVPASS=IVPASS+1 02050912 ! 209: GO TO 33070 02060912 ! 210: 33060 WRITE(NUVI,55010)IVTNUM,REMK2 02070912 ! 211: IVFAIL=IVFAIL+1 02080912 ! 212: C***** 02090912 ! 213: CT004* TEST 4 - WRITES RECORD 3 02100912 ! 214: C***** 02110912 ! 215: 33070 IVTNUM=4 02120912 ! 216: IVI = IVI + 1 02130912 ! 217: AVS = F1S (IVI) 02140912 ! 218: BVS = F1S(IVI + 1) 02150912 ! 219: A20VK = A201K (IVI) 02160912 ! 220: AVB = C1B (IVI) 02170912 ! 221: AVD = D1D (IVI) 02180912 ! 222: WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD, 02190912 ! 223: 1 AVB, A20VK 02200912 ! 224: 41206 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC') 02210912 ! 225: WRITE(NUVI,80002)IVTNUM 02220912 ! 226: IVPASS=IVPASS+1 02230912 ! 227: GO TO 33090 02240912 ! 228: 02250912 ! 229: 33080 WRITE(NUVI,55010)IVTNUM,REMK3 02260912 ! 230: IVFAIL=IVFAIL+1 02270912 ! 231: C***** 02280912 ! 232: CT005* TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE 02290912 ! 233: C***** 02300912 ! 234: 33090 IVTNUM=5 02310912 ! 235: IVI = IVI + 1 02320912 ! 236: AVS = F1S (IVI) 02330912 ! 237: BVS = F1S(IVI + 1) 02340912 ! 238: A20VK = A201K (IVI) 02350912 ! 239: AVB = C1B (IVI) 02360912 ! 240: AVD = D1D (IVI) 02370912 ! 241: WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB, 02380912 ! 242: 1 A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK 02390912 ! 243: 41207 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/ 02400912 ! 244: 1 E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END') 02410912 ! 245: WRITE(NUVI,80002)IVTNUM 02420912 ! 246: IVPASS=IVPASS+1 02430912 ! 247: GO TO 33290 02440912 ! 248: 33100 WRITE(NUVI,55010)IVTNUM,REMK45 02450912 ! 249: IVFAIL=IVFAIL+1 02460912 ! 250: C***** 02470912 ! 251: CT006* TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE 02480912 ! 252: C***** 02490912 ! 253: 33290 IVTNUM=6 02500912 ! 254: INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 02510912 ! 255: IF (IVI .NE. 120)GO TO 33300 02520912 ! 256: IF(KVI .NE. 6)GO TO 33300 02530912 ! 257: WRITE(NUVI,80002)IVTNUM 02540912 ! 258: IVPASS=IVPASS+1 02550912 ! 259: GO TO 33110 02560912 ! 260: 33300 REMK='ERROR IN INQUIRE' 02570912 ! 261: WRITE(NUVI,55010)IVTNUM,REMK 02580912 ! 262: IVFAIL=IVFAIL+1 02590912 ! 263: WRITE(NUVI,55020)IVI,KVI 02600912 ! 264: WRITE(NUVI,55040) 02610912 ! 265: 55040 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 6/) 02620912 ! 266: C***** 02630912 ! 267: CT007* TEST 7 - READS RECORD 1 02640912 ! 268: C***** 02650912 ! 269: 33110 IVTNUM=7 02660912 ! 270: IVI = 1 02670912 ! 271: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD, 02680912 ! 272: 1 AVB, A20VK, A47VK 02690912 ! 273: 41210 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47) 02700912 ! 274: ISWT=1 02710912 ! 275: GO TO 33220 02720912 ! 276: 02730912 ! 277: 33120 WRITE(NUVI,55010)IVTNUM,REMK1 02740912 ! 278: IVFAIL=IVFAIL+1 02750912 ! 279: C***** 02760912 ! 280: CT008* TEST 8 - READS RECORD 2 02770912 ! 281: C***** 02780912 ! 282: 33130 IVTNUM=8 02790912 ! 283: IVI = 2 02800912 ! 284: READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS, 02810912 ! 285: 1 AVB, A20VK, A51VK 02820912 ! 286: 41238 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51) 02830912 ! 287: ISWT=2 02840912 ! 288: GO TO 33230 02850912 ! 289: 02860912 ! 290: 33140 WRITE(NUVI,55010)IVTNUM,REMK2 02870912 ! 291: IVFAIL=IVFAIL+1 02880912 ! 292: C***** 02890912 ! 293: CT009* TEST 9 - READS RECORD 3 02900912 ! 294: C***** 02910912 ! 295: 33150 IVTNUM=9 02920912 ! 296: IVI = 3 02930912 ! 297: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD, 02940912 ! 298: 1 BVB, B20VK, B47VK 02950912 ! 299: ISWT=3 02960912 ! 300: GO TO 33240 02970912 ! 301: 02980912 ! 302: 33160 WRITE(NUVI,55010)IVTNUM,REMK3 02990912 ! 303: IVFAIL=IVFAIL+1 03000912 ! 304: C***** 03010912 ! 305: CT010* TEST 10 - READS RECORD 4 03020912 ! 306: C***** 03030912 ! 307: 33170 IVTNUM=10 03040912 ! 308: IVI = 4 03050912 ! 309: READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB, 03060912 ! 310: 1 C20VK, FVS, C47VK 03070912 ! 311: 41241 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47) 03080912 ! 312: ISWT=4 03090912 ! 313: GO TO 33250 03100912 ! 314: 03110912 ! 315: 33180 WRITE(NUVI,55010)IVTNUM,REMK4 03120912 ! 316: IVFAIL=IVFAIL+1 03130912 ! 317: C***** 03140912 ! 318: CT011* TEST 11 - READS RECORD 5 03150912 ! 319: C***** 03160912 ! 320: 33190 IVTNUM=11 03170912 ! 321: IVI = 5 03180912 ! 322: JVI = 4 03190912 ! 323: READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI, 03200912 ! 324: 1 AVS, A20VK, A51VK 03210912 ! 325: 41218 FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51) 03220912 ! 326: ISWT=5 03230912 ! 327: GO TO 33260 03240912 ! 328: 03250912 ! 329: 33200 WRITE(NUVI,55010)IVTNUM,REMK5 03260912 ! 330: IVFAIL=IVFAIL+1 03270912 ! 331: C***** 03280912 ! 332: CT012* TEST 12 - OVERWRITES RECORD 3 03290912 ! 333: C***** 03300912 ! 334: 33210 IVTNUM=12 03310912 ! 335: IVI = 3 03320912 ! 336: AVS = G1S (IVI) 03330912 ! 337: BVS = G1S(IVI + 1) 03340912 ! 338: A20VK = B201K (IVI) 03350912 ! 339: AVB = D1B (IVI) 03360912 ! 340: AVD = B1D (IVI) 03370912 ! 341: WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD, 03380912 ! 342: 1 A20VK, AVB 03390912 ! 343: 41251 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW RECORD ') 03400912 ! 344: WRITE(NUVI,80002)IVTNUM 03410912 ! 345: IVPASS=IVPASS+1 03420912 ! 346: GO TO 33320 03430912 ! 347: 03440912 ! 348: 33310 WRITE(NUVI,55010)IVTNUM,REMK3 03450912 ! 349: IVFAIL=IVFAIL+1 03460912 ! 350: C***** 03470912 ! 351: CT013* TEST 13 - OVERWRITES RECORD 5 03480912 ! 352: C***** 03490912 ! 353: 33320 IVTNUM=13 03500912 ! 354: IVI = 5 03510912 ! 355: AVS = G1S (IVI) 03520912 ! 356: BVS = G1S(IVI - 1) 03530912 ! 357: A20VK = B201K (IVI) 03540912 ! 358: AVB = D1B (IVI) 03550912 ! 359: AVD = B1D (IVI) 03560912 ! 360: WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,03570912 ! 361: 1 BVS, AVB 03580912 ! 362: 41252 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP RECORD') 03590912 ! 363: WRITE(NUVI,80002)IVTNUM 03600912 ! 364: IVPASS=IVPASS+1 03610912 ! 365: GO TO 33340 03620912 ! 366: 03630912 ! 367: 33330 WRITE(NUVI,55010)IVTNUM,REMK5 03640912 ! 368: IVFAIL=IVFAIL+1 03650912 ! 369: C***** 03660912 ! 370: C***** CLOSE AND REOPEN DIRECT ACCESS FILE 03670912 ! 371: C***** 03680912 ! 372: 33340 CLOSE(UNIT=KUVI) 03690912 ! 373: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 03700912 ! 374: 1 FORM='FORMATTED',RECL=120) 03710912 ! 375: C***** 03720912 ! 376: CT014* TEST 14 - READS RECORD 4 03730912 ! 377: C***** 03740912 ! 378: IVTNUM=14 03750912 ! 379: IVI = 4 03760912 ! 380: READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB, 03770912 ! 381: 1 C20VK, FVS, C47VK 03780912 ! 382: ISWT=6 03790912 ! 383: GO TO 33250 03800912 ! 384: 03810912 ! 385: 33350 WRITE(NUVI,55010)IVTNUM,REMK4 03820912 ! 386: IVFAIL=IVFAIL+1 03830912 ! 387: C***** 03840912 ! 388: CT015* TEST 15 - READS THE CHANGED RECORD 5 03850912 ! 389: C***** 03860912 ! 390: 33360 IVTNUM=15 03870912 ! 391: IVI = 5 03880912 ! 392: READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK, 03890912 ! 393: 1 AVD, BVS, AVB, A47VK03900912 ! 394: 41254 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47) 03910912 ! 395: ISWT=7 03920912 ! 396: IF (KVI .NE. IVI) GOTO 41221 03930912 ! 397: IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122303940912 ! 398: IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 4122503950912 ! 399: IF (A20VK .NE. B201K(IVI)) GOTO 41229 03960912 ! 400: IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 03970912 ! 401: 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 03980912 ! 402: IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122703990912 ! 403: IF (A47VK .NE. 04000912 ! 404: 1 ' STOP RECORD') GOTO 41231 04010912 ! 405: WRITE(NUVI,80002)IVTNUM 04020912 ! 406: IVPASS=IVPASS+1 04030912 ! 407: GO TO 33380 04040912 ! 408: 33370 WRITE(NUVI,55010)IVTNUM,REMK5 04050912 ! 409: IVFAIL=IVFAIL+1 04060912 ! 410: C***** 04070912 ! 411: CT016* TEST 16 - READS RECORD 2 04080912 ! 412: C***** 04090912 ! 413: 33380 IVTNUM=16 04100912 ! 414: IVI = 2 04110912 ! 415: READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS, 04120912 ! 416: 1 AVB, A20VK, A51VK 04130912 ! 417: ISWT=8 04140912 ! 418: GO TO 33230 04150912 ! 419: 04160912 ! 420: 33390 WRITE(NUVI,55010)IVTNUM,REMK2 04170912 ! 421: IVFAIL=IVFAIL+1 04180912 ! 422: C***** 04190912 ! 423: CT017* TEST 17 - READS THE CHANGED RECORD 3 04200912 ! 424: C***** 04210912 ! 425: 33400 IVTNUM=17 04220912 ! 426: IVI = 3 04230912 ! 427: READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD, 04240912 ! 428: 1 A20VK, AVB, A47VK 04250912 ! 429: 41256 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47) 04260912 ! 430: ISWT=9 04270912 ! 431: IF (KVI .NE. IVI) GOTO 41221 04280912 ! 432: IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122304290912 ! 433: IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 4122504300912 ! 434: IF (A20VK .NE. B201K(IVI)) GOTO 41229 04310912 ! 435: IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 04320912 ! 436: 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 04330912 ! 437: IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122704340912 ! 438: IF (A47VK .NE. 04350912 ! 439: 1 ' NEW RECORD ') GOTO 41231 04360912 ! 440: WRITE(NUVI,80002)IVTNUM 04370912 ! 441: IVPASS=IVPASS+1 04380912 ! 442: GO TO 33420 04390912 ! 443: 04400912 ! 444: 33410 WRITE(NUVI,55010)IVTNUM,REMK3 04410912 ! 445: IVFAIL=IVFAIL+1 04420912 ! 446: C***** 04430912 ! 447: CT018* TEST 18 - READS RECORD 1 04440912 ! 448: C***** 04450912 ! 449: 33420 IVTNUM=18 04460912 ! 450: IVI = 1 04470912 ! 451: READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD, 04480912 ! 452: 1 AVB, A20VK, A47VK 04490912 ! 453: ISWT=10 04500912 ! 454: GO TO 33220 04510912 ! 455: 04520912 ! 456: 33430 WRITE(NUVI,55010)IVTNUM,REMK1 04530912 ! 457: IVFAIL=IVFAIL+1 04540912 ! 458: C***** 04550912 ! 459: CT019* TEST 19 - OVERWRITES RECORD 4 04560912 ! 460: C***** 04570912 ! 461: 33440 IVTNUM=19 04580912 ! 462: 41258 IVI = 4 04590912 ! 463: KVI = IVI + 1 04600912 ! 464: AVS = F1S (IVI) 04610912 ! 465: BVS = F1S(IVI + 1) 04620912 ! 466: EVS = F1S(IVI) + 2.34 04630912 ! 467: AVD = D1D (IVI) 04640912 ! 468: WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS, 04650912 ! 469: 1 EVS, AVD 04660912 ! 470: 41259 FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8) 04670912 ! 471: WRITE(NUVI,80002)IVTNUM 04680912 ! 472: IVPASS=IVPASS+1 04690912 ! 473: GO TO 33460 04700912 ! 474: 04710912 ! 475: 33450 WRITE(NUVI,55010)IVTNUM,REMK4 04720912 ! 476: IVFAIL=IVFAIL+1 04730912 ! 477: C***** 04740912 ! 478: CT020* TEST 20 - OVERWRITES RECORDS 1, 2, AND 3 04750912 ! 479: C***** 04760912 ! 480: 33460 IVTNUM=20 04770912 ! 481: IVI = 1 04780912 ! 482: A1VK = 'A' 04790912 ! 483: A4VK = A201K (IVI) (1:4) 04800912 ! 484: AVB = C1B (IVI) 04810912 ! 485: AVD = D1D (IVI) 04820912 ! 486: BVD = D1D (IVI) + 3.234D2 04830912 ! 487: WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK, 04840912 ! 488: 1 A4VK 04850912 ! 489: 41260 FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//, 04860912 ! 490: 1 10HHOLLERITH , T15, 'ONE', 10X, TL5, 'TWO', TR5, 04870912 ! 491: 2 'THREE', :, 'LAST') 04880912 ! 492: WRITE(NUVI,80002)IVTNUM 04890912 ! 493: IVPASS=IVPASS+1 04900912 ! 494: GO TO 33480 04910912 ! 495: 04920912 ! 496: 33470 WRITE(NUVI,55010)IVTNUM,REMK1 04930912 ! 497: IVFAIL=IVFAIL+1 04940912 ! 498: C***** 04950912 ! 499: CT021* TEST 21 - OVERWRITES RECORD 5 04960912 ! 500: C***** 04970912 ! 501: 33480 IVTNUM=21 04980912 ! 502: IVI = 5 04990912 ! 503: BVS = F1S(IVI - 1) 05000912 ! 504: AVD = B1D (4) 05010912 ! 505: WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD 05020912 ! 506: 41261 FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2) 05030912 ! 507: WRITE(NUVI,80002)IVTNUM 05040912 ! 508: IVPASS=IVPASS+1 05050912 ! 509: GO TO 33500 05060912 ! 510: 05070912 ! 511: 33490 WRITE(NUVI,55010)IVTNUM,REMK5 05080912 ! 512: IVFAIL=IVFAIL+1 05090912 ! 513: C***** 05100912 ! 514: C***** CLOSE AND REOPEN DIRECT ACCESS FILE 05110912 ! 515: C***** 05120912 ! 516: 33500 CLOSE(UNIT=KUVI) 05130912 ! 517: OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 05140912 ! 518: 1 FORM='FORMATTED',RECL=120) 05150912 ! 519: C***** 05160912 ! 520: CT022* TEST 22 - READS RECORD 1 05170912 ! 521: C***** 05180912 ! 522: IVTNUM=22 05190912 ! 523: IVI = 1 05200912 ! 524: READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB, 05210912 ! 525: 1 A1VK, A4VK, A12VK 05220912 ! 526: 41262 FORMAT(G14.8, A20, L2, A, A4, A12) 05230912 ! 527: ISWT=1 05240912 ! 528: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4127705250912 ! 529: IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279 05260912 ! 530: IF ((A1VK .NE. 'A') .OR. 05270912 ! 531: 1 (A4VK .NE. A201K(IVI)(1:4)) .OR. 05280912 ! 532: 2 (A12VK .NE. 'TSAL DROCER')) GOTO 41279 05290*TI ! 533: WRITE(NUVI,80002)IVTNUM 05300912 ! 534: IVPASS=IVPASS+1 05310912 ! 535: GO TO 33520 05320912 ! 536: 05330912 ! 537: 33510 WRITE(NUVI,55010)IVTNUM,REMK1 05340912 ! 538: IVFAIL=IVFAIL+1 05350912 ! 539: C***** RECORD # 4 05360912 ! 540: CT023* TEST 23 - READS RECORD 4 05370912 ! 541: C***** 05380912 ! 542: 33520 IVTNUM=23 05390912 ! 543: IVI = 4 05400912 ! 544: READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS, 05410912 ! 545: 1 BVS, B20VK, AVD 05420912 ! 546: 41266 FORMAT(I5, A5, F10.5, E14.6, A20, D14.8) 05430912 ! 547: ISWT=2 05440912 ! 548: IF (A20VK(3:5) .NE. '005') GOTO 41293 05450912 ! 549: IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR. 05460912 ! 550: 1 (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR. 05470912 ! 551: 2 (B20VK(13:20) .NE. '.6E+0001')) GOTO 41293 05480*TI ! 552: WRITE(NUVI,80002)IVTNUM 05490912 ! 553: IVPASS=IVPASS+1 05500912 ! 554: GO TO 33540 05510912 ! 555: 05520912 ! 556: 33530 WRITE(NUVI,55010)IVTNUM,REMK4 05530912 ! 557: IVFAIL=IVFAIL+1 05540912 ! 558: C***** 05550912 ! 559: CT024* TEST 24 - READS RECORD 2 TESTS FOR BLANK RECORD 05560912 ! 560: C***** 05570912 ! 561: 33540 IVTNUM=24 05580912 ! 562: B120VK = ' ' 05590912 ! 563: IVI = 2 05600912 ! 564: READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK 05610912 ! 565: 41269 FORMAT(A120) 05620912 ! 566: ISWT=3 05630912 ! 567: IF (A120VK .NE. B120VK) GOTO 41281 05640912 ! 568: WRITE(NUVI,80002)IVTNUM 05650912 ! 569: IVPASS=IVPASS+1 05660912 ! 570: GO TO 33560 05670912 ! 571: 05680912 ! 572: 33550 WRITE(NUVI,55010)IVTNUM,REMK2 05690912 ! 573: IVFAIL=IVFAIL+1 05700912 ! 574: C***** 05710912 ! 575: CT025* TEST 25 - READS RECORD 5 05720912 ! 576: C***** 05730912 ! 577: 33560 IVTNUM=25 05740912 ! 578: IVI = 5 05750912 ! 579: READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS, 05760912 ! 580: 1 B20VK, C20VK 05770912 ! 581: 41271 FORMAT(A5, F10.5, BZ, A5, BN, A20) 05780912 ! 582: ISWT=4 05790912 ! 583: IF (A20VK(1:5) .NE. ' +5') GOTO 41283 05800912 ! 584: IF (B20VK(1:5) .NE. ' 5') GOTO 41285 05810912 ! 585: IF (C20VK(1:14) .NE. ' 625.0000E-03') GOTO 41287 05820912 ! 586: WRITE(NUVI,80002)IVTNUM 05830912 ! 587: IVPASS=IVPASS+1 05840912 ! 588: GO TO 33580 05850912 ! 589: 05860912 ! 590: 33570 WRITE(NUVI,55010)IVTNUM,REMK5 05870912 ! 591: IVFAIL=IVFAIL+1 05880912 ! 592: C***** 05890912 ! 593: CT026* TEST 26 - READS RECORD 3 05900912 ! 594: C***** 05910912 ! 595: 33580 IVTNUM=26 05920912 ! 596: IVI = 3 05930912 ! 597: READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK 05940912 ! 598: 41275 FORMAT(A120) 05950912 ! 599: ISWT=5 05960912 ! 600: IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289 05970912 ! 601: IF (A120VK(11:40) .NE. 05980912 ! 602: 1 ' ONE TWO THREE ') GOTO 41291 05990912 ! 603: WRITE(NUVI,80002)IVTNUM 06000912 ! 604: IVPASS=IVPASS+1 06010912 ! 605: GO TO 33600 06020912 ! 606: 06030912 ! 607: 33590 WRITE(NUVI,55010)IVTNUM,REMK3 06040912 ! 608: IVFAIL=IVFAIL+1 06050912 ! 609: C***** 06060912 ! 610: C***** CLOSE DIRECT ACCESS FILE 06070912 ! 611: C***** 06080912 ! 612: 33600 CLOSE(UNIT=KUVI,STATUS='DELETE') 06090912 ! 613: GO TO 33610 06100912 ! 614: C***** 06110912 ! 615: C***** CHECKING RECORD 1 06120912 ! 616: C***** 06130912 ! 617: 33220 IF (KVI .NE. IVI) GOTO 41221 06140912 ! 618: IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306150912 ! 619: IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506160912 ! 620: IF (A20VK .NE. A201K(IVI)) GOTO 41229 06170912 ! 621: IF (A47VK .NE. 06180912 ! 622: 1 ' LAST RECORD') GOTO 41231 06190912 ! 623: IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06200912 ! 624: 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06210912 ! 625: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706220912 ! 626: WRITE(NUVI,80002)IVTNUM 06230912 ! 627: IVPASS=IVPASS+1 06240912 ! 628: IF (ISWT .EQ. 10)GO TO 33440 06250912 ! 629: GO TO 33130 06260912 ! 630: 06270912 ! 631: 41221 WRITE(NUVI,41222)IVTNUM,IVI 06280912 ! 632: IVFAIL=IVFAIL+1 06290912 ! 633: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06300912 ! 634: 1 33420,33440)ISWT 06310912 ! 635: 06320912 ! 636: 41223 WRITE(NUVI,41224)IVTNUM,IVI 06330912 ! 637: IVFAIL=IVFAIL+1 06340912 ! 638: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06350912 ! 639: 1 33420,33440)ISWT 06360912 ! 640: 06370912 ! 641: 41225 WRITE(NUVI,41226)IVTNUM,IVI 06380912 ! 642: IVFAIL=IVFAIL+1 06390912 ! 643: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06400912 ! 644: 1 33420,33440)ISWT 06410912 ! 645: 06420912 ! 646: 41227 WRITE(NUVI,41228)IVTNUM,IVI 06430912 ! 647: IVFAIL=IVFAIL+1 06440912 ! 648: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06450912 ! 649: 1 33420,33440)ISWT 06460912 ! 650: 06470912 ! 651: 41229 WRITE(NUVI,41230)IVTNUM,IVI 06480912 ! 652: IVFAIL=IVFAIL+1 06490912 ! 653: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06500912 ! 654: 1 33420,33440)ISWT 06510912 ! 655: 06520912 ! 656: 41231 WRITE(NUVI,41232)IVTNUM,IVI 06530912 ! 657: IVFAIL=IVFAIL+1 06540912 ! 658: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06550912 ! 659: 1 33420,33440)ISWT 06560912 ! 660: 06570912 ! 661: 41233 WRITE(NUVI,41234)IVTNUM,IVI 06580912 ! 662: IVFAIL=IVFAIL+1 06590912 ! 663: GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06600912 ! 664: 1 33420,33440)ISWT 06610912 ! 665: C***** 06620912 ! 666: C***** CHECKING RECORD 2 06630912 ! 667: C***** 06640912 ! 668: 33230 IF (KVI .NE. IVI) GOTO 41221 06650912 ! 669: IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306660912 ! 670: IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506670912 ! 671: IF (A20VK .NE. A201K(IVI)) GOTO 41229 06680912 ! 672: IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06690912 ! 673: 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06700912 ! 674: IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706710912 ! 675: IF (A51VK .NE. 06720912 ! 676: 1 ' LASTS RECORD ')GOTO 41231 06730912 ! 677: WRITE(NUVI,80002)IVTNUM 06740912 ! 678: IVPASS=IVPASS+1 06750912 ! 679: IF (ISWT .EQ. 8)GO TO 33400 06760912 ! 680: GO TO 33150 06770912 ! 681: C***** 06780912 ! 682: C***** CHECKING RECORD 3 06790912 ! 683: C***** 06800912 ! 684: 33240 IF (LVI .NE. IVI) GOTO 41221 06810912 ! 685: IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 4122306820912 ! 686: IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 4122506830912 ! 687: IF (B20VK .NE. A201K(IVI)) GOTO 41229 06840912 ! 688: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 06850912 ! 689: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 41233 06860912 ! 690: IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 4122706870912 ! 691: IF (B47VK .NE. 06880912 ! 692: 1 ' THE LAST REC ') GOTO 41231 06890912 ! 693: WRITE(NUVI,80002)IVTNUM 06900912 ! 694: IVPASS=IVPASS+1 06910912 ! 695: GO TO 33170 06920912 ! 696: C***** 06930912 ! 697: C***** CHECKING RECORD 4 06940912 ! 698: C***** 06950912 ! 699: 33250 IF (NVI .NE. IVI) GOTO 41221 06960912 ! 700: IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 4122306970912 ! 701: IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 4122506980912 ! 702: IF (C20VK .NE. A201K(IVI)) GOTO 41229 06990912 ! 703: IF ((CVB .AND. .NOT. C1B(IVI)) .OR. 07000912 ! 704: 1 (.NOT. CVB .AND. C1B(IVI))) GOTO 41233 07010912 ! 705: IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 4122707020912 ! 706: IF (C47VK .NE. 07030912 ! 707: 1 ' NEXT TO LAST') GOTO 41231 07040912 ! 708: WRITE(NUVI,80002)IVTNUM 07050912 ! 709: IVPASS=IVPASS+1 07060912 ! 710: IF (ISWT .EQ. 6)GO TO 33360 07070912 ! 711: GO TO 33190 07080912 ! 712: C***** 07090912 ! 713: C***** CHECKING RECORD 5 07100912 ! 714: C***** 07110912 ! 715: 33260 IF (KVI .NE. JVI) GOTO 41221 07120912 ! 716: IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 4122307130912 ! 717: IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 4122507140912 ! 718: IF (A20VK .NE. A201K(JVI)) GOTO 41229 07150912 ! 719: IF ((AVB .AND. .NOT. C1B(JVI)) .OR. 07160912 ! 720: 1 (.NOT. AVB .AND. C1B(JVI))) GOTO 41233 07170912 ! 721: IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 4122707180912 ! 722: IF (A51VK .NE. 07190912 ! 723: 1 ' THE END ') GOTO 4123107200912 ! 724: WRITE(NUVI,80002)IVTNUM 07210912 ! 725: IVPASS=IVPASS+1 07220912 ! 726: GO TO 33210 07230912 ! 727: C***** 07240912 ! 728: C***** 07250912 ! 729: C***** 07260912 ! 730: 41277 WRITE(NUVI,41278)IVTNUM,IVI 07270912 ! 731: IVFAIL=IVFAIL+1 07280912 ! 732: GO TO(33520,33540,33560,33580,33600)ISWT 07290912 ! 733: 07300912 ! 734: 41279 WRITE(NUVI,41280)IVTNUM,IVI 07310912 ! 735: IVFAIL=IVFAIL+1 07320912 ! 736: GO TO(33520,33540,33560,33580,33600)ISWT 07330912 ! 737: 07340912 ! 738: 41281 WRITE(NUVI,41282)IVTNUM,IVI 07350912 ! 739: IVFAIL=IVFAIL+1 07360912 ! 740: GO TO(33520,33540,33560,33580,33600)ISWT 07370912 ! 741: 07380912 ! 742: 41283 WRITE(NUVI,41284)IVTNUM,IVI 07390912 ! 743: IVFAIL=IVFAIL+1 07400912 ! 744: GO TO(33520,33540,33560,33580,33600)ISWT 07410912 ! 745: 07420912 ! 746: 41285 WRITE(NUVI,41286)IVTNUM,IVI 07430912 ! 747: IVFAIL=IVFAIL+1 07440912 ! 748: GO TO(33520,33540,33560,33580,33600)ISWT 07450912 ! 749: 07460912 ! 750: 41287 WRITE(NUVI,41288)IVTNUM,IVI 07470912 ! 751: IVFAIL=IVFAIL+1 07480912 ! 752: GO TO(33520,33540,33560,33580,33600)ISWT 07490912 ! 753: 07500912 ! 754: 41289 WRITE(NUVI,41290)IVTNUM,IVI 07510912 ! 755: IVFAIL=IVFAIL+1 07520912 ! 756: GO TO(33520,33540,33560,33580,33600)ISWT 07530912 ! 757: 07540912 ! 758: 41291 WRITE(NUVI,41292)IVTNUM,IVI 07550912 ! 759: IVFAIL=IVFAIL+1 07560912 ! 760: GO TO(33520,33540,33560,33580,33600)ISWT 07570912 ! 761: 07580912 ! 762: 41293 WRITE(NUVI,41294)IVTNUM,IVI 07590912 ! 763: IVFAIL=IVFAIL+1 07600912 ! 764: GO TO(33520,33540,33560,33580,33600)ISWT 07610912 ! 765: C***** 07620912 ! 766: C***** 07630912 ! 767: C***** 07640912 ! 768: 41222 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07650912 ! 769: 1 14H - ON I FORMAT) 07660912 ! 770: 41224 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07670912 ! 771: 1 14H - ON F FORMAT) 07680912 ! 772: 41226 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07690912 ! 773: 1 14H - ON E FORMAT) 07700912 ! 774: 41228 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07710912 ! 775: 1 14H - ON D FORMAT) 07720912 ! 776: 41230 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07730912 ! 777: 1 14H - ON A FORMAT) 07740912 ! 778: 41232 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07750912 ! 779: 1 20H - ON X AND ' FORMAT) 07760912 ! 780: 41234 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07770912 ! 781: 1 14H - ON L FORMAT) 07780912 ! 782: 41278 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07790912 ! 783: 1 17H - ON GW.D FORMAT) 07800912 ! 784: 41280 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07810912 ! 785: 1 19H - ON GW.DEN FORMAT) 07820912 ! 786: 41282 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07830912 ! 787: 1 19H - ON BLANK RECORD ) 07840912 ! 788: 41284 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07850912 ! 789: 1 19H - ON SP FORMAT ) 07860912 ! 790: 41286 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07870912 ! 791: 1 21H - ON BZ OR SS FORMAT) 07880912 ! 792: 41288 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07890912 ! 793: 1 19H - ON NP FORMAT ) 07900912 ! 794: 41290 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07910912 ! 795: 1 19H - ON H FORMAT ) 07920912 ! 796: 41292 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07930912 ! 797: 1 23H - ON TR, TLC, T FORMAT) 07940912 ! 798: 41294 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2, 07950912 ! 799: 1 19H - ON IN.N FORMAT ) 07960912 ! 800: C***** 07970912 ! 801: C***** END OF TEST SEGMENT 412 07980912 ! 802: C***** 07990912 ! 803: 33610 CONTINUE 08000912 ! 804: CBB** ********************** BBCSUM0 **********************************08010912 ! 805: C**** WRITE OUT TEST SUMMARY 08020912 ! 806: C**** 08030912 ! 807: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08040912 ! 808: WRITE (I02, 90004) 08050912 ! 809: WRITE (I02, 90014) 08060912 ! 810: WRITE (I02, 90004) 08070912 ! 811: WRITE (I02, 90020) IVPASS 08080912 ! 812: WRITE (I02, 90022) IVFAIL 08090912 ! 813: WRITE (I02, 90024) IVDELE 08100912 ! 814: WRITE (I02, 90026) IVINSP 08110912 ! 815: WRITE (I02, 90028) IVTOTN, IVTOTL 08120912 ! 816: CBE** ********************** BBCSUM0 **********************************08130912 ! 817: CBB** ********************** BBCFOOT0 **********************************08140912 ! 818: C**** WRITE OUT REPORT FOOTINGS 08150912 ! 819: C**** 08160912 ! 820: WRITE (I02,90016) ZPROG, ZPROG 08170912 ! 821: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08180912 ! 822: WRITE (I02,90019) 08190912 ! 823: CBE** ********************** BBCFOOT0 **********************************08200912 ! 824: CBB** ********************** BBCFMT0A **********************************08210912 ! 825: C**** FORMATS FOR TEST DETAIL LINES 08220912 ! 826: C**** 08230912 ! 827: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 08240912 ! 828: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 08250912 ! 829: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 08260912 ! 830: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 08270912 ! 831: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 08280912 ! 832: 1I6,/,1H ,15X,10HCORRECT= ,I6) 08290912 ! 833: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08300912 ! 834: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 08310912 ! 835: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08320912 ! 836: 1A21,/,1H ,16X,10HCORRECT= ,A21) 08330912 ! 837: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 08340912 ! 838: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 08350912 ! 839: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 08360912 ! 840: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 08370912 ! 841: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 08380912 ! 842: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 08390912 ! 843: 80050 FORMAT (1H ,48X,A31) 08400912 ! 844: CBE** ********************** BBCFMT0A **********************************08410912 ! 845: CBB** ********************** BBCFMAT1 **********************************08420912 ! 846: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08430912 ! 847: C**** 08440912 ! 848: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08450912 ! 849: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 08460912 ! 850: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 08470912 ! 851: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 08480912 ! 852: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08490912 ! 853: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08500912 ! 854: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08510912 ! 855: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08520912 ! 856: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08530912 ! 857: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 08540912 ! 858: 21H(,F12.5,2H, ,F12.5,1H)) 08550912 ! 859: CBE** ********************** BBCFMAT1 **********************************08560912 ! 860: CBB** ********************** BBCFMT0B **********************************08570912 ! 861: C**** FORMAT STATEMENTS FOR PAGE HEADERS 08580912 ! 862: C**** 08590912 ! 863: 90002 FORMAT (1H1) 08600912 ! 864: 90004 FORMAT (1H ) 08610912 ! 865: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 08620912 ! 866: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08630912 ! 867: 90008 FORMAT (1H ,21X,A13,A17) 08640912 ! 868: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 08650912 ! 869: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 08660912 ! 870: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 08670912 ! 871: 1 7X,7HREMARKS,24X) 08680912 ! 872: 90014 FORMAT (1H ,46H----------------------------------------------, 08690912 ! 873: 1 33H---------------------------------) 08700912 ! 874: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 08710912 ! 875: C**** 08720912 ! 876: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08730912 ! 877: C**** 08740912 ! 878: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 08750912 ! 879: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 08760912 ! 880: 1 A13) 08770912 ! 881: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 08780912 ! 882: C**** 08790912 ! 883: C**** FORMAT STATEMENTS FOR RUN SUMMARY 08800912 ! 884: C**** 08810912 ! 885: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 08820912 ! 886: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 08830912 ! 887: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 08840912 ! 888: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 08850912 ! 889: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 08860912 ! 890: CBE** ********************** BBCFMT0B **********************************08870912 ! 891: STOP 08880912 ! 892: END 08890912 ! 893: C********************************************************************** 00010913 ! 894: C DATE***82/08/02*18.33.46 ! 895: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 896: C AUDIT FCVS78 V2.0 ! 897: C***** FORTRAN 77 00020913 ! 898: C***** FM913 00030913 ! 899: C***** SN913 FAQ - (807) 00040913 ! 900: C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913 ! 901: C********************************************************************** 00060913 ! 902: SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D, 00070913 ! 903: 1 A20W1K, B20W1K) 00080913 ! 904: C***** 00090913 ! 905: C***** SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES 00100913 ! 906: C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110913 ! 907: C***** 00120913 ! 908: REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5) 00130913 ! 909: LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5) 00140913 ! 910: DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5) 00150913 ! 911: CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5) 00160913 ! 912: DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/ 00170913 ! 913: DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/ 00180913 ! 914: DATA A20T1K / 'AAAALKJHGFASERTYUIOP', 'KDJFLKJEOITMNV E CJF', 00190913 ! 915: 1 'CDFEJHFKLM CNB FHGDC', 'LKJHNHBJMVK,FIJ NVHD', 00200913 ! 916: 2 'JHGFKDJJSLDKFJDKJFSL'/ 00210913 ! 917: DATA B20T1K / 'AAAALSDEFCASERTYUIOP', 'KDDFFEJEOITMNV E CJF', 00220913 ! 918: 1 'CDFEJHFKLM DHGDC', 'L...NHBJMVK,FIJ NVHD', 00230913 ! 919: 2 'LKJHDNMVHNEUYHBDGHCJ'/ 00240913 ! 920: DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./ 00250913 ! 921: DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./ 00260913 ! 922: DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/ 00270913 ! 923: DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/ 00280913 ! 924: C***** 00290913 ! 925: C***** 00300913 ! 926: C***** 00310913 ! 927: DO 1 IVI = 1, 5 00320913 ! 928: FW1S(IVI) = FT1S(IVI) 00330913 ! 929: GW1S(IVI) = GT1S(IVI) 00340913 ! 930: CW1B(IVI) = CT1B(IVI) 00350913 ! 931: DW1B(IVI) = DT1B(IVI) 00360913 ! 932: DW1D(IVI) = DT1D(IVI) 00370913 ! 933: BW1D(IVI) = BT1D(IVI) 00380913 ! 934: A20W1K(IVI) = A20T1K(IVI) 00390913 ! 935: B20W1K(IVI) = B20T1K(IVI) 00400913 ! 936: 1 CONTINUE 00410913 ! 937: C***** 00420913 ! 938: C***** 00430913 ! 939: C***** 00440913 ! 940: RETURN 00450913 ! 941: END 00460913
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.