|
|
1.1 ! root 1: PROGRAM FM306 00010306 ! 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 00020306 ! 6: C 00030306 ! 7: C THIS ROUTINE TESTS THE USE OF THE SUBSET LEVEL FEATURES OF 00040306 ! 8: C THE IMPLICIT SPECIFICATION STATEMENT. THE DEFAULT IMPLIED INTEGER00050306 ! 9: C AND REAL TYPING IS EITHER CONFIRMED OR OVERRIDDEN TO SPECIFY 00060306 ! 10: C INTEGER, REAL AND LOGICAL TYPING. ALL 26 ALPHABETIC LETTERS ARE 00070306 ! 11: C USED TO INDICATE THE IMPLICIT TYPING. VARIABLE AND ARRAY 00080306 ! 12: C ENTITIES ARE USED TO TEST THE ACTUAL TYPING. THE SUBSET LEVEL 00090306 ! 13: C FEATURES OF THE IMPLICIT STATEMENT ARE ALSO TESTED IN ROUTINES 00100306 ! 14: C FM201 AND FM251. 00110306 ! 15: C 00120306 ! 16: C REFERENCES. 00130306 ! 17: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140306 ! 18: C X3.9-1978 00150306 ! 19: C 00160306 ! 20: C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS. 00170306 ! 21: C SECTION 8.5, IMPLICIT STATEMENT 00180306 ! 22: C 00190306 ! 23: C 00200306 ! 24: C ******************************************************************00210306 ! 25: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220306 ! 26: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00230306 ! 27: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00240306 ! 28: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00250306 ! 29: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00260306 ! 30: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00270306 ! 31: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00280306 ! 32: C THE RESULT OF EXECUTING THESE TESTS. 00290306 ! 33: C 00300306 ! 34: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00310306 ! 35: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00320306 ! 36: C 00330306 ! 37: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00340306 ! 38: C DEPARTMENT OF THE NAVY 00350306 ! 39: C FEDERAL COBOL COMPILER TESTING SERVICE 00360306 ! 40: C WASHINGTON, D.C. 20376 00370306 ! 41: C 00380306 ! 42: C ******************************************************************00390306 ! 43: C 00400306 ! 44: C 00410306 ! 45: IMPLICIT LOGICAL (L) 00420306 ! 46: IMPLICIT CHARACTER*14 (C) 00430306 ! 47: C 00440306 ! 48: IMPLICIT INTEGER (A) 00450306 ! 49: IMPLICIT LOGICAL (B) 00460306 ! 50: IMPLICIT INTEGER (D,E,F) 00470306 ! 51: IMPLICIT REAL (G-H) 00480306 ! 52: IMPLICIT INTEGER (I) 00490306 ! 53: IMPLICIT REAL (J) 00500306 ! 54: IMPLICIT INTEGER (K,O-Q) 00510306 ! 55: IMPLICIT REAL (M), REAL (N) 00520306 ! 56: IMPLICIT REAL (R) 00530306 ! 57: IMPLICIT REAL (S), INTEGER (T-V) 00540306 ! 58: IMPLICIT INTEGER (W), REAL (X), LOGICAL (Y), INTEGER (Z) 00550306 ! 59: DIMENSION AAIN11(5) 00560306 ! 60: DIMENSION HAIN11(5) 00570306 ! 61: C 00580306 ! 62: C 00590306 ! 63: C 00600306 ! 64: C INITIALIZATION SECTION. 00610306 ! 65: C 00620306 ! 66: C INITIALIZE CONSTANTS 00630306 ! 67: C ******************** 00640306 ! 68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00650306 ! 69: I01 = 5 00660306 ! 70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00670306 ! 71: I02 = 6 00680306 ! 72: C SYSTEM ENVIRONMENT SECTION 00690306 ! 73: C 00700306 ! 74: I01 = 5 00710306 ! 75: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720306 ! 76: C (UNIT NUMBER FOR CARD READER). 00730306 ! 77: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00740306 ! 78: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750306 ! 79: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00760306 ! 80: C 00770306 ! 81: I02 = 6 00780306 ! 82: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00790306 ! 83: C (UNIT NUMBER FOR PRINTER). 00800306 ! 84: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00810306 ! 85: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820306 ! 86: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00830306 ! 87: C 00840306 ! 88: IVPASS = 0 00850306 ! 89: IVFAIL = 0 00860306 ! 90: IVDELE = 0 00870306 ! 91: ICZERO = 0 00880306 ! 92: C 00890306 ! 93: C WRITE OUT PAGE HEADERS 00900306 ! 94: C 00910306 ! 95: WRITE (I02,90002) 00920306 ! 96: WRITE (I02,90006) 00930306 ! 97: WRITE (I02,90008) 00940306 ! 98: WRITE (I02,90004) 00950306 ! 99: WRITE (I02,90010) 00960306 ! 100: WRITE (I02,90004) 00970306 ! 101: WRITE (I02,90016) 00980306 ! 102: WRITE (I02,90001) 00990306 ! 103: WRITE (I02,90004) 01000306 ! 104: WRITE (I02,90012) 01010306 ! 105: WRITE (I02,90014) 01020306 ! 106: WRITE (I02,90004) 01030306 ! 107: C 01040306 ! 108: C 01050306 ! 109: C **** FCVS PROGRAM 306 - TEST 001 **** 01060306 ! 110: C 01070306 ! 111: C TEST 001 IS DESIGNED TO CONFIRM IMPLICIT INTEGER TYPING. 01080306 ! 112: C 01090306 ! 113: IVTNUM = 1 01100306 ! 114: IF (ICZERO) 30010, 0010, 30010 01110306 ! 115: 0010 CONTINUE 01120306 ! 116: RVCOMP = 10.0 01130306 ! 117: IVIN01 = 4 01140306 ! 118: RVCOMP = IVIN01 / 5 01150306 ! 119: RVCORR = 0.0 01160306 ! 120: 40010 IF (RVCOMP) 20010, 10010, 20010 01170306 ! 121: 30010 IVDELE = IVDELE + 1 01180306 ! 122: WRITE (I02,80000) IVTNUM 01190306 ! 123: IF (ICZERO) 10010, 0021, 20010 01200306 ! 124: 10010 IVPASS = IVPASS + 1 01210306 ! 125: WRITE (I02,80002) IVTNUM 01220306 ! 126: GO TO 0021 01230306 ! 127: 20010 IVFAIL = IVFAIL + 1 01240306 ! 128: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01250306 ! 129: 0021 CONTINUE 01260306 ! 130: C 01270306 ! 131: C **** FCVS PROGRAM 306 - TEST 002 **** 01280306 ! 132: C 01290306 ! 133: C TEST 002 IS DESIGNED TO CONFIRM IMPLICIT REAL TYPING. 01300306 ! 134: C 01310306 ! 135: IVTNUM = 2 01320306 ! 136: IF (ICZERO) 30020, 0020, 30020 01330306 ! 137: 0020 CONTINUE 01340306 ! 138: RVCOMP = 10.0 01350306 ! 139: RVIN01 = 4 01360306 ! 140: RVCOMP = RVIN01/5 01370306 ! 141: RVCORR = .8 01380306 ! 142: 40020 IF (RVCOMP - .79995) 20020, 10020, 40021 01390306 ! 143: 40021 IF (RVCOMP - .80005) 10020, 10020, 20020 01400306 ! 144: 30020 IVDELE = IVDELE + 1 01410306 ! 145: WRITE (I02,80000) IVTNUM 01420306 ! 146: IF (ICZERO) 10020, 0031, 20020 01430306 ! 147: 10020 IVPASS = IVPASS + 1 01440306 ! 148: WRITE (I02,80002) IVTNUM 01450306 ! 149: GO TO 0031 01460306 ! 150: 20020 IVFAIL = IVFAIL + 1 01470306 ! 151: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01480306 ! 152: 0031 CONTINUE 01490306 ! 153: C 01500306 ! 154: C **** FCVS PROGRAM 306 - TEST 003 **** 01510306 ! 155: C 01520306 ! 156: C TEST 003 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 01530306 ! 157: C INTEGER WITH IMPLICIT TYPING OF REAL. 01540306 ! 158: C 01550306 ! 159: IVTNUM = 3 01560306 ! 160: IF (ICZERO) 30030, 0030, 30030 01570306 ! 161: 0030 CONTINUE 01580306 ! 162: RVCOMP = 10.0 01590306 ! 163: JVIN01 = 4 01600306 ! 164: RVCOMP = JVIN01/5 01610306 ! 165: RVCORR = .8 01620306 ! 166: 40030 IF (RVCOMP - .79995) 20030, 10030, 40031 01630306 ! 167: 40031 IF (RVCOMP - .80005) 10030, 10030, 20030 01640306 ! 168: 30030 IVDELE = IVDELE + 1 01650306 ! 169: WRITE (I02,80000) IVTNUM 01660306 ! 170: IF (ICZERO) 10030, 0041, 20030 01670306 ! 171: 10030 IVPASS = IVPASS + 1 01680306 ! 172: WRITE (I02,80002) IVTNUM 01690306 ! 173: GO TO 0041 01700306 ! 174: 20030 IVFAIL = IVFAIL + 1 01710306 ! 175: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01720306 ! 176: 0041 CONTINUE 01730306 ! 177: C 01740306 ! 178: C **** FCVS PROGRAM 306 - TEST 004 **** 01750306 ! 179: C 01760306 ! 180: C TEST 004 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 01770306 ! 181: C INTEGER WITH IMPLICIT TYPING OF LOGICAL. 01780306 ! 182: C 01790306 ! 183: IVTNUM = 4 01800306 ! 184: IF (ICZERO) 30040, 0040, 30040 01810306 ! 185: 0040 CONTINUE 01820306 ! 186: LVIN01 = .TRUE. 01830306 ! 187: IVCORR = 1 01840306 ! 188: IVCOMP = 0 01850306 ! 189: IF (LVIN01) IVCOMP = 1 01860306 ! 190: 40040 IF (IVCOMP - 1) 20040, 10040, 20040 01870306 ! 191: 30040 IVDELE = IVDELE + 1 01880306 ! 192: WRITE (I02,80000) IVTNUM 01890306 ! 193: IF (ICZERO) 10040, 0051, 20040 01900306 ! 194: 10040 IVPASS = IVPASS + 1 01910306 ! 195: WRITE (I02,80002) IVTNUM 01920306 ! 196: GO TO 0051 01930306 ! 197: 20040 IVFAIL = IVFAIL + 1 01940306 ! 198: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01950306 ! 199: 0051 CONTINUE 01960306 ! 200: C 01970306 ! 201: C **** FCVS PROGRAM 306 - TEST 005 **** 01980306 ! 202: C 01990306 ! 203: C TEST 005 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 02000306 ! 204: C REAL WITH IMPLICIT TYPING OF INTEGER. 02010306 ! 205: C 02020306 ! 206: IVTNUM = 5 02030306 ! 207: IF (ICZERO) 30050, 0050, 30050 02040306 ! 208: 0050 CONTINUE 02050306 ! 209: RVCOMP = 10.0 02060306 ! 210: AAIN11(2) = 4 02070306 ! 211: RVCOMP = AAIN11(2)/5 02080306 ! 212: RVCORR = 0.0 02090306 ! 213: 40050 IF (RVCOMP) 20050, 10050, 20050 02100306 ! 214: 30050 IVDELE = IVDELE + 1 02110306 ! 215: WRITE (I02,80000) IVTNUM 02120306 ! 216: IF (ICZERO) 10050, 0061, 20050 02130306 ! 217: 10050 IVPASS = IVPASS + 1 02140306 ! 218: WRITE (I02,80002) IVTNUM 02150306 ! 219: GO TO 0061 02160306 ! 220: 20050 IVFAIL = IVFAIL + 1 02170306 ! 221: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02180306 ! 222: 0061 CONTINUE 02190306 ! 223: C 02200306 ! 224: C **** FCVS PROGRAM 306 - TEST 006 **** 02210306 ! 225: C 02220306 ! 226: C TEST 006 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF REAL 02230306 ! 227: C WITH IMPLICIT TYPING OF LOGICAL. 02240306 ! 228: C 02250306 ! 229: IVTNUM = 6 02260306 ! 230: IF (ICZERO) 30060, 0060, 30060 02270306 ! 231: 0060 CONTINUE 02280306 ! 232: BVIN01 = .TRUE. 02290306 ! 233: IVCORR = 1 02300306 ! 234: IVCOMP = 0 02310306 ! 235: IF (BVIN01) IVCOMP = 1 02320306 ! 236: 40060 IF (IVCOMP - 1) 20060, 10060, 20060 02330306 ! 237: 30060 IVDELE = IVDELE + 1 02340306 ! 238: WRITE (I02,80000) IVTNUM 02350306 ! 239: IF (ICZERO) 10060, 0071, 20060 02360306 ! 240: 10060 IVPASS = IVPASS + 1 02370306 ! 241: WRITE (I02,80002) IVTNUM 02380306 ! 242: GO TO 0071 02390306 ! 243: 20060 IVFAIL = IVFAIL + 1 02400306 ! 244: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02410306 ! 245: 0071 CONTINUE 02420306 ! 246: C 02430306 ! 247: C TESTS 007 THROUGH 012 ARE DESIGNED TO TEST VARIOUS SYNTACTICAL 02440306 ! 248: C CONSTRUCTS OF THE IMPLICIT STATEMENT. 02450306 ! 249: C 02460306 ! 250: C 02470306 ! 251: C **** FCVS PROGRAM 306 - TEST 007 **** 02480306 ! 252: C 02490306 ! 253: C TEST 007 TESTS THE SPECIFYING OF MORE THAN ONE ALPHABETIC 02500306 ! 254: C CHARACTER IN AN IMPLICIT STATEMENT. 02510306 ! 255: C 02520306 ! 256: IVTNUM = 7 02530306 ! 257: IF (ICZERO) 30070, 0070, 30070 02540306 ! 258: 0070 CONTINUE 02550306 ! 259: DVIN01 = 4 02560306 ! 260: EVIN01 = 4 02570306 ! 261: FVIN01 = 4 02580306 ! 262: RVCMP1 = DVIN01/5 02590306 ! 263: RVCMP2 = EVIN01/5 02600306 ! 264: RVCMP3 = FVIN01/5 02610306 ! 265: IVCOMP = 1 02620306 ! 266: IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 02630306 ! 267: IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 02640306 ! 268: IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 02650306 ! 269: IVCORR = 30 02660306 ! 270: C 30 = 2 * 3 * 5 02670306 ! 271: 40070 IF (IVCOMP - 30) 20070, 10070, 20070 02680306 ! 272: 30070 IVDELE = IVDELE + 1 02690306 ! 273: WRITE (I02,80000) IVTNUM 02700306 ! 274: IF (ICZERO) 10070, 0081, 20070 02710306 ! 275: 10070 IVPASS = IVPASS + 1 02720306 ! 276: WRITE (I02,80002) IVTNUM 02730306 ! 277: GO TO 0081 02740306 ! 278: 20070 IVFAIL = IVFAIL + 1 02750306 ! 279: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02760306 ! 280: 0081 CONTINUE 02770306 ! 281: C 02780306 ! 282: C **** FCVS PROGRAM 306 - TEST 008 **** 02790306 ! 283: C 02800306 ! 284: C TEST 008 TESTS THE SPECIFYING A RANGE OF SINGLE LETTERS IN 02810306 ! 285: C ALPHABETIC ORDER IN AN IMPLICIT STATEMENT. 02820306 ! 286: C 02830306 ! 287: IVTNUM = 8 02840306 ! 288: IF (ICZERO) 30080, 0080, 30080 02850306 ! 289: 0080 CONTINUE 02860306 ! 290: GVIN01 = 4 02870306 ! 291: HAIN11(4) = 4 02880306 ! 292: RVCMP1 = GVIN01/5 02890306 ! 293: RVCMP2 = HAIN11(4)/5 02900306 ! 294: IVCOMP = 1 02910306 ! 295: IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 02920306 ! 296: IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 02930306 ! 297: IVCORR = 6 02940306 ! 298: C 6 = 2 * 3 02950306 ! 299: 40080 IF (IVCOMP - 6) 20080, 10080, 20080 02960306 ! 300: 30080 IVDELE = IVDELE + 1 02970306 ! 301: WRITE (I02,80000) IVTNUM 02980306 ! 302: IF (ICZERO) 10080, 0091, 20080 02990306 ! 303: 10080 IVPASS = IVPASS + 1 03000306 ! 304: WRITE (I02,80002) IVTNUM 03010306 ! 305: GO TO 0091 03020306 ! 306: 20080 IVFAIL = IVFAIL + 1 03030306 ! 307: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03040306 ! 308: 0091 CONTINUE 03050306 ! 309: C 03060306 ! 310: C **** FCVS PROGRAM 306 - TEST 009 **** 03070306 ! 311: C 03080306 ! 312: C TEST 009 TESTS THE SPECIFYING A SINGLE LETTER AND A RANGE OF 03090306 ! 313: C SINGLE LETTERS IN ALPHABETIC ORDER IN AN IMPLICIT STATEMENT. 03100306 ! 314: C 03110306 ! 315: IVTNUM = 9 03120306 ! 316: IF (ICZERO) 30090, 0090, 30090 03130306 ! 317: 0090 CONTINUE 03140306 ! 318: KVIN01 = 4 03150306 ! 319: OVIN01 = 4 03160306 ! 320: PVIN01 = 4 03170306 ! 321: QVIN01 = 4 03180306 ! 322: RVCMP1 = KVIN01/5 03190306 ! 323: RVCMP2 = OVIN01/5 03200306 ! 324: RVCMP3 = PVIN01/5 03210306 ! 325: RVCMP4 = QVIN01/5 03220306 ! 326: IVCOMP = 1 03230306 ! 327: IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 03240306 ! 328: IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 03250306 ! 329: IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 03260306 ! 330: IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7 03270306 ! 331: IVCORR = 210 03280306 ! 332: C 210 = 2 * 3 * 5 * 7 03290306 ! 333: 40090 IF (IVCOMP - 210) 20090, 10090, 20090 03300306 ! 334: 30090 IVDELE = IVDELE + 1 03310306 ! 335: WRITE (I02,80000) IVTNUM 03320306 ! 336: IF (ICZERO) 10090, 0101, 20090 03330306 ! 337: 10090 IVPASS = IVPASS + 1 03340306 ! 338: WRITE (I02,80002) IVTNUM 03350306 ! 339: GO TO 0101 03360306 ! 340: 20090 IVFAIL = IVFAIL + 1 03370306 ! 341: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03380306 ! 342: 0101 CONTINUE 03390306 ! 343: C 03400306 ! 344: C **** FCVS PROGRAM 306 - TEST 010 **** 03410306 ! 345: C 03420306 ! 346: C TEST 010 TESTS THE SPECIFYING OF MORE THAN ONE TYPING IN ONE 03430306 ! 347: C IMPLICIT STATEMENT. 03440306 ! 348: C 03450306 ! 349: IVTNUM = 10 03460306 ! 350: IF (ICZERO) 30100, 0100, 30100 03470306 ! 351: 0100 CONTINUE 03480306 ! 352: SVIN01 = 4 03490306 ! 353: TVIN01 = 4 03500306 ! 354: UVIN01 = 4 03510306 ! 355: VVIN01 = 4 03520306 ! 356: RVCMP1 = SVIN01/5 03530306 ! 357: RVCMP2 = TVIN01/5 03540306 ! 358: RVCMP3 = UVIN01/5 03550306 ! 359: RVCMP4 = VVIN01/5 03560306 ! 360: IVCOMP = 1 03570306 ! 361: IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 03580306 ! 362: IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 03590306 ! 363: IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 03600306 ! 364: IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7 03610306 ! 365: IVCORR = 210 03620306 ! 366: C 210 = 2 * 3 * 5 * 7 03630306 ! 367: IF (IVCOMP - 210) 20100, 10100, 20100 03640306 ! 368: 30100 IVDELE = IVDELE + 1 03650306 ! 369: WRITE (I02,80000) IVTNUM 03660306 ! 370: IF (ICZERO) 10100, 0111, 20100 03670306 ! 371: 10100 IVPASS = IVPASS + 1 03680306 ! 372: WRITE (I02,80002) IVTNUM 03690306 ! 373: GO TO 0111 03700306 ! 374: 20100 IVFAIL = IVFAIL + 1 03710306 ! 375: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720306 ! 376: 0111 CONTINUE 03730306 ! 377: C 03740306 ! 378: C **** FCVS PROGRAM 306 - TEST 011 **** 03750306 ! 379: C 03760306 ! 380: C TEST 011 TESTS THE SPECIFYING OF INTEGER, REAL, AND LOGICAL 03770306 ! 381: C TYPING IN ONE IMPLICIT STATEMENT. IN THIS TEST INTEGER TYPING 03780306 ! 382: C IS REPEATED A SECOND TIME. 03790306 ! 383: C 03800306 ! 384: IVTNUM = 11 03810306 ! 385: IF (ICZERO) 30110, 0110, 30110 03820306 ! 386: 0110 CONTINUE 03830306 ! 387: WVIN01 = 4 03840306 ! 388: XVIN01 = 4 03850306 ! 389: YVIN01 = .TRUE. 03860306 ! 390: ZVIN01 = 4 03870306 ! 391: RVCMP1 = WVIN01/5 03880306 ! 392: RVCMP2 = XVIN01/5 03890306 ! 393: LVCOMP = YVIN01 03900306 ! 394: RVCMP3 = ZVIN01/5 03910306 ! 395: IVCOMP = 1 03920306 ! 396: IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 03930306 ! 397: IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 03940306 ! 398: IF (LVCOMP) IVCOMP = IVCOMP * 5 03950306 ! 399: IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 7 03960306 ! 400: IVCORR = 210 03970306 ! 401: C 210 = 2 * 3 * 5 * 7 03980306 ! 402: 40110 IF (IVCOMP - 210) 20110, 10110, 20110 03990306 ! 403: 30110 IVDELE = IVDELE + 1 04000306 ! 404: WRITE (I02,80000) IVTNUM 04010306 ! 405: IF (ICZERO) 10110, 0121, 20110 04020306 ! 406: 10110 IVPASS = IVPASS + 1 04030306 ! 407: WRITE (I02,80002) IVTNUM 04040306 ! 408: GO TO 0121 04050306 ! 409: 20110 IVFAIL = IVFAIL + 1 04060306 ! 410: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04070306 ! 411: 0121 CONTINUE 04080306 ! 412: C 04090306 ! 413: C **** FCVS PROGRAM 306 - TEST 012 **** 04100306 ! 414: C 04110306 ! 415: C TEST 012 TESTS THE SPECIFYING OF REAL TYPING TWICE IN ONE 04120306 ! 416: C IMPLICIT STATEMENT. 04130306 ! 417: C 04140306 ! 418: IVTNUM = 12 04150306 ! 419: IF (ICZERO) 30120, 0120, 30120 04160306 ! 420: 0120 CONTINUE 04170306 ! 421: MVIN01 = 4 04180306 ! 422: NVIN01 = 4 04190306 ! 423: RVCMP1 = MVIN01/5 04200306 ! 424: RVCMP2 = NVIN01/5 04210306 ! 425: IVCOMP = 1 04220306 ! 426: IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 04230306 ! 427: IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 04240306 ! 428: IVCORR = 6 04250306 ! 429: C 6 = 2 * 3 04260306 ! 430: IF (IVCOMP - 6) 20120, 10120, 20120 04270306 ! 431: 30120 IVDELE = IVDELE + 1 04280306 ! 432: WRITE (I02,80000) IVTNUM 04290306 ! 433: IF (ICZERO) 10120, 0131, 20120 04300306 ! 434: 10120 IVPASS = IVPASS + 1 04310306 ! 435: WRITE (I02,80002) IVTNUM 04320306 ! 436: GO TO 0131 04330306 ! 437: 20120 IVFAIL = IVFAIL + 1 04340306 ! 438: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04350306 ! 439: 0131 CONTINUE 04360306 ! 440: C 04370306 ! 441: C 04380306 ! 442: C WRITE OUT TEST SUMMARY 04390306 ! 443: C 04400306 ! 444: WRITE (I02,90004) 04410306 ! 445: WRITE (I02,90014) 04420306 ! 446: WRITE (I02,90004) 04430306 ! 447: WRITE (I02,90000) 04440306 ! 448: WRITE (I02,90004) 04450306 ! 449: WRITE (I02,90020) IVFAIL 04460306 ! 450: WRITE (I02,90022) IVPASS 04470306 ! 451: WRITE (I02,90024) IVDELE 04480306 ! 452: STOP 04490306 ! 453: 90001 FORMAT (1H ,24X,5HFM306) 04500306 ! 454: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM306) 04510306 ! 455: C 04520306 ! 456: C FORMATS FOR TEST DETAIL LINES 04530306 ! 457: C 04540306 ! 458: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 04550306 ! 459: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 04560306 ! 460: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 04570306 ! 461: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 04580306 ! 462: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 04590306 ! 463: C 04600306 ! 464: C FORMAT STATEMENTS FOR PAGE HEADERS 04610306 ! 465: C 04620306 ! 466: 90002 FORMAT (1H1) 04630306 ! 467: 90004 FORMAT (1H ) 04640306 ! 468: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04650306 ! 469: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 04660306 ! 470: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 04670306 ! 471: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 04680306 ! 472: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 04690306 ! 473: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 04700306 ! 474: C 04710306 ! 475: C FORMAT STATEMENTS FOR RUN SUMMARY 04720306 ! 476: C 04730306 ! 477: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 04740306 ! 478: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 04750306 ! 479: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 04760306 ! 480: END 04770306
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.