|
|
1.1 ! root 1: C***********************************************************************00010406 ! 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 00020406 ! 6: C***** FM406 00030406 ! 7: C***** INTER2 - (391) 00040406 ! 8: C***** 00050406 ! 9: C***********************************************************************00060406 ! 10: C***** TESTING OF INTERNAL FILES - SUBSET REF00070406 ! 11: C***** USING WRITE 12.2.5 00080406 ! 12: C***** 00090406 ! 13: CBB** ********************** BBCCOMNT **********************************00100406 ! 14: C**** 00110406 ! 15: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120406 ! 16: C**** VERSION 2.0 00130406 ! 17: C**** 00140406 ! 18: C**** 00150406 ! 19: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160406 ! 20: C**** GENERAL SERVICES ADMINISTRATION 00170406 ! 21: C**** FEDERAL SOFTWARE TESTING CENTER 00180406 ! 22: C**** 5203 LEESBURG PIKE, SUITE 1100 00190406 ! 23: C**** FALLS CHURCH, VA. 22041 00200406 ! 24: C**** 00210406 ! 25: C**** (703) 756-6153 00220406 ! 26: C**** 00230406 ! 27: CBE** ********************** BBCCOMNT **********************************00240406 ! 28: C***** 00250406 ! 29: C***** S P E C I F I C A T I O N S SEGMENT 391 00260406 ! 30: C***** 00270406 ! 31: LOGICAL AVB 00280406 ! 32: CHARACTER A4VK*4, A5VK*5, A10VK*10, A38VK*38 00290406 ! 33: CHARACTER CVCORR*38, AVCORR(8)*38 00300406 ! 34: C***** 00310406 ! 35: CBB** ********************** BBCINITA **********************************00320406 ! 36: C**** SPECIFICATION STATEMENTS 00330406 ! 37: C**** 00340406 ! 38: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350406 ! 39: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360406 ! 40: CBE** ********************** BBCINITA **********************************00370406 ! 41: CBB** ********************** BBCINITB **********************************00380406 ! 42: C**** INITIALIZE SECTION 00390406 ! 43: DATA ZVERS, ZVERSD, ZDATE 00400406 ! 44: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00410406 ! 45: DATA ZCOMPL, ZNAME, ZTAPE 00420406 ! 46: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430406 ! 47: DATA ZPROJ, ZTAPED, ZPROG 00440406 ! 48: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450406 ! 49: DATA REMRKS /' '/ 00460406 ! 50: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470406 ! 51: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480406 ! 52: C**** 00490406 ! 53: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500406 ! 54: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510406 ! 55: CZ03 ZPROG = 'PROGRAM NAME' 00520406 ! 56: ZDATE = '07-Nov-85 ' *RP ! 57: ZCOMPL = 'CCI 5.2 ' *RP ! 58: ZPROJ = 'TC-85- -410' *RP ! 59: ZNAME = ' ' *RP ! 60: ZTAPE = ' ' *RP ! 61: ZTAPED = '850703 ' *RP ! 62: C 00590406 ! 63: IVPASS = 0 00600406 ! 64: IVFAIL = 0 00610406 ! 65: IVDELE = 0 00620406 ! 66: IVINSP = 0 00630406 ! 67: IVTOTL = 0 00640406 ! 68: IVTOTN = 0 00650406 ! 69: ICZERO = 0 00660406 ! 70: C 00670406 ! 71: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680406 ! 72: I01 = 05 00690406 ! 73: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700406 ! 74: I02 = 06 00710406 ! 75: C 00720406 ! 76: I01 = 5 00730406 ! 77: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740406 ! 78: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750406 ! 79: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760406 ! 80: C 00770406 ! 81: I02 = 6 00780406 ! 82: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790406 ! 83: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800406 ! 84: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810406 ! 85: C 00820406 ! 86: CBE** ********************** BBCINITB **********************************00830406 ! 87: NUVI = I02 00840406 ! 88: IVTOTL = 12 00850406 ! 89: ZPROG = 'FM406' 00860406 ! 90: CBB** ********************** BBCHED0A **********************************00870406 ! 91: C**** 00880406 ! 92: C**** WRITE REPORT TITLE 00890406 ! 93: C**** 00900406 ! 94: WRITE (I02, 90002) 00910406 ! 95: WRITE (I02, 90006) 00920406 ! 96: WRITE (I02, 90007) 00930406 ! 97: WRITE (I02, 90008) ZVERS, ZVERSD 00940406 ! 98: WRITE (I02, 90009) ZPROG, ZPROG 00950406 ! 99: WRITE (I02, 90010) ZDATE, ZCOMPL 00960406 ! 100: CBE** ********************** BBCHED0A **********************************00970406 ! 101: C***** 00980406 ! 102: C***** 00990406 ! 103: C***** HEADER FOR SEGMENT 391 01000406 ! 104: C***** 01010406 ! 105: WRITE(NUVI,39100) 01020406 ! 106: 39100 FORMAT(1H ,/ 45H INTER2 - (391) INTERNAL FILES -- USING WRITE 01030406 ! 107: 1 //21H SUBSET REF. - 12.2.5) 01040406 ! 108: CBB** ********************** BBCHED0B **********************************01050406 ! 109: C**** WRITE DETAIL REPORT HEADERS 01060406 ! 110: C**** 01070406 ! 111: WRITE (I02,90004) 01080406 ! 112: WRITE (I02,90004) 01090406 ! 113: WRITE (I02,90013) 01100406 ! 114: WRITE (I02,90014) 01110406 ! 115: WRITE (I02,90015) IVTOTL 01120406 ! 116: CBE** ********************** BBCHED0B **********************************01130406 ! 117: WRITE (NUVI, 39199) 01140406 ! 118: 39199 FORMAT (1H ,48X,31HNOTE 1: OPTIONAL LEADING ZERO / 01150406 ! 119: 1 1H ,48X,31H MAY BE BLANK FOR ABSOLUTE / 01160406 ! 120: 2 1H ,48X,31H VALUE < 1 / 01170406 ! 121: 3 1H ,48X,31HNOTE 2: LEADING PLUS SIGN IS / 01180406 ! 122: 4 1H ,48X,31H OPTIONAL / 01190406 ! 123: 5 1H ,48X,31HNOTE 3: E EXPONENT MAY BE E+ / 01200406 ! 124: 6 1H ,48X,31H OR +0 BEFORE VALUE ) 01210406 ! 125: CT001* TEST 1 CHARACTER VARIABLE, INTEGER 01220406 ! 126: IVTNUM = 1 01230406 ! 127: A10VK = 'XXXXXXXXXX' 01240406 ! 128: KVI = 3 01250406 ! 129: WRITE(A10VK,39101) KVI 01260406 ! 130: 39101 FORMAT(I2) 01270406 ! 131: IVCOMP = 0 01280406 ! 132: AVCORR(1) = ' 3 ' 01290406 ! 133: AVCORR(2) = '+3 ' 01300406 ! 134: DO 40011 I = 1, 2 01310406 ! 135: IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1 01320406 ! 136: IF (IVCOMP - 1) 40011, 10010, 40011 01330406 ! 137: 40011 CONTINUE 01340406 ! 138: GO TO 20010 01350406 ! 139: 10010 IVPASS = IVPASS + 1 01360406 ! 140: WRITE (NUVI, 80002) IVTNUM 01370406 ! 141: GO TO 0011 01380406 ! 142: 20010 IVFAIL = IVFAIL + 1 01390406 ! 143: CVCORR = ' 3 ' 01400406 ! 144: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01410406 ! 145: WRITE (NUVI, 80008) IVTNUM, REMRKS 01420406 ! 146: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01430406 ! 147: WRITE (NUVI, 80050) REMRKS 01440406 ! 148: WRITE (NUVI, 80020) A10VK 01450406 ! 149: WRITE (NUVI, 80022) CVCORR 01460406 ! 150: 0011 CONTINUE 01470406 ! 151: CT002* TEST 2 REAL, FW.D 01480406 ! 152: IVTNUM = 2 01490406 ! 153: A10VK = 'XXXXXXXXXX' 01500406 ! 154: AVS = 2.1 01510406 ! 155: WRITE(A10VK,39103) AVS 01520406 ! 156: 39103 FORMAT(F3.1) 01530406 ! 157: IVCOMP = 0 01540406 ! 158: IF (A10VK.EQ.'2.1 ') IVCOMP = 1 01550406 ! 159: IF (IVCOMP - 1) 20020, 10020, 20020 01560406 ! 160: 10020 IVPASS = IVPASS + 1 01570406 ! 161: WRITE (NUVI, 80002) IVTNUM 01580406 ! 162: GO TO 0021 01590406 ! 163: 20020 IVFAIL = IVFAIL + 1 01600406 ! 164: CVCORR = '2.1 ' 01610406 ! 165: WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR 01620406 ! 166: 0021 CONTINUE 01630406 ! 167: CT003* TEST 3 CHECK FOR MISSING SIGN 01640406 ! 168: IVTNUM = 3 01650406 ! 169: A10VK = 'XXXXXXXXXX' 01660406 ! 170: AVS = -0.0001 01670406 ! 171: WRITE(A10VK,39104) AVS 01680406 ! 172: 39104 FORMAT(F4.1) 01690406 ! 173: IVCOMP = 0 01700406 ! 174: AVCORR(1) = ' 0.0 ' 01710406 ! 175: AVCORR(2) = ' .0 ' 01720406 ! 176: AVCORR(3) = '+0.0 ' 01730406 ! 177: AVCORR(4) = ' +.0 ' 01740406 ! 178: DO 40031 I = 1, 4 01750406 ! 179: IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1 01760406 ! 180: IF (IVCOMP - 1) 40031, 10030, 40031 01770406 ! 181: 40031 CONTINUE 01780406 ! 182: GO TO 20030 01790406 ! 183: 10030 IVPASS = IVPASS + 1 01800406 ! 184: WRITE (NUVI, 80002) IVTNUM 01810406 ! 185: GO TO 0031 01820406 ! 186: 20030 IVFAIL = IVFAIL + 1 01830406 ! 187: CVCORR = ' 0.0 ' 01840406 ! 188: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01850406 ! 189: WRITE (NUVI, 80008) IVTNUM, REMRKS 01860406 ! 190: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01870406 ! 191: WRITE (NUVI, 80050) REMRKS 01880406 ! 192: WRITE (NUVI, 80020) A10VK 01890406 ! 193: WRITE (NUVI, 80022) CVCORR 01900406 ! 194: 0031 CONTINUE 01910406 ! 195: CT004* TEST 4 CONVERSION ERROR 01920406 ! 196: IVTNUM = 4 01930406 ! 197: A10VK = 'XXXXXXXXXX' 01940406 ! 198: AVS = 231.75 01950406 ! 199: WRITE(A10VK,39105) AVS 01960406 ! 200: 39105 FORMAT(F4.2) 01970406 ! 201: IVCOMP = 0 01980406 ! 202: IF (A10VK.EQ.'**** ') IVCOMP = 1 01990406 ! 203: IF (IVCOMP - 1) 20040, 10040, 20040 02000406 ! 204: 10040 IVPASS = IVPASS + 1 02010406 ! 205: WRITE (NUVI, 80002) IVTNUM 02020406 ! 206: GO TO 0041 02030406 ! 207: 20040 IVFAIL = IVFAIL + 1 02040406 ! 208: CVCORR = '**** ' 02050406 ! 209: WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR 02060406 ! 210: 0041 CONTINUE 02070406 ! 211: CT005* TEST 5 REAL, EW.D 02080406 ! 212: IVTNUM = 5 02090406 ! 213: A10VK = 'XXXXXXXXXX' 02100406 ! 214: AVS = 23.45E2 02110406 ! 215: WRITE(A10VK,39106) AVS 02120406 ! 216: 39106 FORMAT(1X,E9.4) 02130406 ! 217: IVCOMP = 0 02140406 ! 218: AVCORR(1) = ' .2345E+04' 02150406 ! 219: AVCORR(2) = ' .2345+004' 02160406 ! 220: DO 40051 I = 1, 2 02170406 ! 221: IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1 02180406 ! 222: IF (IVCOMP - 1) 40051, 10050, 40051 02190406 ! 223: 40051 CONTINUE 02200406 ! 224: GO TO 20050 02210406 ! 225: 10050 IVPASS = IVPASS + 1 02220406 ! 226: WRITE (NUVI, 80002) IVTNUM 02230406 ! 227: GO TO 0051 02240406 ! 228: 20050 IVFAIL = IVFAIL + 1 02250406 ! 229: CVCORR = ' .2345E+04' 02260406 ! 230: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02270406 ! 231: WRITE (NUVI, 80008) IVTNUM, REMRKS 02280406 ! 232: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02290406 ! 233: WRITE (NUVI, 80050) REMRKS 02300406 ! 234: WRITE (NUVI, 80020) A10VK 02310406 ! 235: WRITE (NUVI, 80022) CVCORR 02320406 ! 236: 0051 CONTINUE 02330406 ! 237: CT006* TEST 6 REAL, EW.DEN 02340406 ! 238: IVTNUM = 6 02350406 ! 239: A10VK = 'XXXXXXXXXX' 02360406 ! 240: WRITE(A10VK,39107) AVS 02370406 ! 241: 39107 FORMAT(1X,E8.4E1) 02380406 ! 242: IVCOMP = 0 02390406 ! 243: AVCORR(1) = ' .2345E+4 ' 02400406 ! 244: AVCORR(2) = ' .2345+04 ' 02410406 ! 245: DO 40061 I = 1, 2 02420406 ! 246: IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1 02430406 ! 247: IF (IVCOMP - 1) 40061, 10060, 40061 02440406 ! 248: 40061 CONTINUE 02450406 ! 249: GO TO 20060 02460406 ! 250: 10060 IVPASS = IVPASS + 1 02470406 ! 251: WRITE (NUVI, 80002) IVTNUM 02480406 ! 252: GO TO 0061 02490406 ! 253: 20060 IVFAIL = IVFAIL + 1 02500406 ! 254: CVCORR = ' .2345E+4 ' 02510406 ! 255: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02520406 ! 256: WRITE (NUVI, 80008) IVTNUM, REMRKS 02530406 ! 257: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02540406 ! 258: WRITE (NUVI, 80050) REMRKS 02550406 ! 259: WRITE (NUVI, 80020) A10VK 02560406 ! 260: WRITE (NUVI, 80022) CVCORR 02570406 ! 261: 0061 CONTINUE 02580406 ! 262: CT007* TEST 7 LOGICAL 02590406 ! 263: IVTNUM = 7 02600406 ! 264: A10VK = 'XXXXXXXXXX' 02610406 ! 265: AVB = .TRUE. 02620406 ! 266: WRITE(A10VK,39108) AVB 02630406 ! 267: 39108 FORMAT(L6) 02640406 ! 268: IVCOMP = 0 02650406 ! 269: IF (A10VK.EQ.' T ') IVCOMP = 1 02660406 ! 270: IF (IVCOMP - 1) 20070, 10070, 20070 02670406 ! 271: 10070 IVPASS = IVPASS + 1 02680406 ! 272: WRITE (NUVI, 80002) IVTNUM 02690406 ! 273: GO TO 0071 02700406 ! 274: 20070 IVFAIL = IVFAIL + 1 02710406 ! 275: CVCORR = ' T ' 02720406 ! 276: WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR 02730406 ! 277: 0071 CONTINUE 02740406 ! 278: CT008* TEST 8 CHARACTER, AW 02750406 ! 279: IVTNUM = 8 02760406 ! 280: A10VK = 'XXXXXXXXXX' 02770406 ! 281: A4VK = 'TEST' 02780406 ! 282: WRITE(A10VK,39109) A4VK 02790406 ! 283: 39109 FORMAT(A4) 02800406 ! 284: IVCOMP = 0 02810406 ! 285: IF (A10VK.EQ.'TEST ') IVCOMP = 1 02820406 ! 286: IF (IVCOMP - 1) 20080, 10080, 20080 02830406 ! 287: 10080 IVPASS = IVPASS + 1 02840406 ! 288: WRITE (NUVI, 80002) IVTNUM 02850406 ! 289: GO TO 0081 02860406 ! 290: 20080 IVFAIL = IVFAIL + 1 02870406 ! 291: CVCORR = 'TEST ' 02880406 ! 292: WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR 02890406 ! 293: 0081 CONTINUE 02900406 ! 294: CT009* TEST 9 BLANK RECORD 02910406 ! 295: IVTNUM = 9 02920406 ! 296: A10VK = 'XXXXXXXXXX' 02930406 ! 297: WRITE(A10VK,39110) 02940406 ! 298: 39110 FORMAT() 02950406 ! 299: IVCOMP = 0 02960406 ! 300: IF (A10VK.EQ.' ') IVCOMP = 1 02970406 ! 301: IF (IVCOMP - 1) 20090, 10090, 20090 02980406 ! 302: 10090 IVPASS = IVPASS + 1 02990406 ! 303: WRITE (NUVI, 80002) IVTNUM 03000406 ! 304: GO TO 0091 03010406 ! 305: 20090 IVFAIL = IVFAIL + 1 03020406 ! 306: CVCORR = ' ' 03030406 ! 307: WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR 03040406 ! 308: 0091 CONTINUE 03050406 ! 309: CT010* TEST 10 MIXED TYPES 03060406 ! 310: IVTNUM = 10 03070406 ! 311: A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' 03080406 ! 312: KVI = 23 03090406 ! 313: AVS = 23.345 03100406 ! 314: AVB = .TRUE. 03110406 ! 315: A4VK = 'ENDS' 03120406 ! 316: WRITE(A38VK,39111) KVI, AVS, AVB, A4VK 03130406 ! 317: 39111 FORMAT(I5,1X,F8.3,1X,L5,1X,A4) 03140406 ! 318: IVCOMP = 0 03150406 ! 319: AVCORR(1) = ' 23 23.345 T ENDS ' 03160406 ! 320: AVCORR(2) = ' +23 +23.345 T ENDS ' 03170406 ! 321: AVCORR(3) = ' 23 +23.345 T ENDS ' 03180406 ! 322: AVCORR(4) = ' +23 23.345 T ENDS ' 03190406 ! 323: DO 40101 I = 1, 4 03200406 ! 324: IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1 03210406 ! 325: IF (IVCOMP - 1) 40101, 10100, 40101 03220406 ! 326: 40101 CONTINUE 03230406 ! 327: GO TO 20100 03240406 ! 328: 10100 IVPASS = IVPASS + 1 03250406 ! 329: WRITE (NUVI, 80002) IVTNUM 03260406 ! 330: GO TO 0101 03270406 ! 331: 20100 IVFAIL = IVFAIL + 1 03280406 ! 332: CVCORR = ' 23 23.345 T ENDS ' 03290406 ! 333: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 03300406 ! 334: WRITE (NUVI, 80008) IVTNUM, REMRKS 03310406 ! 335: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 03320406 ! 336: WRITE (NUVI, 80050) REMRKS 03330406 ! 337: WRITE (NUVI, 80020) A38VK 03340406 ! 338: WRITE (NUVI, 80022) CVCORR 03350406 ! 339: 0101 CONTINUE 03360406 ! 340: CT011* TEST 11 MIXED TYPES, WITH 03370406 ! 341: C***** CHARACTER AND HOLLERITH STRINGS 03380406 ! 342: IVTNUM = 11 03390406 ! 343: A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' 03400406 ! 344: AVS = 23.456 03410406 ! 345: AVB = .FALSE. 03420406 ! 346: KVI = 98 03430406 ! 347: A5VK = 'YOURS' 03440406 ! 348: WRITE(A38VK,39112) AVS, AVB, KVI, A5VK 03450406 ! 349: 39112 FORMAT(F7.3,1X,L5,1X,I5,1X,A5,1X,'PROGRAMS',1X,3HONE) 03460406 ! 350: IVCOMP = 0 03470406 ! 351: AVCORR(1) = ' 23.456 F 98 YOURS PROGRAMS ONE' 03480406 ! 352: AVCORR(2) = '+23.456 F +98 YOURS PROGRAMS ONE' 03490406 ! 353: AVCORR(3) = ' 23.456 F +98 YOURS PROGRAMS ONE' 03500406 ! 354: AVCORR(4) = '+23.456 F 98 YOURS PROGRAMS ONE' 03510406 ! 355: DO 40111 I = 1, 4 03520406 ! 356: IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1 03530406 ! 357: IF (IVCOMP - 1) 40111, 10110, 40111 03540406 ! 358: 40111 CONTINUE 03550406 ! 359: GO TO 20110 03560406 ! 360: 10110 IVPASS = IVPASS + 1 03570406 ! 361: WRITE (NUVI, 80002) IVTNUM 03580406 ! 362: GO TO 0111 03590406 ! 363: 20110 IVFAIL = IVFAIL + 1 03600406 ! 364: CVCORR = ' 23.456 F 98 YOURS PROGRAMS ONE' 03610406 ! 365: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 03620406 ! 366: WRITE (NUVI, 80008) IVTNUM, REMRKS 03630406 ! 367: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 03640406 ! 368: WRITE (NUVI, 80050) REMRKS 03650406 ! 369: WRITE (NUVI, 80020) A38VK 03660406 ! 370: WRITE (NUVI, 80022) CVCORR 03670406 ! 371: 0111 CONTINUE 03680406 ! 372: CT012* TEST 12 MIXED TYPES, WITH EXPRESSION 03690406 ! 373: IVTNUM = 12 03700406 ! 374: A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' 03710406 ! 375: AVS = 5.2345 03720406 ! 376: BVS = 1.2345 03730406 ! 377: AVB = .TRUE. 03740406 ! 378: WRITE(A38VK,39113) AVS, 5, BVS*2, AVB, 'TWO' 03750406 ! 379: 39113 FORMAT(F9.4,1X,I4,1X,3HBVS,1X,F9.4,1X,L1,1X,A3) 03760406 ! 380: IVCOMP = 0 03770406 ! 381: AVCORR(1) = ' 5.2345 5 BVS 2.4690 T TWO ' 03780406 ! 382: AVCORR(2) = ' 5.2345 5 BVS +2.4690 T TWO ' 03790406 ! 383: AVCORR(3) = ' 5.2345 +5 BVS 2.4690 T TWO ' 03800406 ! 384: AVCORR(4) = ' 5.2345 +5 BVS +2.4690 T TWO ' 03810406 ! 385: AVCORR(5) = ' +5.2345 5 BVS 2.4690 T TWO ' 03820406 ! 386: AVCORR(6) = ' +5.2345 5 BVS +2.4690 T TWO ' 03830406 ! 387: AVCORR(7) = ' +5.2345 +5 BVS 2.4690 T TWO ' 03840406 ! 388: AVCORR(8) = ' +5.2345 +5 BVS +2.4690 T TWO ' 03850406 ! 389: DO 40121 I = 1, 8 03860406 ! 390: IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1 03870406 ! 391: IF (IVCOMP - 1) 40121, 10120, 40121 03880406 ! 392: 40121 CONTINUE 03890406 ! 393: GO TO 20120 03900406 ! 394: 10120 IVPASS = IVPASS + 1 03910406 ! 395: WRITE (NUVI, 80002) IVTNUM 03920406 ! 396: GO TO 0121 03930406 ! 397: 20120 IVFAIL = IVFAIL + 1 03940406 ! 398: CVCORR = ' 5.2345 5 BVS 2.4690 T TWO ' 03950406 ! 399: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 03960406 ! 400: WRITE (NUVI, 80008) IVTNUM, REMRKS 03970406 ! 401: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 03980406 ! 402: WRITE (NUVI, 80050) REMRKS 03990406 ! 403: WRITE (NUVI, 80020) A38VK 04000406 ! 404: WRITE (NUVI, 80022) CVCORR 04010406 ! 405: 0121 CONTINUE 04020406 ! 406: C***** 04030406 ! 407: CBB** ********************** BBCSUM0 **********************************04040406 ! 408: C**** WRITE OUT TEST SUMMARY 04050406 ! 409: C**** 04060406 ! 410: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04070406 ! 411: WRITE (I02, 90004) 04080406 ! 412: WRITE (I02, 90014) 04090406 ! 413: WRITE (I02, 90004) 04100406 ! 414: WRITE (I02, 90020) IVPASS 04110406 ! 415: WRITE (I02, 90022) IVFAIL 04120406 ! 416: WRITE (I02, 90024) IVDELE 04130406 ! 417: WRITE (I02, 90026) IVINSP 04140406 ! 418: WRITE (I02, 90028) IVTOTN, IVTOTL 04150406 ! 419: CBE** ********************** BBCSUM0 **********************************04160406 ! 420: CBB** ********************** BBCFOOT0 **********************************04170406 ! 421: C**** WRITE OUT REPORT FOOTINGS 04180406 ! 422: C**** 04190406 ! 423: WRITE (I02,90016) ZPROG, ZPROG 04200406 ! 424: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04210406 ! 425: WRITE (I02,90019) 04220406 ! 426: CBE** ********************** BBCFOOT0 **********************************04230406 ! 427: CBB** ********************** BBCFMT0A **********************************04240406 ! 428: C**** FORMATS FOR TEST DETAIL LINES 04250406 ! 429: C**** 04260406 ! 430: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04270406 ! 431: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04280406 ! 432: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04290406 ! 433: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04300406 ! 434: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04310406 ! 435: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04320406 ! 436: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04330406 ! 437: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04340406 ! 438: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04350406 ! 439: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04360406 ! 440: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04370406 ! 441: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04380406 ! 442: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04390406 ! 443: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04400406 ! 444: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04410406 ! 445: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04420406 ! 446: 80050 FORMAT (1H ,48X,A31) 04430406 ! 447: CBE** ********************** BBCFMT0A **********************************04440406 ! 448: CBB** ********************** BBCFMT0B **********************************04450406 ! 449: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04460406 ! 450: C**** 04470406 ! 451: 90002 FORMAT (1H1) 04480406 ! 452: 90004 FORMAT (1H ) 04490406 ! 453: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04500406 ! 454: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04510406 ! 455: 90008 FORMAT (1H ,21X,A13,A17) 04520406 ! 456: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04530406 ! 457: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04540406 ! 458: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04550406 ! 459: 1 7X,7HREMARKS,24X) 04560406 ! 460: 90014 FORMAT (1H ,46H----------------------------------------------, 04570406 ! 461: 1 33H---------------------------------) 04580406 ! 462: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04590406 ! 463: C**** 04600406 ! 464: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04610406 ! 465: C**** 04620406 ! 466: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04630406 ! 467: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04640406 ! 468: 1 A13) 04650406 ! 469: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04660406 ! 470: C**** 04670406 ! 471: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04680406 ! 472: C**** 04690406 ! 473: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04700406 ! 474: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04710406 ! 475: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04720406 ! 476: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04730406 ! 477: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04740406 ! 478: CBE** ********************** BBCFMT0B **********************************04750406 ! 479: C***** 04760406 ! 480: C***** END OF TEST SEGMENT 391 04770406 ! 481: STOP 04780406 ! 482: END 04790406
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.