|
|
1.1 ! root 1: C***********************************************************************00010908 ! 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 00020908 ! 6: C***** FM908 00030908 ! 7: C***** INTER3 - (392) 00040908 ! 8: C***** 00050908 ! 9: C***********************************************************************00060908 ! 10: C***** TESTING OF INTERNAL FILES - ANS. REF 00070908 ! 11: C***** USING READ 12.2.5 00080908 ! 12: C***** 00090908 ! 13: CBB** ********************** BBCCOMNT **********************************00100908 ! 14: C**** 00110908 ! 15: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120908 ! 16: C**** VERSION 2.0 00130908 ! 17: C**** 00140908 ! 18: C**** 00150908 ! 19: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160908 ! 20: C**** GENERAL SERVICES ADMINISTRATION 00170908 ! 21: C**** FEDERAL SOFTWARE TESTING CENTER 00180908 ! 22: C**** 5203 LEESBURG PIKE, SUITE 1100 00190908 ! 23: C**** FALLS CHURCH, VA. 22041 00200908 ! 24: C**** 00210908 ! 25: C**** (703) 756-6153 00220908 ! 26: C**** 00230908 ! 27: CBE** ********************** BBCCOMNT **********************************00240908 ! 28: C***** 00250908 ! 29: C***** S P E C I F I C A T I O N S SEGMENT 392 00260908 ! 30: C***** 00270908 ! 31: DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, DVCORR 00280908 ! 32: LOGICAL AVB 00290908 ! 33: CHARACTER*43 A43VK, D43VK, F43VK, G43VK, K43VK, N43VK 00300908 ! 34: CHARACTER A8VK*8, E51VK*51, L53VK*53, I82VK*82 00310908 ! 35: CHARACTER J97VK*97, C431K(2)*43, CVCORR*30 00320908 ! 36: CHARACTER*29 B291K(5), M291K(5), H131K(2)*13 00330908 ! 37: COMPLEX AVC, BVC, CVC, DVC, ZVCORR 00340908 ! 38: REAL R2E(8) 00350908 ! 39: EQUIVALENCE (R2E(1),AVC),(R2E(3),BVC),(R2E(5),CVC),(R2E(7),DVC) 00360908 ! 40: C***** 00370908 ! 41: CBB** ********************** BBCINITA **********************************00380908 ! 42: C**** SPECIFICATION STATEMENTS 00390908 ! 43: C**** 00400908 ! 44: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00410908 ! 45: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00420908 ! 46: CBE** ********************** BBCINITA **********************************00430908 ! 47: CBB** ********************** BBCINITB **********************************00440908 ! 48: C**** INITIALIZE SECTION 00450908 ! 49: DATA ZVERS, ZVERSD, ZDATE 00460908 ! 50: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00470908 ! 51: DATA ZCOMPL, ZNAME, ZTAPE 00480908 ! 52: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00490908 ! 53: DATA ZPROJ, ZTAPED, ZPROG 00500908 ! 54: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00510908 ! 55: DATA REMRKS /' '/ 00520908 ! 56: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00530908 ! 57: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00540908 ! 58: C**** 00550908 ! 59: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00560908 ! 60: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00570908 ! 61: CZ03 ZPROG = 'PROGRAM NAME' 00580908 ! 62: ZDATE = '07-Nov-85 ' *RP ! 63: ZCOMPL = 'CCI 5.2 ' *RP ! 64: ZPROJ = 'TC-85- -410' *RP ! 65: ZNAME = ' ' *RP ! 66: ZTAPE = ' ' *RP ! 67: ZTAPED = '850703 ' *RP ! 68: C 00650908 ! 69: IVPASS = 0 00660908 ! 70: IVFAIL = 0 00670908 ! 71: IVDELE = 0 00680908 ! 72: IVINSP = 0 00690908 ! 73: IVTOTL = 0 00700908 ! 74: IVTOTN = 0 00710908 ! 75: ICZERO = 0 00720908 ! 76: C 00730908 ! 77: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00740908 ! 78: I01 = 05 00750908 ! 79: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00760908 ! 80: I02 = 06 00770908 ! 81: C 00780908 ! 82: I01 = 5 00790908 ! 83: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00800908 ! 84: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00810908 ! 85: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00820908 ! 86: C 00830908 ! 87: I02 = 6 00840908 ! 88: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00850908 ! 89: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00860908 ! 90: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00870908 ! 91: C 00880908 ! 92: CBE** ********************** BBCINITB **********************************00890908 ! 93: NUVI = I02 00900908 ! 94: IVTOTL = 54 00910908 ! 95: ZPROG = 'FM908' 00920908 ! 96: CBB** ********************** BBCHED0A **********************************00930908 ! 97: C**** 00940908 ! 98: C**** WRITE REPORT TITLE 00950908 ! 99: C**** 00960908 ! 100: WRITE (I02, 90002) 00970908 ! 101: WRITE (I02, 90006) 00980908 ! 102: WRITE (I02, 90007) 00990908 ! 103: WRITE (I02, 90008) ZVERS, ZVERSD 01000908 ! 104: WRITE (I02, 90009) ZPROG, ZPROG 01010908 ! 105: WRITE (I02, 90010) ZDATE, ZCOMPL 01020908 ! 106: CBE** ********************** BBCHED0A **********************************01030908 ! 107: C***** 01040908 ! 108: C***** HEADER FOR SEGMENT 392 01050908 ! 109: C***** 01060908 ! 110: WRITE(NUVI,39200) 01070908 ! 111: 39200 FORMAT(1H ,/ 44H INTER3 - (392) INTERNAL FILES -- USING READ 01080908 ! 112: 1 //19H ANS. REF. - 12.2.5) 01090908 ! 113: CBB** ********************** BBCHED0B **********************************01100908 ! 114: C**** WRITE DETAIL REPORT HEADERS 01110908 ! 115: C**** 01120908 ! 116: WRITE (I02,90004) 01130908 ! 117: WRITE (I02,90004) 01140908 ! 118: WRITE (I02,90013) 01150908 ! 119: WRITE (I02,90014) 01160908 ! 120: WRITE (I02,90015) IVTOTL 01170908 ! 121: CBE** ********************** BBCHED0B **********************************01180908 ! 122: A43VK = ' 2.1000000D1 23.45600D3 23.450000000D2' 01190908 ! 123: D43VK = '34.58673D2 3458.67300 34.58673D2 3458.673 ' 01200908 ! 124: F43VK = 'T 10.98THISISIT 3.4945D2 3 ' 01210908 ! 125: G43VK = ' 2.343 34.394 ' 01220908 ! 126: K43VK = ' 0.934, 34.567 34.65 0.63540D1 ' 01230908 ! 127: N43VK = '34 34.98395.83000D2 F.FALSE.13.45300E+2 ' 01240908 ! 128: E51VK = ' 348 3.4783E1384.3847D1 T 3.48570 KDFJ D/.' 01250908 ! 129: L53VK = ' 0.345 ,3.4345E01,F, 34.85900D-1, 10.000012345678' 01260908 ! 130: I82VK = ' 2.34 , 2.456 2.34 , 2.456 0.234E01, 2.456E0001270908 ! 131: 1 0.234E+001, 2.456E-000' 01280908 ! 132: J97VK = ' 5.67980, 0.9876 5.67980, 0.9876 05.6798E001290908 ! 133: 10, 9.8760E-1 5.67980E0000,0.09876E+001' 01300908 ! 134: B291K(1) = '34.38457D1 34.38457D1 ' 01310908 ! 135: B291K(2) = '34.38457D1 ' 01320908 ! 136: B291K(3) = '34.38457D1 34.38457D1 ' 01330908 ! 137: B291K(4) = ' ' 01340908 ! 138: B291K(5) = '34.38457D1 ' 01350908 ! 139: M291K(1) = ' 98 ' 01360908 ! 140: M291K(2) = '8.40485D02 ' 01370908 ! 141: M291K(3) = ' ' 01380908 ! 142: M291K(4) = ' .TRUE. 340.435E-1, 3.494E+1' 01390908 ! 143: M291K(5) = '87654321 ' 01400908 ! 144: C431K(1) = ' 2.1000000D1 23.45600D3 23.450000000D2' 01410908 ! 145: C431K(2) = ' ' 01420908 ! 146: H131K(1) = '34.84' 01430908 ! 147: H131K(2) = '349.887' 01440908 ! 148: CT001* TEST 1 DOUBLE PRECISION FROM VARIABLE 01450908 ! 149: IVTNUM = 1 01460908 ! 150: READ(UNIT=A43VK,FMT=39201) AVD 01470908 ! 151: 39201 FORMAT(13X,D10.5) 01480908 ! 152: IF (AVD - 0.2345599998D+05) 20010, 10010, 40010 01490908 ! 153: 40010 IF (AVD - 0.2345600002D+05) 10010, 10010, 20010 01500908 ! 154: 10010 IVPASS = IVPASS + 1 01510908 ! 155: WRITE (NUVI, 80002) IVTNUM 01520908 ! 156: GO TO 0011 01530908 ! 157: 20010 IVFAIL = IVFAIL + 1 01540908 ! 158: DVCORR = 23.456D3 01550908 ! 159: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01560908 ! 160: 0011 CONTINUE 01570908 ! 161: CT002* TEST 2 FROM ELEMENT 01580908 ! 162: IVTNUM = 2 01590908 ! 163: READ(UNIT=C431K(1),FMT=39204) AVD 01600908 ! 164: 39204 FORMAT(D12.7) 01610908 ! 165: IF (AVD - 0.2099999999D+02) 20020, 10020, 40020 01620908 ! 166: 40020 IF (AVD - 0.2100000001D+02) 10020, 10020, 20020 01630908 ! 167: 10020 IVPASS = IVPASS + 1 01640908 ! 168: WRITE (NUVI, 80002) IVTNUM 01650908 ! 169: GO TO 0021 01660908 ! 170: 20020 IVFAIL = IVFAIL + 1 01670908 ! 171: DVCORR = 2.1D1 01680908 ! 172: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01690908 ! 173: 0021 CONTINUE 01700908 ! 174: CT003* TEST 3 FROM SUBSTRING 01710908 ! 175: IVTNUM = 3 01720908 ! 176: READ(UNIT=A43VK(19:),FMT=39206) AVD 01730908 ! 177: 39206 FORMAT(11X,D14.9) 01740908 ! 178: IF (AVD - 0.2344999998D+04) 20030, 10030, 40030 01750908 ! 179: 40030 IF (AVD - 0.2345000002D+04) 10030, 10030, 20030 01760908 ! 180: 10030 IVPASS = IVPASS + 1 01770908 ! 181: WRITE (NUVI, 80002) IVTNUM 01780908 ! 182: GO TO 0031 01790908 ! 183: 20030 IVFAIL = IVFAIL + 1 01800908 ! 184: DVCORR = 23.45D2 01810908 ! 185: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01820908 ! 186: 0031 CONTINUE 01830908 ! 187: CT004* TEST 4 FROM ARRAY 01840908 ! 188: IVTNUM = 4 01850908 ! 189: READ(UNIT=C431K,FMT=39208) CVD 01860908 ! 190: 39208 FORMAT(25X,D18.10) 01870908 ! 191: IF (CVD - 0.2344999998D+04) 20040, 10040, 40040 01880908 ! 192: 40040 IF (CVD - 0.2345000002D+04) 10040, 10040, 20040 01890908 ! 193: 10040 IVPASS = IVPASS + 1 01900908 ! 194: WRITE (NUVI, 80002) IVTNUM 01910908 ! 195: GO TO 0041 01920908 ! 196: 20040 IVFAIL = IVFAIL + 1 01930908 ! 197: DVCORR = 23.45D2 01940908 ! 198: WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 01950908 ! 199: 0041 CONTINUE 01960908 ! 200: C***** 01970908 ! 201: C***** TESTS 5 THRU 9 - LIST FROM ARRAY 01980908 ! 202: C***** 01990908 ! 203: CT005* TEST 5 02000908 ! 204: IVTNUM = 5 02010908 ! 205: READ(UNIT=B291K,FMT=39210) AVD, BVD, CVD, DVD, EVD 02020908 ! 206: 39210 FORMAT(D10.5,1X,D10.5,/,D10.5,/,D10.5,//,D10.5) 02030908 ! 207: IF (AVD - 0.3438456998D+03) 20050, 10050, 40050 02040908 ! 208: 40050 IF (AVD - 0.3438457002D+03) 10050, 10050, 20050 02050908 ! 209: 10050 IVPASS = IVPASS + 1 02060908 ! 210: WRITE (NUVI, 80002) IVTNUM 02070908 ! 211: GO TO 0051 02080908 ! 212: 20050 IVFAIL = IVFAIL + 1 02090908 ! 213: DVCORR = 34.38457D1 02100908 ! 214: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02110908 ! 215: 0051 CONTINUE 02120908 ! 216: CT006* TEST 6 02130908 ! 217: IVTNUM = 6 02140908 ! 218: IF (BVD - 0.3438456998D+03) 20060, 10060, 40060 02150908 ! 219: 40060 IF (BVD - 0.3438457002D+03) 10060, 10060, 20060 02160908 ! 220: 10060 IVPASS = IVPASS + 1 02170908 ! 221: WRITE (NUVI, 80002) IVTNUM 02180908 ! 222: GO TO 0061 02190908 ! 223: 20060 IVFAIL = IVFAIL + 1 02200908 ! 224: DVCORR = 34.38457D1 02210908 ! 225: WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02220908 ! 226: 0061 CONTINUE 02230908 ! 227: CT007* TEST 7 02240908 ! 228: IVTNUM = 7 02250908 ! 229: IF (CVD - 0.3438456998D+03) 20070, 10070, 40070 02260908 ! 230: 40070 IF (CVD - 0.3438457002D+03) 10070, 10070, 20070 02270908 ! 231: 10070 IVPASS = IVPASS + 1 02280908 ! 232: WRITE (NUVI, 80002) IVTNUM 02290908 ! 233: GO TO 0071 02300908 ! 234: 20070 IVFAIL = IVFAIL + 1 02310908 ! 235: DVCORR = 34.38457D1 02320908 ! 236: WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 02330908 ! 237: 0071 CONTINUE 02340908 ! 238: CT008* TEST 8 02350908 ! 239: IVTNUM = 8 02360908 ! 240: IF (DVD - 0.3438456998D+03) 20080, 10080, 40080 02370908 ! 241: 40080 IF (DVD - 0.3438457002D+03) 10080, 10080, 20080 02380908 ! 242: 10080 IVPASS = IVPASS + 1 02390908 ! 243: WRITE (NUVI, 80002) IVTNUM 02400908 ! 244: GO TO 0081 02410908 ! 245: 20080 IVFAIL = IVFAIL + 1 02420908 ! 246: DVCORR = 34.38457D1 02430908 ! 247: WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR 02440908 ! 248: 0081 CONTINUE 02450908 ! 249: CT009* TEST 9 02460908 ! 250: IVTNUM = 9 02470908 ! 251: IF (EVD - 0.3438456998D+03) 20090, 10090, 40090 02480908 ! 252: 40090 IF (EVD - 0.3438457002D+03) 10090, 10090, 20090 02490908 ! 253: 10090 IVPASS = IVPASS + 1 02500908 ! 254: WRITE (NUVI, 80002) IVTNUM 02510908 ! 255: GO TO 0091 02520908 ! 256: 20090 IVFAIL = IVFAIL + 1 02530908 ! 257: DVCORR = 34.38457D1 02540908 ! 258: WRITE (NUVI, 80031) IVTNUM, EVD, DVCORR 02550908 ! 259: 0091 CONTINUE 02560908 ! 260: C***** 02570908 ! 261: C***** TESTS 10 THRU 13 - LIST FROM VARIABLE WITH DIFFERENT FORMATS 02580908 ! 262: C***** 02590908 ! 263: CT010* TEST 10 02600908 ! 264: IVTNUM = 10 02610908 ! 265: READ(UNIT=D43VK,FMT=39212) AVD, BVD, CVD, DVD 02620908 ! 266: 39212 FORMAT(D10.5,1X,F10.5,D11.5,G11.5) 02630908 ! 267: IF (AVD - 0.3458672998D+04) 20100, 10100, 40100 02640908 ! 268: 40100 IF (AVD - 0.3458673002D+04) 10100, 10100, 20100 02650908 ! 269: 10100 IVPASS = IVPASS + 1 02660908 ! 270: WRITE (NUVI, 80002) IVTNUM 02670908 ! 271: GO TO 0101 02680908 ! 272: 20100 IVFAIL = IVFAIL + 1 02690908 ! 273: DVCORR = 34.58673D2 02700908 ! 274: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02710908 ! 275: 0101 CONTINUE 02720908 ! 276: CT011* TEST 11 02730908 ! 277: IVTNUM = 11 02740908 ! 278: IF (BVD - 0.3458672998D+04) 20110, 10110, 40110 02750908 ! 279: 40110 IF (BVD - 0.3458673002D+04) 10110, 10110, 20110 02760908 ! 280: 10110 IVPASS = IVPASS + 1 02770908 ! 281: WRITE (NUVI, 80002) IVTNUM 02780908 ! 282: GO TO 0111 02790908 ! 283: 20110 IVFAIL = IVFAIL + 1 02800908 ! 284: DVCORR = 34.58673D2 02810908 ! 285: WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02820908 ! 286: 0111 CONTINUE 02830908 ! 287: CT012* TEST 12 02840908 ! 288: IVTNUM = 12 02850908 ! 289: IF (CVD - 0.3458672998D+04) 20120, 10120, 40120 02860908 ! 290: 40120 IF (CVD - 0.3458673002D+04) 10120, 10120, 20120 02870908 ! 291: 10120 IVPASS = IVPASS + 1 02880908 ! 292: WRITE (NUVI, 80002) IVTNUM 02890908 ! 293: GO TO 0121 02900908 ! 294: 20120 IVFAIL = IVFAIL + 1 02910908 ! 295: DVCORR = 34.58673D2 02920908 ! 296: WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 02930908 ! 297: 0121 CONTINUE 02940908 ! 298: CT013* TEST 13 02950908 ! 299: IVTNUM = 13 02960908 ! 300: IF (DVD - 0.3458672998D+04) 20130, 10130, 40130 02970908 ! 301: 40130 IF (DVD - 0.3458673002D+04) 10130, 10130, 20130 02980908 ! 302: 10130 IVPASS = IVPASS + 1 02990908 ! 303: WRITE (NUVI, 80002) IVTNUM 03000908 ! 304: GO TO 0131 03010908 ! 305: 20130 IVFAIL = IVFAIL + 1 03020908 ! 306: DVCORR = 34.58673D2 03030908 ! 307: WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR 03040908 ! 308: 0131 CONTINUE 03050908 ! 309: C***** 03060908 ! 310: WRITE (NUVI, 90002) 03070908 ! 311: WRITE (NUVI, 90013) 03080908 ! 312: WRITE (NUVI, 90014) 03090908 ! 313: C***** 03100908 ! 314: C***** TESTS 14 THRU 19 - MIXED TYPES 03110908 ! 315: C***** 03120908 ! 316: CT014* TEST 14 03130908 ! 317: IVTNUM = 14 03140908 ! 318: READ(UNIT=E51VK,FMT=39214) KVI, AVS, AVD, AVB, BVS, A8VK 03150908 ! 319: 39214 FORMAT(I4,1X,E9.4,D10.4,1X,L4,1X,F12.5,1X,A8) 03160908 ! 320: IF (KVI - 348) 20140, 10140, 20140 03170908 ! 321: 10140 IVPASS = IVPASS + 1 03180908 ! 322: WRITE (NUVI, 80002) IVTNUM 03190908 ! 323: GO TO 0141 03200908 ! 324: 20140 IVFAIL = IVFAIL + 1 03210908 ! 325: IVCORR = 348 03220908 ! 326: WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 03230908 ! 327: 0141 CONTINUE 03240908 ! 328: CT015* TEST 15 03250908 ! 329: IVTNUM = 15 03260908 ! 330: IF (AVS - 0.34781E+02) 20150, 10150, 40150 03270908 ! 331: 40150 IF (AVS - 0.34785E+02) 10150, 10150, 20150 03280908 ! 332: 10150 IVPASS = IVPASS + 1 03290908 ! 333: WRITE (NUVI, 80002) IVTNUM 03300908 ! 334: GO TO 0151 03310908 ! 335: 20150 IVFAIL = IVFAIL + 1 03320908 ! 336: RVCORR = 34.783 03330908 ! 337: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03340908 ! 338: 0151 CONTINUE 03350908 ! 339: CT016* TEST 16 03360908 ! 340: IVTNUM = 16 03370908 ! 341: IF (AVD - 0.3843846998D+04) 20160, 10160, 40160 03380908 ! 342: 40160 IF (AVD - 0.3843847002D+04) 10160, 10160, 20160 03390908 ! 343: 10160 IVPASS = IVPASS + 1 03400908 ! 344: WRITE (NUVI, 80002) IVTNUM 03410908 ! 345: GO TO 0161 03420908 ! 346: 20160 IVFAIL = IVFAIL + 1 03430908 ! 347: DVCORR = 384.3847D1 03440908 ! 348: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03450908 ! 349: 0161 CONTINUE 03460908 ! 350: CT017* TEST 17 03470908 ! 351: IVTNUM = 17 03480908 ! 352: IVCOMP = 0 03490908 ! 353: IF (AVB) IVCOMP = 1 03500908 ! 354: IF (IVCOMP - 1) 20170, 10170, 20170 03510908 ! 355: 10170 IVPASS = IVPASS + 1 03520908 ! 356: WRITE (NUVI, 80002) IVTNUM 03530908 ! 357: GO TO 0171 03540908 ! 358: 20170 IVFAIL = IVFAIL + 1 03550908 ! 359: LVCORR = 1 03560908 ! 360: REMRKS = '1 = TRUE ; 0 = FALSE' 03570908 ! 361: WRITE (NUVI, 80008) IVTNUM, REMRKS 03580908 ! 362: WRITE (NUVI, 80024) IVCOMP 03590908 ! 363: WRITE (NUVI, 80026) LVCORR 03600908 ! 364: 0171 CONTINUE 03610908 ! 365: CT018* TEST 18 03620908 ! 366: IVTNUM = 18 03630908 ! 367: IF (BVS - 0.34855E+01) 20180, 10180, 40180 03640908 ! 368: 40180 IF (BVS - 0.34859E+01) 10180, 10180, 20180 03650908 ! 369: 10180 IVPASS = IVPASS + 1 03660908 ! 370: WRITE (NUVI, 80002) IVTNUM 03670908 ! 371: GO TO 0181 03680908 ! 372: 20180 IVFAIL = IVFAIL + 1 03690908 ! 373: RVCORR = 3.4857 03700908 ! 374: WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 03710908 ! 375: 0181 CONTINUE 03720908 ! 376: CT019* TEST 19 03730908 ! 377: IVTNUM = 19 03740908 ! 378: IVCOMP = 0 03750908 ! 379: IF (A8VK.EQ.'KDFJ D/.') IVCOMP = 1 03760908 ! 380: IF (IVCOMP - 1) 20190, 10190, 20190 03770908 ! 381: 10190 IVPASS = IVPASS + 1 03780908 ! 382: WRITE (NUVI, 80002) IVTNUM 03790908 ! 383: GO TO 0191 03800908 ! 384: 20190 IVFAIL = IVFAIL + 1 03810908 ! 385: CVCORR = 'KDFJ D/.' 03820908 ! 386: WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 03830908 ! 387: 0191 CONTINUE 03840908 ! 388: C***** 03850908 ! 389: C***** TESTS 20 THRU 25 - MIXED TYPES WITH TC, TLC, TRC, AND NX 03860908 ! 390: C***** 03870908 ! 391: CT020* TEST 20 03880908 ! 392: IVTNUM = 20 03890908 ! 393: READ(UNIT=F43VK,FMT=39216) AVB, AVS, A8VK, AVD, BVS, KVI 03900908 ! 394: 39216 FORMAT(L1,T5,F5.2,A8,TR2,D8.4,TL8,F6.4,4X,I1) 03910908 ! 395: IVCOMP = 0 03920908 ! 396: IF (AVB) IVCOMP = 1 03930908 ! 397: IF (IVCOMP - 1) 20200, 10200, 20200 03940908 ! 398: 10200 IVPASS = IVPASS + 1 03950908 ! 399: WRITE (NUVI, 80002) IVTNUM 03960908 ! 400: GO TO 0201 03970908 ! 401: 20200 IVFAIL = IVFAIL + 1 03980908 ! 402: LVCORR = 1 03990908 ! 403: REMRKS = '1 = TRUE ; 0 = FALSE' 04000908 ! 404: WRITE (NUVI, 80008) IVTNUM, REMRKS 04010908 ! 405: WRITE (NUVI, 80024) IVCOMP 04020908 ! 406: WRITE (NUVI, 80026) LVCORR 04030908 ! 407: 0201 CONTINUE 04040908 ! 408: CT021* TEST 21 04050908 ! 409: IVTNUM = 21 04060908 ! 410: IF (AVS - 0.10979E+02) 20210, 10210, 40210 04070908 ! 411: 40210 IF (AVS - 0.10981E+02) 10210, 10210, 20210 04080908 ! 412: 10210 IVPASS = IVPASS + 1 04090908 ! 413: WRITE (NUVI, 80002) IVTNUM 04100908 ! 414: GO TO 0211 04110908 ! 415: 20210 IVFAIL = IVFAIL + 1 04120908 ! 416: RVCORR = 10.98 04130908 ! 417: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 04140908 ! 418: 0211 CONTINUE 04150908 ! 419: CT022* TEST 22 04160908 ! 420: IVTNUM = 22 04170908 ! 421: IVCOMP = 0 04180908 ! 422: IF (A8VK.EQ.'THISISIT') IVCOMP = 1 04190908 ! 423: IF (IVCOMP - 1) 20220, 10220, 20220 04200908 ! 424: 10220 IVPASS = IVPASS + 1 04210908 ! 425: WRITE (NUVI, 80002) IVTNUM 04220908 ! 426: GO TO 0221 04230908 ! 427: 20220 IVFAIL = IVFAIL + 1 04240908 ! 428: CVCORR = 'THISISIT' 04250908 ! 429: WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 04260908 ! 430: 0221 CONTINUE 04270908 ! 431: CT023* TEST 23 04280908 ! 432: IVTNUM = 23 04290908 ! 433: IF (AVD - 0.3494499998D+03) 20230, 10230, 40230 04300908 ! 434: 40230 IF (AVD - 0.3494500002D+03) 10230, 10230, 20230 04310908 ! 435: 10230 IVPASS = IVPASS + 1 04320908 ! 436: WRITE (NUVI, 80002) IVTNUM 04330908 ! 437: GO TO 0231 04340908 ! 438: 20230 IVFAIL = IVFAIL + 1 04350908 ! 439: DVCORR = 3.4945D2 04360908 ! 440: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 04370908 ! 441: 0231 CONTINUE 04380908 ! 442: CT024* TEST 24 04390908 ! 443: IVTNUM = 24 04400908 ! 444: IF (BVS - 0.34943E+01) 20240, 10240, 40240 04410908 ! 445: 40240 IF (BVS - 0.34947E+01) 10240, 10240, 20240 04420908 ! 446: 10240 IVPASS = IVPASS + 1 04430908 ! 447: WRITE (NUVI, 80002) IVTNUM 04440908 ! 448: GO TO 0241 04450908 ! 449: 20240 IVFAIL = IVFAIL + 1 04460908 ! 450: RVCORR = 3.4945 04470908 ! 451: WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04480908 ! 452: 0241 CONTINUE 04490908 ! 453: CT025* TEST 25 04500908 ! 454: IVTNUM = 25 04510908 ! 455: IF (KVI - 3) 20250, 10250, 20250 04520908 ! 456: 10250 IVPASS = IVPASS + 1 04530908 ! 457: WRITE (NUVI, 80002) IVTNUM 04540908 ! 458: GO TO 0251 04550908 ! 459: 20250 IVFAIL = IVFAIL + 1 04560908 ! 460: IVCORR = 3 04570908 ! 461: WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04580908 ! 462: 0251 CONTINUE 04590908 ! 463: CT026* TEST 26 COMPLEX FROM VARIABLE 04600908 ! 464: IVTNUM = 26 04610908 ! 465: READ(UNIT=G43VK,FMT=39218) AVC 04620908 ! 466: 39218 FORMAT(F10.5,1X,F10.5) 04630908 ! 467: IF (R2E(1) - 0.23428E+01) 20260, 40262, 40261 04640908 ! 468: 40261 IF (R2E(1) - 0.23432E+01) 40262, 40262, 20260 04650908 ! 469: 40262 IF (R2E(2) - 0.34392E+02) 20260, 10260, 40260 04660908 ! 470: 40260 IF (R2E(2) - 0.34396E+02) 10260, 10260, 20260 04670908 ! 471: 10260 IVPASS = IVPASS + 1 04680908 ! 472: WRITE (NUVI, 80002) IVTNUM 04690908 ! 473: GO TO 0261 04700908 ! 474: 20260 IVFAIL = IVFAIL + 1 04710908 ! 475: ZVCORR = (2.343, 34.394) 04720908 ! 476: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 04730908 ! 477: 0261 CONTINUE 04740908 ! 478: CT027* TEST 27 COMPLEX FROM ARRAY 04750908 ! 479: IVTNUM = 27 04760908 ! 480: READ(UNIT=H131K,FMT=39220) AVC 04770908 ! 481: 39220 FORMAT(E12.5,/,E12.5) 04780908 ! 482: IF (R2E(1) - 0.34838E+02) 20270, 40272, 40271 04790908 ! 483: 40271 IF (R2E(1) - 0.34842E+02) 40272, 40272, 20270 04800908 ! 484: 40272 IF (R2E(2) - 0.34987E+03) 20270, 10270, 40270 04810908 ! 485: 40270 IF (R2E(2) - 0.34991E+03) 10270, 10270, 20270 04820908 ! 486: 10270 IVPASS = IVPASS + 1 04830908 ! 487: WRITE (NUVI, 80002) IVTNUM 04840908 ! 488: GO TO 0271 04850908 ! 489: 20270 IVFAIL = IVFAIL + 1 04860908 ! 490: ZVCORR = (34.84, 349.887) 04870908 ! 491: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 04880908 ! 492: 0271 CONTINUE 04890908 ! 493: C***** 04900908 ! 494: WRITE (NUVI, 90002) 04910908 ! 495: WRITE (NUVI, 90013) 04920908 ! 496: WRITE (NUVI, 90014) 04930908 ! 497: C***** 04940908 ! 498: C***** TESTS 28 THRU 31 - COMPLEX LIST FROM VARIABLE POSITION 1X BEYOND04950908 ! 499: C***** VARIABLE LENGTH 04960908 ! 500: CT028* TEST 28 04970908 ! 501: IVTNUM = 28 04980908 ! 502: READ(UNIT=I82VK,FMT=39222) AVC, BVC, CVC, DVC 04990908 ! 503: 39222 FORMAT(2(2(G7.5,1X),2X),2(G10.4E2,1X),1X,2(G11.7E4,1X)) 05000908 ! 504: IF (R2E(1) - 0.23398E+01) 20280, 40282, 40281 05010908 ! 505: 40281 IF (R2E(1) - 0.23402E+01) 40282, 40282, 20280 05020908 ! 506: 40282 IF (R2E(2) - 0.24558E+01) 20280, 10280, 40280 05030908 ! 507: 40280 IF (R2E(2) - 0.24562E+01) 10280, 10280, 20280 05040908 ! 508: 10280 IVPASS = IVPASS + 1 05050908 ! 509: WRITE (NUVI, 80002) IVTNUM 05060908 ! 510: GO TO 0281 05070908 ! 511: 20280 IVFAIL = IVFAIL + 1 05080908 ! 512: ZVCORR = (2.34, 2.456) 05090908 ! 513: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 05100908 ! 514: 0281 CONTINUE 05110908 ! 515: CT029* TEST 29 05120908 ! 516: IVTNUM = 29 05130908 ! 517: IF (R2E(3) - 0.23398E+01) 20290, 40292, 40291 05140908 ! 518: 40291 IF (R2E(3) - 0.23402E+01) 40292, 40292, 20290 05150908 ! 519: 40292 IF (R2E(4) - 0.24558E+01) 20290, 10290, 40290 05160908 ! 520: 40290 IF (R2E(4) - 0.24562E+01) 10290, 10290, 20290 05170908 ! 521: 10290 IVPASS = IVPASS + 1 05180908 ! 522: WRITE (NUVI, 80002) IVTNUM 05190908 ! 523: GO TO 0291 05200908 ! 524: 20290 IVFAIL = IVFAIL + 1 05210908 ! 525: ZVCORR = (2.34, 2.456) 05220908 ! 526: WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05230908 ! 527: 0291 CONTINUE 05240908 ! 528: CT030* TEST 30 05250908 ! 529: IVTNUM = 30 05260908 ! 530: IF (R2E(5) - 0.23398E+01) 20300, 40302, 40301 05270908 ! 531: 40301 IF (R2E(5) - 0.23402E+01) 40302, 40302, 20300 05280908 ! 532: 40302 IF (R2E(6) - 0.24558E+01) 20300, 10300, 40300 05290908 ! 533: 40300 IF (R2E(6) - 0.24562E+01) 10300, 10300, 20300 05300908 ! 534: 10300 IVPASS = IVPASS + 1 05310908 ! 535: WRITE (NUVI, 80002) IVTNUM 05320908 ! 536: GO TO 0301 05330908 ! 537: 20300 IVFAIL = IVFAIL + 1 05340908 ! 538: ZVCORR = (2.34, 2.456) 05350908 ! 539: WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 05360908 ! 540: 0301 CONTINUE 05370908 ! 541: CT031* TEST 31 05380908 ! 542: IVTNUM = 31 05390908 ! 543: IF (R2E(7) - 0.23398E+01) 20310, 40312, 40311 05400908 ! 544: 40311 IF (R2E(7) - 0.23402E+01) 40312, 40312, 20310 05410908 ! 545: 40312 IF (R2E(8) - 0.24558E+01) 20310, 10310, 40310 05420908 ! 546: 40310 IF (R2E(8) - 0.24562E+01) 10310, 10310, 20310 05430908 ! 547: 10310 IVPASS = IVPASS + 1 05440908 ! 548: WRITE (NUVI, 80002) IVTNUM 05450908 ! 549: GO TO 0311 05460908 ! 550: 20310 IVFAIL = IVFAIL + 1 05470908 ! 551: ZVCORR = (2.34, 2.456) 05480908 ! 552: WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR 05490908 ! 553: 0311 CONTINUE 05500908 ! 554: C***** 05510908 ! 555: C***** TESTS 32 THRU 35 - COMPLEX LIST USING EW.D AND EW.DEN 05520908 ! 556: C***** 05530908 ! 557: CT032* TEST 32 05540908 ! 558: IVTNUM = 32 05550908 ! 559: READ(UNIT=J97VK(1:),FMT=39224) AVC, BVC, CVC, DVC 05560908 ! 560: 39224 FORMAT(2(2(E10.5,1X),2X),2(E10.4E2,1X),1X,2(E12.5E4,1X)) 05570908 ! 561: IF (R2E(1) - 0.56795E+01) 20320, 40322, 40321 05580908 ! 562: 40321 IF (R2E(1) - 0.56801E+01) 40322, 40322, 20320 05590908 ! 563: 40322 IF (R2E(2) - 0.98755E+00) 20320, 10320, 40320 05600908 ! 564: 40320 IF (R2E(2) - 0.98765E+00) 10320, 10320, 20320 05610908 ! 565: 10320 IVPASS = IVPASS + 1 05620908 ! 566: WRITE (NUVI, 80002) IVTNUM 05630908 ! 567: GO TO 0321 05640908 ! 568: 20320 IVFAIL = IVFAIL + 1 05650908 ! 569: ZVCORR = (5.6798, 0.9876) 05660908 ! 570: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 05670908 ! 571: 0321 CONTINUE 05680908 ! 572: CT033* TEST 33 05690908 ! 573: IVTNUM = 33 05700908 ! 574: IF (R2E(3) - 0.56795E+01) 20330, 40332, 40331 05710908 ! 575: 40331 IF (R2E(3) - 0.56801E+01) 40332, 40332, 20330 05720908 ! 576: 40332 IF (R2E(4) - 0.98755E+00) 20330, 10330, 40330 05730908 ! 577: 40330 IF (R2E(4) - 0.98765E+00) 10330, 10330, 20330 05740908 ! 578: 10330 IVPASS = IVPASS + 1 05750908 ! 579: WRITE (NUVI, 80002) IVTNUM 05760908 ! 580: GO TO 0331 05770908 ! 581: 20330 IVFAIL = IVFAIL + 1 05780908 ! 582: ZVCORR = (5.6798, 0.9876) 05790908 ! 583: WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05800908 ! 584: 0331 CONTINUE 05810908 ! 585: CT034* TEST 34 05820908 ! 586: IVTNUM = 34 05830908 ! 587: IF (R2E(5) - 0.56795E+01) 20340, 40342, 40341 05840908 ! 588: 40341 IF (R2E(5) - 0.56801E+01) 40342, 40342, 20340 05850908 ! 589: 40342 IF (R2E(6) - 0.98755E+00) 20340, 10340, 40340 05860908 ! 590: 40340 IF (R2E(6) - 0.98765E+00) 10340, 10340, 20340 05870908 ! 591: 10340 IVPASS = IVPASS + 1 05880908 ! 592: WRITE (NUVI, 80002) IVTNUM 05890908 ! 593: GO TO 0341 05900908 ! 594: 20340 IVFAIL = IVFAIL + 1 05910908 ! 595: ZVCORR = (5.6798, 0.9876) 05920908 ! 596: WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 05930908 ! 597: 0341 CONTINUE 05940908 ! 598: CT035* TEST 35 05950908 ! 599: IVTNUM = 35 05960908 ! 600: IF (R2E(7) - 0.56795E+01) 20350, 40352, 40351 05970908 ! 601: 40351 IF (R2E(7) - 0.56801E+01) 40352, 40352, 20350 05980908 ! 602: 40352 IF (R2E(8) - 0.98755E+00) 20350, 10350, 40350 05990908 ! 603: 40350 IF (R2E(8) - 0.98765E+00) 10350, 10350, 20350 06000908 ! 604: 10350 IVPASS = IVPASS + 1 06010908 ! 605: WRITE (NUVI, 80002) IVTNUM 06020908 ! 606: GO TO 0351 06030908 ! 607: 20350 IVFAIL = IVFAIL + 1 06040908 ! 608: ZVCORR = (5.6798, 0.9876) 06050908 ! 609: WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR 06060908 ! 610: 0351 CONTINUE 06070908 ! 611: C***** 06080908 ! 612: C***** TESTS 36 THRU 38 - MIXED TYPES FROM VARIABLE 06090908 ! 613: C***** 06100908 ! 614: CT036* TEST 36 06110908 ! 615: IVTNUM = 36 06120908 ! 616: READ(UNIT=K43VK,FMT=39226) AVC, AVS, AVD 06130908 ! 617: 39226 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,D13.5) 06140908 ! 618: IF (R2E(1) - 0.93395E+00) 20360, 40362, 40361 06150908 ! 619: 40361 IF (R2E(1) - 0.93405E+00) 40362, 40362, 20360 06160908 ! 620: 40362 IF (R2E(2) - 0.34565E+02) 20360, 10360, 40360 06170908 ! 621: 40360 IF (R2E(2) - 0.34569E+02) 10360, 10360, 20360 06180908 ! 622: 10360 IVPASS = IVPASS + 1 06190908 ! 623: WRITE (NUVI, 80002) IVTNUM 06200908 ! 624: GO TO 0361 06210908 ! 625: 20360 IVFAIL = IVFAIL + 1 06220908 ! 626: ZVCORR = (0.934, 34.567) 06230908 ! 627: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 06240908 ! 628: 0361 CONTINUE 06250908 ! 629: CT037* TEST 37 06260908 ! 630: IVTNUM = 37 06270908 ! 631: IF (AVS - 0.34648E+02) 20370, 10370, 40370 06280908 ! 632: 40370 IF (AVS - 0.34652E+02) 10370, 10370, 20370 06290908 ! 633: 10370 IVPASS = IVPASS + 1 06300908 ! 634: WRITE (NUVI, 80002) IVTNUM 06310908 ! 635: GO TO 0371 06320908 ! 636: 20370 IVFAIL = IVFAIL + 1 06330908 ! 637: RVCORR = 34.65 06340908 ! 638: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 06350908 ! 639: 0371 CONTINUE 06360908 ! 640: CT038* TEST 38 06370908 ! 641: IVTNUM = 38 06380908 ! 642: IF (AVD - 0.6353999996D+01) 20380, 10380, 40380 06390908 ! 643: 40380 IF (AVD - 0.6354000004D+01) 10380, 10380, 20380 06400908 ! 644: 10380 IVPASS = IVPASS + 1 06410908 ! 645: WRITE (NUVI, 80002) IVTNUM 06420908 ! 646: GO TO 0381 06430908 ! 647: 20380 IVFAIL = IVFAIL + 1 06440908 ! 648: DVCORR = 0.6354D1 06450908 ! 649: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 06460908 ! 650: 0381 CONTINUE 06470908 ! 651: C***** 06480908 ! 652: C***** TESTS 39 THRU 43 - MIXED TYPES FROM ARRAY 06490908 ! 653: C***** 06500908 ! 654: CT039* TEST 39 06510908 ! 655: IVTNUM = 39 06520908 ! 656: READ(UNIT=L53VK,FMT=39228) AVC, AVB, AVD, AVS, A8VK 06530908 ! 657: 39228 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8) 06540908 ! 658: IF (R2E(1) - 0.34498E+00) 20390, 40392, 40391 06550908 ! 659: 40391 IF (R2E(1) - 0.34502E+00) 40392, 40392, 20390 06560908 ! 660: 40392 IF (R2E(2) - 0.34343E+02) 20390, 10390, 40390 06570908 ! 661: 40390 IF (R2E(2) - 0.34347E+02) 10390, 10390, 20390 06580908 ! 662: 10390 IVPASS = IVPASS + 1 06590908 ! 663: WRITE (NUVI, 80002) IVTNUM 06600908 ! 664: GO TO 0391 06610908 ! 665: 20390 IVFAIL = IVFAIL + 1 06620908 ! 666: ZVCORR = (0.345, 34.345) 06630908 ! 667: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 06640908 ! 668: 0391 CONTINUE 06650908 ! 669: CT040* TEST 40 06660908 ! 670: IVTNUM = 40 06670908 ! 671: IVCOMP = 0 06680908 ! 672: IF (AVB) IVCOMP = 1 06690908 ! 673: IF (IVCOMP - 0) 20400, 10400, 20400 06700908 ! 674: 10400 IVPASS = IVPASS + 1 06710908 ! 675: WRITE (NUVI, 80002) IVTNUM 06720908 ! 676: GO TO 0401 06730908 ! 677: 20400 IVFAIL = IVFAIL + 1 06740908 ! 678: LVCORR = 0 06750908 ! 679: REMRKS = '1 = TRUE ; 0 = FALSE' 06760908 ! 680: WRITE (NUVI, 80008) IVTNUM, REMRKS 06770908 ! 681: WRITE (NUVI, 80024) IVCOMP 06780908 ! 682: WRITE (NUVI, 80026) LVCORR 06790908 ! 683: 0401 CONTINUE 06800908 ! 684: CT041* TEST 41 06810908 ! 685: IVTNUM = 41 06820908 ! 686: IF (AVD - 0.3485899998D+01) 20410, 10410, 40410 06830908 ! 687: 40410 IF (AVD - 0.3485900002D+01) 10410, 10410, 20410 06840908 ! 688: 10410 IVPASS = IVPASS + 1 06850908 ! 689: WRITE (NUVI, 80002) IVTNUM 06860908 ! 690: GO TO 0411 06870908 ! 691: 20410 IVFAIL = IVFAIL + 1 06880908 ! 692: DVCORR = 34.859D-1 06890908 ! 693: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 06900908 ! 694: 0411 CONTINUE 06910908 ! 695: CT042* TEST 42 06920908 ! 696: IVTNUM = 42 06930908 ! 697: IF (AVS - 0.99995E+01) 20420, 10420, 40420 06940908 ! 698: 40420 IF (AVS - 0.10001E+02) 10420, 10420, 20420 06950908 ! 699: 10420 IVPASS = IVPASS + 1 06960908 ! 700: WRITE (NUVI, 80002) IVTNUM 06970908 ! 701: GO TO 0421 06980908 ! 702: 20420 IVFAIL = IVFAIL + 1 06990908 ! 703: RVCORR = 10.0 07000908 ! 704: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 07010908 ! 705: 0421 CONTINUE 07020908 ! 706: CT043* TEST 43 07030908 ! 707: IVTNUM = 43 07040908 ! 708: IVCOMP = 0 07050908 ! 709: IF (A8VK.EQ.'12345678') IVCOMP = 1 07060908 ! 710: IF (IVCOMP - 1) 20430, 10430, 20430 07070908 ! 711: 10430 IVPASS = IVPASS + 1 07080908 ! 712: WRITE (NUVI, 80002) IVTNUM 07090908 ! 713: GO TO 0431 07100908 ! 714: 20430 IVFAIL = IVFAIL + 1 07110908 ! 715: CVCORR = '12345678' 07120908 ! 716: WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 07130908 ! 717: 0431 CONTINUE 07140908 ! 718: C***** 07150908 ! 719: WRITE (NUVI, 90002) 07160908 ! 720: WRITE (NUVI, 90013) 07170908 ! 721: WRITE (NUVI, 90014) 07180908 ! 722: C***** 07190908 ! 723: C***** TESTS 44 THRU 48 - READ 5 RECORD FROM ARRAY POSITION 1X BEYOND 07200908 ! 724: C***** ARRAY ELEMENT 07210908 ! 725: C***** 07220908 ! 726: CT044* TEST 44 07230908 ! 727: IVTNUM = 44 07240908 ! 728: READ(UNIT=M291K,FMT=39230) KVI, AVD, AVB, AVC, A8VK 07250908 ! 729: 39230 FORMAT(I5,/,D10.5,//,1X,L6,1X,2(E10.3,1X),/,A8) 07260908 ! 730: IF (KVI - 98) 20440, 10440, 20440 07270908 ! 731: 10440 IVPASS = IVPASS + 1 07280908 ! 732: WRITE (NUVI, 80002) IVTNUM 07290908 ! 733: GO TO 0441 07300908 ! 734: 20440 IVFAIL = IVFAIL + 1 07310908 ! 735: IVCORR = 98 07320908 ! 736: WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 07330908 ! 737: 0441 CONTINUE 07340908 ! 738: CT045* TEST 45 07350908 ! 739: IVTNUM = 45 07360908 ! 740: IF (AVD - 0.8404849995D+03) 20450, 10450, 40450 07370908 ! 741: 40450 IF (AVD - 0.8404850004D+03) 10450, 10450, 20450 07380908 ! 742: 10450 IVPASS = IVPASS + 1 07390908 ! 743: WRITE (NUVI, 80002) IVTNUM 07400908 ! 744: GO TO 0451 07410908 ! 745: 20450 IVFAIL = IVFAIL + 1 07420908 ! 746: DVCORR = 84.0485D1 07430908 ! 747: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 07440908 ! 748: 0451 CONTINUE 07450908 ! 749: CT046* TEST 46 07460908 ! 750: IVTNUM = 46 07470908 ! 751: IVCOMP = 0 07480908 ! 752: IF (AVB) IVCOMP = 1 07490908 ! 753: IF (IVCOMP - 1) 20460, 10460, 20460 07500908 ! 754: 10460 IVPASS = IVPASS + 1 07510908 ! 755: WRITE (NUVI, 80002) IVTNUM 07520908 ! 756: GO TO 0461 07530908 ! 757: 20460 IVFAIL = IVFAIL + 1 07540908 ! 758: LVCORR = 1 07550908 ! 759: REMRKS = '1 = TRUE ; 0 = FALSE' 07560908 ! 760: WRITE (NUVI, 80008) IVTNUM, REMRKS 07570908 ! 761: WRITE (NUVI, 80024) IVCOMP 07580908 ! 762: WRITE (NUVI, 80026) LVCORR 07590908 ! 763: 0461 CONTINUE 07600908 ! 764: CT047* TEST 47 07610908 ! 765: IVTNUM = 47 07620908 ! 766: IF (R2E(1) - 0.34041E+02) 20470, 40472, 40471 07630908 ! 767: 40471 IF (R2E(1) - 0.34046E+02) 40472, 40472, 20470 07640908 ! 768: 40472 IF (R2E(2) - 0.34938E+02) 20470, 10470, 40470 07650908 ! 769: 40470 IF (R2E(2) - 0.34942E+02) 10470, 10470, 20470 07660908 ! 770: 10470 IVPASS = IVPASS + 1 07670908 ! 771: WRITE (NUVI, 80002) IVTNUM 07680908 ! 772: GO TO 0471 07690908 ! 773: 20470 IVFAIL = IVFAIL + 1 07700908 ! 774: ZVCORR = (34.0435, 34.94) 07710908 ! 775: WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 07720908 ! 776: 0471 CONTINUE 07730908 ! 777: CT048* TEST 48 07740908 ! 778: IVTNUM = 48 07750908 ! 779: IVCOMP = 0 07760908 ! 780: IF (A8VK.EQ.'87654321') IVCOMP = 1 07770908 ! 781: IF (IVCOMP - 1) 20480, 10480, 20480 07780908 ! 782: 10480 IVPASS = IVPASS + 1 07790908 ! 783: WRITE (NUVI, 80002) IVTNUM 07800908 ! 784: GO TO 0481 07810908 ! 785: 20480 IVFAIL = IVFAIL + 1 07820908 ! 786: CVCORR = '87654321' 07830908 ! 787: WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 07840908 ! 788: 0481 CONTINUE 07850908 ! 789: C***** 07860908 ! 790: C***** TESTS 49 THRU 54 - MIXED TYPES, NX, AND : 07870908 ! 791: C***** 07880908 ! 792: CT049* TEST 49 07890908 ! 793: IVTNUM = 49 07900908 ! 794: READ(UNIT=N43VK,FMT=39232)JVI,AVS,AVD,AVB,A8VK,BVS 07910908 ! 795: 39232 FORMAT(I2,1X,F6.3,D10.5,L2,A8,E10.5,:,I5,2X,F10.4) 07920908 ! 796: IF (JVI - 34) 20490, 10490, 20490 07930908 ! 797: 10490 IVPASS = IVPASS + 1 07940908 ! 798: WRITE (NUVI, 80002) IVTNUM 07950908 ! 799: GO TO 0491 07960908 ! 800: 20490 IVFAIL = IVFAIL + 1 07970908 ! 801: IVCORR = 34 07980908 ! 802: WRITE (NUVI, 80010) IVTNUM, JVI, IVCORR 07990908 ! 803: 0491 CONTINUE 08000908 ! 804: CT050* TEST 50 08010908 ! 805: IVTNUM = 50 08020908 ! 806: IF (AVS - 0.34981E+02) 20500, 10500, 40500 08030908 ! 807: 40500 IF (AVS - 0.34985E+02) 10500, 10500, 20500 08040908 ! 808: 10500 IVPASS = IVPASS + 1 08050908 ! 809: WRITE (NUVI, 80002) IVTNUM 08060908 ! 810: GO TO 0501 08070908 ! 811: 20500 IVFAIL = IVFAIL + 1 08080908 ! 812: RVCORR = 34.983 08090908 ! 813: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 08100908 ! 814: 0501 CONTINUE 08110908 ! 815: CT051* TEST 51 08120908 ! 816: IVTNUM = 51 08130908 ! 817: IF (AVD - 0.9582999995D+04) 20510, 10510, 40510 08140908 ! 818: 40510 IF (AVD - 0.9583000005D+04) 10510, 10510, 20510 08150908 ! 819: 10510 IVPASS = IVPASS + 1 08160908 ! 820: WRITE (NUVI, 80002) IVTNUM 08170908 ! 821: GO TO 0511 08180908 ! 822: 20510 IVFAIL = IVFAIL + 1 08190908 ! 823: DVCORR = 95.83D2 08200908 ! 824: WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 08210908 ! 825: 0511 CONTINUE 08220908 ! 826: CT052* TEST 52 08230908 ! 827: IVTNUM = 52 08240908 ! 828: IVCOMP = 0 08250908 ! 829: IF (AVB) IVCOMP = 1 08260908 ! 830: IF (IVCOMP - 0) 20520, 10520, 20520 08270908 ! 831: 10520 IVPASS = IVPASS + 1 08280908 ! 832: WRITE (NUVI, 80002) IVTNUM 08290908 ! 833: GO TO 0521 08300908 ! 834: 20520 IVFAIL = IVFAIL + 1 08310908 ! 835: LVCORR = 0 08320908 ! 836: REMRKS = '1 = TRUE ; 0 = FALSE' 08330908 ! 837: WRITE (NUVI, 80008) IVTNUM, REMRKS 08340908 ! 838: WRITE (NUVI, 80024) IVCOMP 08350908 ! 839: WRITE (NUVI, 80026) LVCORR 08360908 ! 840: 0521 CONTINUE 08370908 ! 841: CT053* TEST 53 08380908 ! 842: IVTNUM = 53 08390908 ! 843: IVCOMP = 0 08400908 ! 844: IF (A8VK.EQ.'.FALSE.1') IVCOMP = 1 08410908 ! 845: IF (IVCOMP - 1) 20530, 10530, 20530 08420908 ! 846: 10530 IVPASS = IVPASS + 1 08430908 ! 847: WRITE (NUVI, 80002) IVTNUM 08440908 ! 848: GO TO 0531 08450908 ! 849: 20530 IVFAIL = IVFAIL + 1 08460908 ! 850: CVCORR = '.FALSE.1' 08470908 ! 851: WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 08480908 ! 852: 0531 CONTINUE 08490908 ! 853: CT054* TEST 54 08500908 ! 854: IVTNUM = 54 08510908 ! 855: IF (BVS - 0.34528E+03) 20540, 10540, 40540 08520908 ! 856: 40540 IF (BVS - 0.34532E+03) 10540, 10540, 20540 08530908 ! 857: 10540 IVPASS = IVPASS + 1 08540908 ! 858: WRITE (NUVI, 80002) IVTNUM 08550908 ! 859: GO TO 0541 08560908 ! 860: 20540 IVFAIL = IVFAIL + 1 08570908 ! 861: RVCORR = 345.3 08580908 ! 862: WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 08590908 ! 863: 0541 CONTINUE 08600908 ! 864: C***** 08610908 ! 865: CBB** ********************** BBCSUM0 **********************************08620908 ! 866: C**** WRITE OUT TEST SUMMARY 08630908 ! 867: C**** 08640908 ! 868: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08650908 ! 869: WRITE (I02, 90004) 08660908 ! 870: WRITE (I02, 90014) 08670908 ! 871: WRITE (I02, 90004) 08680908 ! 872: WRITE (I02, 90020) IVPASS 08690908 ! 873: WRITE (I02, 90022) IVFAIL 08700908 ! 874: WRITE (I02, 90024) IVDELE 08710908 ! 875: WRITE (I02, 90026) IVINSP 08720908 ! 876: WRITE (I02, 90028) IVTOTN, IVTOTL 08730908 ! 877: CBE** ********************** BBCSUM0 **********************************08740908 ! 878: CBB** ********************** BBCFOOT0 **********************************08750908 ! 879: C**** WRITE OUT REPORT FOOTINGS 08760908 ! 880: C**** 08770908 ! 881: WRITE (I02,90016) ZPROG, ZPROG 08780908 ! 882: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08790908 ! 883: WRITE (I02,90019) 08800908 ! 884: CBE** ********************** BBCFOOT0 **********************************08810908 ! 885: CBB** ********************** BBCFMT0A **********************************08820908 ! 886: C**** FORMATS FOR TEST DETAIL LINES 08830908 ! 887: C**** 08840908 ! 888: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 08850908 ! 889: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 08860908 ! 890: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 08870908 ! 891: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 08880908 ! 892: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 08890908 ! 893: 1I6,/,1H ,15X,10HCORRECT= ,I6) 08900908 ! 894: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08910908 ! 895: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 08920908 ! 896: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08930908 ! 897: 1A21,/,1H ,16X,10HCORRECT= ,A21) 08940908 ! 898: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 08950908 ! 899: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 08960908 ! 900: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 08970908 ! 901: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 08980908 ! 902: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 08990908 ! 903: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 09000908 ! 904: 80050 FORMAT (1H ,48X,A31) 09010908 ! 905: CBE** ********************** BBCFMT0A **********************************09020908 ! 906: CBB** ********************** BBCFMAT1 **********************************09030908 ! 907: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 09040908 ! 908: C**** 09050908 ! 909: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 09060908 ! 910: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 09070908 ! 911: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 09080908 ! 912: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 09090908 ! 913: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 09100908 ! 914: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 09110908 ! 915: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 09120908 ! 916: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 09130908 ! 917: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 09140908 ! 918: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 09150908 ! 919: 21H(,F12.5,2H, ,F12.5,1H)) 09160908 ! 920: CBE** ********************** BBCFMAT1 **********************************09170908 ! 921: CBB** ********************** BBCFMT0B **********************************09180908 ! 922: C**** FORMAT STATEMENTS FOR PAGE HEADERS 09190908 ! 923: C**** 09200908 ! 924: 90002 FORMAT (1H1) 09210908 ! 925: 90004 FORMAT (1H ) 09220908 ! 926: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 09230908 ! 927: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 09240908 ! 928: 90008 FORMAT (1H ,21X,A13,A17) 09250908 ! 929: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 09260908 ! 930: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 09270908 ! 931: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 09280908 ! 932: 1 7X,7HREMARKS,24X) 09290908 ! 933: 90014 FORMAT (1H ,46H----------------------------------------------, 09300908 ! 934: 1 33H---------------------------------) 09310908 ! 935: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 09320908 ! 936: C**** 09330908 ! 937: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 09340908 ! 938: C**** 09350908 ! 939: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 09360908 ! 940: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 09370908 ! 941: 1 A13) 09380908 ! 942: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 09390908 ! 943: C**** 09400908 ! 944: C**** FORMAT STATEMENTS FOR RUN SUMMARY 09410908 ! 945: C**** 09420908 ! 946: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 09430908 ! 947: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 09440908 ! 948: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 09450908 ! 949: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 09460908 ! 950: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 09470908 ! 951: CBE** ********************** BBCFMT0B **********************************09480908 ! 952: C***** 09490908 ! 953: C***** END OF TEST SEGMENT 392 09500908 ! 954: STOP 09510908 ! 955: END 09520908
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.