|
|
1.1 ! root 1: PROGRAM FM700 00010700 ! 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 00020700 ! 6: C THIS PROGRAM TESTS THE DATA STATEMENT WITH ANS REF. 00030700 ! 7: C VARIABLE NAMES, ARRAY NAMES, ARRAY ELEMENT 9.1 00040700 ! 8: C NAMES, SUBSTRING NAMES, AND IMPLIED-DO LISTS. 9.2 00050700 ! 9: C 9.3 00060700 ! 10: C SYMBOLIC NAMES OF CONSTANTS ARE PERMITTED IN THE 00070700 ! 11: C CLIST OF THE DATA STATEMENT. IF NECESSARY, 00080700 ! 12: C THE CLIST CONSTANT IS CONVERTED TO THE TYPE 00090700 ! 13: C OF THE NLIST ENTITY ACCORDING TO THE RULES 00100700 ! 14: C FOR ARITHMETIC CONVERSION. 00110700 ! 15: C 00120700 ! 16: C 00130700 ! 17: CBB** ********************** BBCCOMNT **********************************00140700 ! 18: C**** 00150700 ! 19: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00160700 ! 20: C**** VERSION 2.0 00170700 ! 21: C**** 00180700 ! 22: C**** 00190700 ! 23: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00200700 ! 24: C**** GENERAL SERVICES ADMINISTRATION 00210700 ! 25: C**** FEDERAL SOFTWARE TESTING CENTER 00220700 ! 26: C**** 5203 LEESBURG PIKE, SUITE 1100 00230700 ! 27: C**** FALLS CHURCH, VA. 22041 00240700 ! 28: C**** 00250700 ! 29: C**** (703) 756-6153 00260700 ! 30: C**** 00270700 ! 31: CBE** ********************** BBCCOMNT **********************************00280700 ! 32: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00290700 ! 33: IMPLICIT CHARACTER*27 (C) 00300700 ! 34: CBB** ********************** BBCINITA **********************************00310700 ! 35: C**** SPECIFICATION STATEMENTS 00320700 ! 36: C**** 00330700 ! 37: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340700 ! 38: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350700 ! 39: CBE** ********************** BBCINITA **********************************00360700 ! 40: C 00370700 ! 41: INTEGER I2N001(2,3), I2N002(7), I2N003(3,7) 00380700 ! 42: INTEGER I2N004(3,10), I2N005(4,5), I2N006(6,8) 00390700 ! 43: CHARACTER CVCOMP*25, CVCORR*25, CPN001*5 00400700 ! 44: CHARACTER CVN001*25, CVN002*5, C1N001(3)*5 00410700 ! 45: CHARACTER C2N001(3,4)*4, CVN003*17 00420700 ! 46: REAL R2E001(2), R2N001(5,3) 00430700 ! 47: DOUBLE PRECISION DVCOMP, DVCORR, DVN001, D1N001(9), DPN001 00440700 ! 48: COMPLEX ZVCOMP, ZVCORR, ZVN001, Z1N001(10) 00450700 ! 49: PARAMETER (IPN001=-14, CPN001='SEVEN', IPN002=5, DPN001=0.1948D+3)00460700 ! 50: EQUIVALENCE (ZVCOMP, R2E001) 00470700 ! 51: DATA IVN001, C1N001, I2N001(2,1), CVN001(11:22) 00480700 ! 52: 1 /-137, 'FIRST', 'SECND', 'THIRD', 65, 'ELEVENTWELVE'/ 00490700 ! 53: DATA (I2N001(1,I), I=1,3) /-47, 198, -217/ 00500700 ! 54: DATA IVN002, CVN002 /IPN001, CPN001/ 00510700 ! 55: DATA I2N002, (I2N003(I,7), I=1,3), C2N001, CVN003(13:16) 00520700 ! 56: 1 /3*19, 7*-4, 13*'SAME'/ 00530700 ! 57: DATA IVN003, IVN004, RVN001, ZVN001, DVN001, DVN002 00540700 ! 58: 1 /-0.473E+3, 239.2D-1, 71, (71, -27), 6, 9.1534E-2/ 00550700 ! 59: DATA (I2N004(2,J), J=1,10) /9,8,7,6,5,4,3,2,1,0/ 00560700 ! 60: DATA ((R2N001(I,J), J=1,3), I=3,5) 00570700 ! 61: 1 /3.1, 3.2, 3.3, 4.1, 4.2, 4.3, 5.1, 5.2, 5.3/ 00580700 ! 62: DATA (Z1N001(I), I=3,7) /IPN002*(7.3, -2.28)/ 00590700 ! 63: DATA (D1N001(I), I=1,9,2) /IPN002*DPN001/ 00600700 ! 64: DATA (I2N005(I,I+1),I=1,4) / 91, -82, 73, -64/ 00610700 ! 65: DATA ((I2N006(2*I,I*J-1), I=2,3), J=1,3,2) /41, 62, 45, 68/ 00620700 ! 66: C 00630700 ! 67: C 00640700 ! 68: CBB** ********************** BBCINITB **********************************00650700 ! 69: C**** INITIALIZE SECTION 00660700 ! 70: DATA ZVERS, ZVERSD, ZDATE 00670700 ! 71: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00680700 ! 72: DATA ZCOMPL, ZNAME, ZTAPE 00690700 ! 73: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00700700 ! 74: DATA ZPROJ, ZTAPED, ZPROG 00710700 ! 75: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00720700 ! 76: DATA REMRKS /' '/ 00730700 ! 77: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00740700 ! 78: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00750700 ! 79: C**** 00760700 ! 80: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00770700 ! 81: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00780700 ! 82: CZ03 ZPROG = 'PROGRAM NAME' 00790700 ! 83: ZDATE = '07-Nov-85 ' *RP ! 84: ZCOMPL = 'CCI 5.2 ' *RP ! 85: ZPROJ = 'TC-85- -410' *RP ! 86: ZNAME = ' ' *RP ! 87: ZTAPE = ' ' *RP ! 88: ZTAPED = '850703 ' *RP ! 89: C 00860700 ! 90: IVPASS = 0 00870700 ! 91: IVFAIL = 0 00880700 ! 92: IVDELE = 0 00890700 ! 93: IVINSP = 0 00900700 ! 94: IVTOTL = 0 00910700 ! 95: IVTOTN = 0 00920700 ! 96: ICZERO = 0 00930700 ! 97: C 00940700 ! 98: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00950700 ! 99: I01 = 05 00960700 ! 100: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00970700 ! 101: I02 = 06 00980700 ! 102: C 00990700 ! 103: I01 = 5 01000700 ! 104: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01010700 ! 105: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01020700 ! 106: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01030700 ! 107: C 01040700 ! 108: I02 = 6 01050700 ! 109: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01060700 ! 110: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01070700 ! 111: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01080700 ! 112: C 01090700 ! 113: CBE** ********************** BBCINITB **********************************01100700 ! 114: ZPROG = 'FM700' 01110700 ! 115: IVTOTL = 23 01120700 ! 116: CBB** ********************** BBCHED0A **********************************01130700 ! 117: C**** 01140700 ! 118: C**** WRITE REPORT TITLE 01150700 ! 119: C**** 01160700 ! 120: WRITE (I02, 90002) 01170700 ! 121: WRITE (I02, 90006) 01180700 ! 122: WRITE (I02, 90007) 01190700 ! 123: WRITE (I02, 90008) ZVERS, ZVERSD 01200700 ! 124: WRITE (I02, 90009) ZPROG, ZPROG 01210700 ! 125: WRITE (I02, 90010) ZDATE, ZCOMPL 01220700 ! 126: CBE** ********************** BBCHED0A **********************************01230700 ! 127: CBB** ********************** BBCHED0B **********************************01240700 ! 128: C**** WRITE DETAIL REPORT HEADERS 01250700 ! 129: C**** 01260700 ! 130: WRITE (I02,90004) 01270700 ! 131: WRITE (I02,90004) 01280700 ! 132: WRITE (I02,90013) 01290700 ! 133: WRITE (I02,90014) 01300700 ! 134: WRITE (I02,90015) IVTOTL 01310700 ! 135: CBE** ********************** BBCHED0B **********************************01320700 ! 136: C 01330700 ! 137: C 01340700 ! 138: C TESTS 1 THRU 5 TEST DATA STATEMENT WITH VARIABLE NAMES, 01350700 ! 139: C ARRAY NAMES, ARRAY ELEMENT NAMES, SUBSTRING NAMES, AND IMPLIED- 01360700 ! 140: C DO LISTS. 01370700 ! 141: C 01380700 ! 142: CT001* TEST 001 **** FCVS PROGRAM 700 ***** 01390700 ! 143: C VARIABLE NAME 01400700 ! 144: C 01410700 ! 145: IVTNUM = 1 01420700 ! 146: IVCOMP = 0 01430700 ! 147: IVCORR = -137 01440700 ! 148: IVCOMP = IVN001 01450700 ! 149: 40010 IF (IVCOMP + 137) 20010, 10010, 20010 01460700 ! 150: 10010 IVPASS = IVPASS + 1 01470700 ! 151: WRITE (I02, 80002) IVTNUM 01480700 ! 152: GO TO 0011 01490700 ! 153: 20010 IVFAIL = IVFAIL + 1 01500700 ! 154: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01510700 ! 155: 0011 CONTINUE 01520700 ! 156: C 01530700 ! 157: CT002* TEST 002 **** FCVS PROGRAM 700 ***** 01540700 ! 158: C ARRAY NAME 01550700 ! 159: C 01560700 ! 160: IVTNUM = 2 01570700 ! 161: CVCOMP = ' ' 01580700 ! 162: CVCORR = 'SECND' 01590700 ! 163: CVCOMP = C1N001(2) 01600700 ! 164: IVCOMP = 0 01610700 ! 165: IF (CVCOMP.EQ.'SECND') IVCOMP = 1 01620700 ! 166: 40020 IF (IVCOMP - 1) 20020, 10020, 20020 01630700 ! 167: 10020 IVPASS = IVPASS + 1 01640700 ! 168: WRITE (I02, 80002) IVTNUM 01650700 ! 169: GO TO 0021 01660700 ! 170: 20020 IVFAIL = IVFAIL + 1 01670700 ! 171: WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 01680700 ! 172: 0021 CONTINUE 01690700 ! 173: C 01700700 ! 174: CT003* TEST 003 **** FCVS PROGRAM 700 ***** 01710700 ! 175: C ARRAY ELEMENT NAME 01720700 ! 176: C 01730700 ! 177: IVTNUM = 3 01740700 ! 178: IVCOMP = 0 01750700 ! 179: IVCORR = 65 01760700 ! 180: IVCOMP = I2N001(2,1) 01770700 ! 181: 40030 IF (IVCOMP - 65) 20030, 10030, 20030 01780700 ! 182: 10030 IVPASS = IVPASS + 1 01790700 ! 183: WRITE (I02, 80002) IVTNUM 01800700 ! 184: GO TO 0031 01810700 ! 185: 20030 IVFAIL = IVFAIL + 1 01820700 ! 186: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01830700 ! 187: 0031 CONTINUE 01840700 ! 188: C 01850700 ! 189: CT004* TEST 004 **** FCVS PROGRAM 700 ***** 01860700 ! 190: C SUBSTRING NAME 01870700 ! 191: C 01880700 ! 192: IVTNUM = 4 01890700 ! 193: CVCOMP = ' ' 01900700 ! 194: CVCORR = 'ELEVENTWELVE' 01910700 ! 195: CVCOMP = CVN001(11:22) 01920700 ! 196: IVCOMP = 0 01930700 ! 197: IF (CVCOMP.EQ.'ELEVENTWELVE') IVCOMP = 1 01940700 ! 198: 40040 IF (IVCOMP - 1) 20040, 10040, 20040 01950700 ! 199: 10040 IVPASS = IVPASS + 1 01960700 ! 200: WRITE (I02, 80002) IVTNUM 01970700 ! 201: GO TO 0041 01980700 ! 202: 20040 IVFAIL = IVFAIL + 1 01990700 ! 203: WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02000700 ! 204: 0041 CONTINUE 02010700 ! 205: C 02020700 ! 206: CT005* TEST 005 **** FCVS PROGRAM 700 ***** 02030700 ! 207: C IMPLIED-DO LIST 02040700 ! 208: C 02050700 ! 209: IVTNUM = 5 02060700 ! 210: IVCOMP = 0 02070700 ! 211: IVCORR = -217 02080700 ! 212: IVCOMP = I2N001(1,3) 02090700 ! 213: 40050 IF (IVCOMP + 217) 20050, 10050, 20050 02100700 ! 214: 10050 IVPASS = IVPASS + 1 02110700 ! 215: WRITE (I02, 80002) IVTNUM 02120700 ! 216: GO TO 0051 02130700 ! 217: 20050 IVFAIL = IVFAIL + 1 02140700 ! 218: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02150700 ! 219: 0051 CONTINUE 02160700 ! 220: C 02170700 ! 221: CT006* TEST 006 **** FCVS PROGRAM 700 ***** 02180700 ! 222: C CLIST CONTAINS A SYMBOLIC NAME OF AN INTEGER CONSTANT 02190700 ! 223: C 02200700 ! 224: IVTNUM = 6 02210700 ! 225: IVCOMP = 0 02220700 ! 226: IVCORR = -14 02230700 ! 227: IVCOMP = IVN002 02240700 ! 228: 40060 IF (IVCOMP + 14) 20060, 10060, 20060 02250700 ! 229: 10060 IVPASS = IVPASS + 1 02260700 ! 230: WRITE (I02, 80002) IVTNUM 02270700 ! 231: GO TO 0061 02280700 ! 232: 20060 IVFAIL = IVFAIL + 1 02290700 ! 233: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02300700 ! 234: 0061 CONTINUE 02310700 ! 235: C 02320700 ! 236: CT007* TEST 007 **** FCVS PROGRAM 700 ***** 02330700 ! 237: C CLIST CONTAINS A SYMBOLIC NAME OF A CHARACTER CONSTANT 02340700 ! 238: C 02350700 ! 239: IVTNUM = 7 02360700 ! 240: CVCOMP = ' ' 02370700 ! 241: CVCORR = 'SEVEN' 02380700 ! 242: CVCOMP = CVN002 02390700 ! 243: IVCOMP = 0 02400700 ! 244: IF (CVCOMP.EQ.'SEVEN') IVCOMP = 1 02410700 ! 245: 40070 IF (IVCOMP - 1) 20070, 10070, 20070 02420700 ! 246: 10070 IVPASS = IVPASS + 1 02430700 ! 247: WRITE (I02, 80002) IVTNUM 02440700 ! 248: GO TO 0071 02450700 ! 249: 20070 IVFAIL = IVFAIL + 1 02460700 ! 250: WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02470700 ! 251: 0071 CONTINUE 02480700 ! 252: C 02490700 ! 253: C TESTS 8 THRU 11 TEST COMBINATIONS OF SUBSTRING NAMES AND 02500700 ! 254: C ARRAY NAMES AND THE R*C FORMAT OF THE CLIST 02510700 ! 255: C 02520700 ! 256: CT008* TEST 008 **** FCVS PROGRAM 700 ***** 02530700 ! 257: C 02540700 ! 258: IVTNUM = 8 02550700 ! 259: IVCOMP = 0 02560700 ! 260: IVCORR = 23 02570700 ! 261: IVCOMP = I2N002(3) - I2N002(4) 02580700 ! 262: 40080 IF (IVCOMP - 23) 20080, 10080, 20080 02590700 ! 263: 10080 IVPASS = IVPASS + 1 02600700 ! 264: WRITE (I02, 80002) IVTNUM 02610700 ! 265: GO TO 0081 02620700 ! 266: 20080 IVFAIL = IVFAIL + 1 02630700 ! 267: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02640700 ! 268: 0081 CONTINUE 02650700 ! 269: C 02660700 ! 270: CT009* TEST 009 **** FCVS PROGRAM 700 ***** 02670700 ! 271: C 02680700 ! 272: IVTNUM = 9 02690700 ! 273: IVCOMP = 0 02700700 ! 274: IVCORR = -4 02710700 ! 275: DO 0092 I = 1, 3 02720700 ! 276: IF (I2N003(I,7) + 4) 0093, 0092, 0093 02730700 ! 277: 0092 CONTINUE 02740700 ! 278: 0093 IVCOMP = I2N003(3,7) 02750700 ! 279: 40090 IF (IVCOMP + 4) 20090, 10090, 20090 02760700 ! 280: 10090 IVPASS = IVPASS + 1 02770700 ! 281: WRITE (I02, 80002) IVTNUM 02780700 ! 282: GO TO 0091 02790700 ! 283: 20090 IVFAIL = IVFAIL + 1 02800700 ! 284: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02810700 ! 285: 0091 CONTINUE 02820700 ! 286: C 02830700 ! 287: CT010* TEST 010 **** FCVS PROGRAM 700 ***** 02840700 ! 288: C 02850700 ! 289: IVTNUM = 10 02860700 ! 290: CVCOMP = ' ' 02870700 ! 291: CVCORR = 'SAME' 02880700 ! 292: DO 0102 I = 1, 3 02890700 ! 293: DO 0102 J = 1, 4 02900700 ! 294: IF (C2N001(I,J).NE.'SAME') GO TO 0103 02910700 ! 295: 0102 CONTINUE 02920700 ! 296: 0103 CVCOMP = C2N001(3,4) 02930700 ! 297: IVCOMP = 0 02940700 ! 298: IF (CVCOMP.EQ.'SAME') IVCOMP = 1 02950700 ! 299: 40100 IF (IVCOMP - 1) 20100, 10100, 20100 02960700 ! 300: 10100 IVPASS = IVPASS + 1 02970700 ! 301: WRITE (I02, 80002) IVTNUM 02980700 ! 302: GO TO 0101 02990700 ! 303: 20100 IVFAIL = IVFAIL + 1 03000700 ! 304: WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03010700 ! 305: 0101 CONTINUE 03020700 ! 306: C 03030700 ! 307: CT011* TEST 011 **** FCVS PROGRAM 700 ***** 03040700 ! 308: C 03050700 ! 309: IVTNUM = 11 03060700 ! 310: CVCOMP = ' ' 03070700 ! 311: CVCORR = 'SAME' 03080700 ! 312: CVCOMP = CVN003(13:16) 03090700 ! 313: IVCOMP = 0 03100700 ! 314: IF (CVCOMP.EQ.'SAME') IVCOMP = 1 03110700 ! 315: 40110 IF (IVCOMP - 1) 20110, 10110, 20110 03120700 ! 316: 10110 IVPASS = IVPASS + 1 03130700 ! 317: WRITE (I02, 80002) IVTNUM 03140700 ! 318: GO TO 0111 03150700 ! 319: 20110 IVFAIL = IVFAIL + 1 03160700 ! 320: WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03170700 ! 321: 0111 CONTINUE 03180700 ! 322: C 03190700 ! 323: C TESTS 12 THRU 17 TEST ARITHMETIC CONVERSION OF CLIST 03200700 ! 324: C CONSTANTS TO THE TYPE OF THE CORRESPONDING NLIST ENTITIES 03210700 ! 325: C 03220700 ! 326: CT012* TEST 012 **** FCVS PROGRAM 700 ***** 03230700 ! 327: C REAL TO INTEGER 03240700 ! 328: C 03250700 ! 329: IVTNUM = 12 03260700 ! 330: IVCOMP = 0 03270700 ! 331: IVCORR = -473 03280700 ! 332: IVCOMP = IVN003 03290700 ! 333: 40120 IF (IVCOMP + 473) 20120, 10120, 20120 03300700 ! 334: 10120 IVPASS = IVPASS + 1 03310700 ! 335: WRITE (I02, 80002) IVTNUM 03320700 ! 336: GO TO 0121 03330700 ! 337: 20120 IVFAIL = IVFAIL + 1 03340700 ! 338: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03350700 ! 339: 0121 CONTINUE 03360700 ! 340: C 03370700 ! 341: CT013* TEST 013 **** FCVS PROGRAM 700 ***** 03380700 ! 342: C DOUBLE PRECISION TO INTEGER 03390700 ! 343: C 03400700 ! 344: IVTNUM = 13 03410700 ! 345: IVCOMP = 0 03420700 ! 346: IVCORR = 23 03430700 ! 347: IVCOMP = IVN004 03440700 ! 348: 40130 IF (IVCOMP - 23) 20130, 10130, 20130 03450700 ! 349: 10130 IVPASS = IVPASS + 1 03460700 ! 350: WRITE (I02, 80002) IVTNUM 03470700 ! 351: GO TO 0131 03480700 ! 352: 20130 IVFAIL = IVFAIL + 1 03490700 ! 353: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03500700 ! 354: 0131 CONTINUE 03510700 ! 355: C 03520700 ! 356: CT014* TEST 014 **** FCVS PROGRAM 700 ***** 03530700 ! 357: C INTEGER TO REAL 03540700 ! 358: C 03550700 ! 359: IVTNUM = 14 03560700 ! 360: RVCOMP = 0.0 03570700 ! 361: RVCORR = 71.0 03580700 ! 362: RVCOMP = RVN001 03590700 ! 363: IF (RVCOMP - 0.70996E+02) 20140, 10140, 40140 03600700 ! 364: 40140 IF (RVCOMP - 0.71004E+02) 10140, 10140, 20140 03610700 ! 365: 10140 IVPASS = IVPASS + 1 03620700 ! 366: WRITE (I02, 80002) IVTNUM 03630700 ! 367: GO TO 0141 03640700 ! 368: 20140 IVFAIL = IVFAIL + 1 03650700 ! 369: WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 03660700 ! 370: 0141 CONTINUE 03670700 ! 371: C 03680700 ! 372: CT015* TEST 015 **** FCVS PROGRAM 700 ***** 03690700 ! 373: C COMPLEX 03700700 ! 374: C 03710700 ! 375: IVTNUM = 15 03720700 ! 376: ZVCOMP = (0.0, 0.0) 03730700 ! 377: ZVCORR = (71.0, -27.0) 03740700 ! 378: ZVCOMP = ZVN001 03750700 ! 379: IF (R2E001(1) - 0.70996E+02) 20150, 40152, 40151 03760700 ! 380: 40151 IF (R2E001(1) - 0.71004E+02) 40152, 40152, 20150 03770700 ! 381: 40152 IF (R2E001(2) + 0.27002E+02) 20150, 10150, 40150 03780700 ! 382: 40150 IF (R2E001(2) + 0.26998E+02) 10150, 10150, 20150 03790700 ! 383: 10150 IVPASS = IVPASS + 1 03800700 ! 384: WRITE (I02, 80002) IVTNUM 03810700 ! 385: GO TO 0151 03820700 ! 386: 20150 IVFAIL = IVFAIL + 1 03830700 ! 387: WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 03840700 ! 388: 0151 CONTINUE 03850700 ! 389: C 03860700 ! 390: CT016* TEST 016 **** FCVS PROGRAM 700 ***** 03870700 ! 391: C INTEGER TO DOUBLE PRECISION 03880700 ! 392: C 03890700 ! 393: IVTNUM = 16 03900700 ! 394: DVCOMP = 0.0D0 03910700 ! 395: DVCORR = 6.0D0 03920700 ! 396: DVCOMP = DVN001 03930700 ! 397: IF (DVCOMP - 0.5999999997D+01) 20160, 10160, 40160 03940700 ! 398: 40160 IF (DVCOMP - 0.6000000003D+01) 10160, 10160, 20160 03950700 ! 399: 10160 IVPASS = IVPASS + 1 03960700 ! 400: WRITE (I02, 80002) IVTNUM 03970700 ! 401: GO TO 0161 03980700 ! 402: 20160 IVFAIL = IVFAIL + 1 03990700 ! 403: WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04000700 ! 404: 0161 CONTINUE 04010700 ! 405: C 04020700 ! 406: CT017* TEST 017 **** FCVS PROGRAM 700 ***** 04030700 ! 407: C REAL TO DOUBLE PRECISION 04040700 ! 408: C 04050700 ! 409: IVTNUM = 17 04060700 ! 410: DVCOMP = 0.0D0 04070700 ! 411: DVCORR = 9.1534D-2 04080700 ! 412: DVCOMP = DVN002 04090700 ! 413: IF (DVCOMP - 0.91529D-01) 20170, 10170, 40170 04100700 ! 414: 40170 IF (DVCOMP - 0.91539D-01) 10170, 10170, 20170 04110700 ! 415: 10170 IVPASS = IVPASS + 1 04120700 ! 416: WRITE (I02, 80002) IVTNUM 04130700 ! 417: GO TO 0171 04140700 ! 418: 20170 IVFAIL = IVFAIL + 1 04150700 ! 419: WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04160700 ! 420: 0171 CONTINUE 04170700 ! 421: C 04180700 ! 422: C TESTS 18 THRU 21 TEST DIFFERENT DATA TYPES USING THE IMPLIED-DO 04190700 ! 423: C 04200700 ! 424: CT018* TEST 018 **** FCVS PROGRAM 700 ***** 04210700 ! 425: C INTEGER 04220700 ! 426: C 04230700 ! 427: IVTNUM = 18 04240700 ! 428: IVCOMP = 0 04250700 ! 429: IVCORR = 3 04260700 ! 430: IVCOMP = I2N004(2,7) 04270700 ! 431: 40180 IF (IVCOMP - 3) 20180, 10180, 20180 04280700 ! 432: 10180 IVPASS = IVPASS + 1 04290700 ! 433: WRITE (I02, 80002) IVTNUM 04300700 ! 434: GO TO 0181 04310700 ! 435: 20180 IVFAIL = IVFAIL + 1 04320700 ! 436: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 04330700 ! 437: 0181 CONTINUE 04340700 ! 438: C 04350700 ! 439: CT019* TEST 019 **** FCVS PROGRAM 700 ***** 04360700 ! 440: C REAL 04370700 ! 441: C 04380700 ! 442: IVTNUM = 19 04390700 ! 443: RVCOMP = 0.0 04400700 ! 444: RVCORR = 4.1 04410700 ! 445: RVCOMP = R2N001(4,1) 04420700 ! 446: IF (RVCOMP - 0.40998E+01) 20190, 10190, 40190 04430700 ! 447: 40190 IF (RVCOMP - 0.41002E+01) 10190, 10190, 20190 04440700 ! 448: 10190 IVPASS = IVPASS + 1 04450700 ! 449: WRITE (I02, 80002) IVTNUM 04460700 ! 450: GO TO 0191 04470700 ! 451: 20190 IVFAIL = IVFAIL + 1 04480700 ! 452: WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 04490700 ! 453: 0191 CONTINUE 04500700 ! 454: C 04510700 ! 455: CT020* TEST 020 **** FCVS PROGRAM 700 ***** 04520700 ! 456: C COMPLEX 04530700 ! 457: C 04540700 ! 458: IVTNUM = 20 04550700 ! 459: ZVCOMP = (0.0, 0.0) 04560700 ! 460: ZVCORR = (7.3, -2.28) 04570700 ! 461: ZVCOMP = Z1N001(7) 04580700 ! 462: IF (R2E001(1) - 0.72996E+01) 20200, 40202, 40201 04590700 ! 463: 40201 IF (R2E001(1) - 0.73004E+01) 40202, 40202, 20200 04600700 ! 464: 40202 IF (R2E001(2) + 0.22802E+01) 20200, 10200, 40200 04610700 ! 465: 40200 IF (R2E001(2) + 0.22798E+01) 10200, 10200, 20200 04620700 ! 466: 10200 IVPASS = IVPASS + 1 04630700 ! 467: WRITE (I02, 80002) IVTNUM 04640700 ! 468: GO TO 0201 04650700 ! 469: 20200 IVFAIL = IVFAIL + 1 04660700 ! 470: WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 04670700 ! 471: 0201 CONTINUE 04680700 ! 472: C 04690700 ! 473: CT021* TEST 021 **** FCVS PROGRAM 700 ***** 04700700 ! 474: C DOUBLE PRECISION 04710700 ! 475: C 04720700 ! 476: IVTNUM = 21 04730700 ! 477: DVCOMP = 0.0D0 04740700 ! 478: DVCORR = 0.1948D+3 04750700 ! 479: DVCOMP = D1N001(9) 04760700 ! 480: IF (DVCOMP - 0.1947999999D+03) 20210, 10210, 40210 04770700 ! 481: 40210 IF (DVCOMP - 0.1948000001D+03) 10210, 10210, 20210 04780700 ! 482: 10210 IVPASS = IVPASS + 1 04790700 ! 483: WRITE (I02, 80002) IVTNUM 04800700 ! 484: GO TO 0211 04810700 ! 485: 20210 IVFAIL = IVFAIL + 1 04820700 ! 486: WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04830700 ! 487: 0211 CONTINUE 04840700 ! 488: C 04850700 ! 489: C TESTS 22 AND 23 TEST THAT EACH SUBSCRIPT EXPRESSION 04860700 ! 490: C IN AN IMPLIED-DO LIST MAY CONTAIN IMPLIED-DO-VARIABLES OF 04870700 ! 491: C THE LIST THAT HAS THE SUBSCRIPT EXPRESSION WITHIN ITS RANGE. 04880700 ! 492: C 04890700 ! 493: CT022* TEST 022 **** FCVS PROGRAM 700 ***** 04900700 ! 494: C 04910700 ! 495: IVTNUM = 22 04920700 ! 496: IVCOMP = 0 04930700 ! 497: IVCORR = 155 04940700 ! 498: IVCOMP = I2N005(3,4) - I2N005(2,3) 04950700 ! 499: 40220 IF (IVCOMP - 155) 20220, 10220, 20220 04960700 ! 500: 10220 IVPASS = IVPASS + 1 04970700 ! 501: WRITE (I02, 80002) IVTNUM 04980700 ! 502: GO TO 0221 04990700 ! 503: 20220 IVFAIL = IVFAIL + 1 05000700 ! 504: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05010700 ! 505: 0221 CONTINUE 05020700 ! 506: C 05030700 ! 507: CT023* TEST 023 **** FCVS PROGRAM 700 ***** 05040700 ! 508: C 05050700 ! 509: IVTNUM = 23 05060700 ! 510: IVCOMP = 0 05070700 ! 511: IVCORR = 130 05080700 ! 512: IVCOMP = I2N006(6,2) + I2N006(6,8) 05090700 ! 513: 40230 IF (IVCOMP - 130) 20230, 10230, 20230 05100700 ! 514: 10230 IVPASS = IVPASS + 1 05110700 ! 515: WRITE (I02, 80002) IVTNUM 05120700 ! 516: GO TO 0231 05130700 ! 517: 20230 IVFAIL = IVFAIL + 1 05140700 ! 518: WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05150700 ! 519: 0231 CONTINUE 05160700 ! 520: C 05170700 ! 521: CBB** ********************** BBCSUM0 **********************************05180700 ! 522: C**** WRITE OUT TEST SUMMARY 05190700 ! 523: C**** 05200700 ! 524: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05210700 ! 525: WRITE (I02, 90004) 05220700 ! 526: WRITE (I02, 90014) 05230700 ! 527: WRITE (I02, 90004) 05240700 ! 528: WRITE (I02, 90020) IVPASS 05250700 ! 529: WRITE (I02, 90022) IVFAIL 05260700 ! 530: WRITE (I02, 90024) IVDELE 05270700 ! 531: WRITE (I02, 90026) IVINSP 05280700 ! 532: WRITE (I02, 90028) IVTOTN, IVTOTL 05290700 ! 533: CBE** ********************** BBCSUM0 **********************************05300700 ! 534: CBB** ********************** BBCFOOT0 **********************************05310700 ! 535: C**** WRITE OUT REPORT FOOTINGS 05320700 ! 536: C**** 05330700 ! 537: WRITE (I02,90016) ZPROG, ZPROG 05340700 ! 538: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05350700 ! 539: WRITE (I02,90019) 05360700 ! 540: CBE** ********************** BBCFOOT0 **********************************05370700 ! 541: 90001 FORMAT (1H ,56X,5HFM700) 05380700 ! 542: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM700) 05390700 ! 543: CBB** ********************** BBCFMT0A **********************************05400700 ! 544: C**** FORMATS FOR TEST DETAIL LINES 05410700 ! 545: C**** 05420700 ! 546: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 05430700 ! 547: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 05440700 ! 548: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 05450700 ! 549: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 05460700 ! 550: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 05470700 ! 551: 1I6,/,1H ,15X,10HCORRECT= ,I6) 05480700 ! 552: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05490700 ! 553: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 05500700 ! 554: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05510700 ! 555: 1A21,/,1H ,16X,10HCORRECT= ,A21) 05520700 ! 556: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 05530700 ! 557: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 05540700 ! 558: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 05550700 ! 559: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 05560700 ! 560: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 05570700 ! 561: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 05580700 ! 562: 80050 FORMAT (1H ,48X,A31) 05590700 ! 563: CBE** ********************** BBCFMT0A **********************************05600700 ! 564: CBB** ********************** BBCFMAT1 **********************************05610700 ! 565: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05620700 ! 566: C**** 05630700 ! 567: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05640700 ! 568: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 05650700 ! 569: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 05660700 ! 570: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 05670700 ! 571: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 05680700 ! 572: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 05690700 ! 573: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 05700700 ! 574: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 05710700 ! 575: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05720700 ! 576: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 05730700 ! 577: 21H(,F12.5,2H, ,F12.5,1H)) 05740700 ! 578: CBE** ********************** BBCFMAT1 **********************************05750700 ! 579: CBB** ********************** BBCFMT0B **********************************05760700 ! 580: C**** FORMAT STATEMENTS FOR PAGE HEADERS 05770700 ! 581: C**** 05780700 ! 582: 90002 FORMAT (1H1) 05790700 ! 583: 90004 FORMAT (1H ) 05800700 ! 584: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 05810700 ! 585: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05820700 ! 586: 90008 FORMAT (1H ,21X,A13,A17) 05830700 ! 587: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 05840700 ! 588: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 05850700 ! 589: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 05860700 ! 590: 1 7X,7HREMARKS,24X) 05870700 ! 591: 90014 FORMAT (1H ,46H----------------------------------------------, 05880700 ! 592: 1 33H---------------------------------) 05890700 ! 593: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 05900700 ! 594: C**** 05910700 ! 595: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05920700 ! 596: C**** 05930700 ! 597: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 05940700 ! 598: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 05950700 ! 599: 1 A13) 05960700 ! 600: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 05970700 ! 601: C**** 05980700 ! 602: C**** FORMAT STATEMENTS FOR RUN SUMMARY 05990700 ! 603: C**** 06000700 ! 604: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 06010700 ! 605: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 06020700 ! 606: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 06030700 ! 607: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 06040700 ! 608: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 06050700 ! 609: CBE** ********************** BBCFMT0B **********************************06060700 ! 610: STOP 06070700 ! 611: END 06080700
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.