|
|
1.1 ! root 1: PROGRAM FM251 00010251 ! 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 00020251 ! 6: C 00030251 ! 7: C 00040251 ! 8: C THIS ROUTINE TESTS THE IMPLICIT STATEMENT FOR DECLARING 00050251 ! 9: C VARIABLES AS TYPE LOGICAL. THE TYPE OF A VARIABLE ( LOGICAL, 00060251 ! 10: C INTEGER, OR REAL ) IS SET BY BOTH IMPLICIT STATEMENTS AND ALSO 00070251 ! 11: C BY EXPLICIT TYPE STATEMENTS. TESTS ARE MADE TO CHECK THAT 00080251 ! 12: C EXPLICIT TYPE STATEMENTS OVERIDE THE TYPE SET BY AN IMPLICIT 00090251 ! 13: C STATEMENT FOR THE VARIABLES LISTED. 00100251 ! 14: C 00110251 ! 15: C REFERENCES 00120251 ! 16: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130251 ! 17: C X3.9-1977 00140251 ! 18: C SECTION 4.7, LOGICAL TYPE 00150251 ! 19: C SECTION 8.4.1, LOGICAL TYPE STAEMENT 00160251 ! 20: C SECTION 8.5, IMPLICIT STATEMENT 00170251 ! 21: C SECTION 11.5, LOGICAL IF STATEMENT 00180251 ! 22: C 00190251 ! 23: C 00200251 ! 24: C FM016 - TESTS LOGICAL TYPE STATEMENTS WITH VARIOUS FORMS OF 00210251 ! 25: C LOGICAL CONSTANTS AND VARIABLES. 00220251 ! 26: C 00230251 ! 27: C 00240251 ! 28: C 00250251 ! 29: C 00260251 ! 30: C ******************************************************************00270251 ! 31: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00280251 ! 32: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00290251 ! 33: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00300251 ! 34: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00310251 ! 35: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00320251 ! 36: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00330251 ! 37: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00340251 ! 38: C THE RESULT OF EXECUTING THESE TESTS. 00350251 ! 39: C 00360251 ! 40: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00370251 ! 41: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00380251 ! 42: C 00390251 ! 43: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00400251 ! 44: C DEPARTMENT OF THE NAVY 00410251 ! 45: C FEDERAL COBOL COMPILER TESTING SERVICE 00420251 ! 46: C WASHINGTON, D.C. 20376 00430251 ! 47: C 00440251 ! 48: C ******************************************************************00450251 ! 49: C 00460251 ! 50: C 00470251 ! 51: IMPLICIT LOGICAL (L) 00480251 ! 52: IMPLICIT CHARACTER*14 (C) 00490251 ! 53: C 00500251 ! 54: IMPLICIT LOGICAL (M,N) 00510251 ! 55: IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 00520251 ! 56: IMPLICIT INTEGER (A, B), REAL (I, J) 00530251 ! 57: INTEGER IVCOMP, IVPASS, IVCORR, IVTNUM, IVDELE, IVFAIL, I01, I02 00540251 ! 58: INTEGER ICZERO 00550251 ! 59: INTEGER MVTN01 00560251 ! 60: REAL NVTN01 00570251 ! 61: LOGICAL MVTN02, NVTN02, MATN21(3,3) 00580251 ! 62: LOGICAL AVTN01 00590251 ! 63: LOGICAL IVTN01 00600251 ! 64: C 00610251 ! 65: C 00620251 ! 66: C 00630251 ! 67: C INITIALIZATION SECTION. 00640251 ! 68: C 00650251 ! 69: C INITIALIZE CONSTANTS 00660251 ! 70: C ******************** 00670251 ! 71: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00680251 ! 72: I01 = 5 00690251 ! 73: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00700251 ! 74: I02 = 6 00710251 ! 75: C SYSTEM ENVIRONMENT SECTION 00720251 ! 76: C 00730251 ! 77: I01 = 5 00740251 ! 78: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750251 ! 79: C (UNIT NUMBER FOR CARD READER). 00760251 ! 80: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00770251 ! 81: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780251 ! 82: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790251 ! 83: C 00800251 ! 84: I02 = 6 00810251 ! 85: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820251 ! 86: C (UNIT NUMBER FOR PRINTER). 00830251 ! 87: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00840251 ! 88: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850251 ! 89: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860251 ! 90: C 00870251 ! 91: IVPASS = 0 00880251 ! 92: IVFAIL = 0 00890251 ! 93: IVDELE = 0 00900251 ! 94: ICZERO = 0 00910251 ! 95: C 00920251 ! 96: C WRITE OUT PAGE HEADERS 00930251 ! 97: C 00940251 ! 98: WRITE (I02,90002) 00950251 ! 99: WRITE (I02,90006) 00960251 ! 100: WRITE (I02,90008) 00970251 ! 101: WRITE (I02,90004) 00980251 ! 102: WRITE (I02,90010) 00990251 ! 103: WRITE (I02,90004) 01000251 ! 104: WRITE (I02,90016) 01010251 ! 105: WRITE (I02,90001) 01020251 ! 106: WRITE (I02,90004) 01030251 ! 107: WRITE (I02,90012) 01040251 ! 108: WRITE (I02,90014) 01050251 ! 109: WRITE (I02,90004) 01060251 ! 110: C 01070251 ! 111: C 01080251 ! 112: C **** FCVS PROGRAM 251 - TEST 001 **** 01090251 ! 113: C 01100251 ! 114: C TEST 001 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVIN01 WHICH WAS 01110251 ! 115: C SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01120251 ! 116: C IMPLICIT LOGICAL (M,N) 01130251 ! 117: C 01140251 ! 118: IVTNUM = 1 01150251 ! 119: IF (ICZERO) 30010, 0010, 30010 01160251 ! 120: 0010 CONTINUE 01170251 ! 121: IVCOMP = 0 01180251 ! 122: MVIN01 = .TRUE. 01190251 ! 123: IF ( MVIN01 ) IVCOMP = 1 01200251 ! 124: IVCORR = 1 01210251 ! 125: 40010 IF ( IVCOMP - 1 ) 20010, 10010, 20010 01220251 ! 126: 30010 IVDELE = IVDELE + 1 01230251 ! 127: WRITE (I02,80000) IVTNUM 01240251 ! 128: IF (ICZERO) 10010, 0021, 20010 01250251 ! 129: 10010 IVPASS = IVPASS + 1 01260251 ! 130: WRITE (I02,80002) IVTNUM 01270251 ! 131: GO TO 0021 01280251 ! 132: 20010 IVFAIL = IVFAIL + 1 01290251 ! 133: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300251 ! 134: 0021 CONTINUE 01310251 ! 135: C 01320251 ! 136: C **** FCVS PROGRAM 251 - TEST 002 **** 01330251 ! 137: C 01340251 ! 138: C TEST 002 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVIN01 WHICH 01350251 ! 139: C WAS SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01360251 ! 140: C IMPLICIT LOGICAL (M,N) 01370251 ! 141: C 01380251 ! 142: IVTNUM = 2 01390251 ! 143: IF (ICZERO) 30020, 0020, 30020 01400251 ! 144: 0020 CONTINUE 01410251 ! 145: IVCOMP = 1 01420251 ! 146: LCON01 = .FALSE. 01430251 ! 147: NVIN01 = LCON01 01440251 ! 148: IF ( NVIN01 ) IVCOMP = 0 01450251 ! 149: IVCORR = 1 01460251 ! 150: 40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 01470251 ! 151: 30020 IVDELE = IVDELE + 1 01480251 ! 152: WRITE (I02,80000) IVTNUM 01490251 ! 153: IF (ICZERO) 10020, 0031, 20020 01500251 ! 154: 10020 IVPASS = IVPASS + 1 01510251 ! 155: WRITE (I02,80002) IVTNUM 01520251 ! 156: GO TO 0031 01530251 ! 157: 20020 IVFAIL = IVFAIL + 1 01540251 ! 158: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01550251 ! 159: 0031 CONTINUE 01560251 ! 160: C 01570251 ! 161: C **** FCVS PROGRAM 251 - TEST 003 **** 01580251 ! 162: C 01590251 ! 163: C TEST 003 ASSIGNS AN INTEGER VALUE OF 4 TO MVTN01 WHICH 01600251 ! 164: C WAS SPECIFIED AS TYPE INTEGER EXPLICITLY IN A TYPE STATEMENT. 01610251 ! 165: C INTEGER MVTN01 01620251 ! 166: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT INTEGER TYPE 01630251 ! 167: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01640251 ! 168: C SET THE TYPE AS LOGICAL. 01650251 ! 169: C IMPLICIT LOGICAL (M,N) 01660251 ! 170: C 01670251 ! 171: IVTNUM = 3 01680251 ! 172: IF (ICZERO) 30030, 0030, 30030 01690251 ! 173: 0030 CONTINUE 01700251 ! 174: RVCOMP = 10.0 01710251 ! 175: MVTN01 = 4 01720251 ! 176: RVCOMP = MVTN01/5 01730251 ! 177: RVCORR = 0.0 01740251 ! 178: 40030 IF ( RVCOMP ) 20030, 10030, 20030 01750251 ! 179: 30030 IVDELE = IVDELE + 1 01760251 ! 180: WRITE (I02,80000) IVTNUM 01770251 ! 181: IF (ICZERO) 10030, 0041, 20030 01780251 ! 182: 10030 IVPASS = IVPASS + 1 01790251 ! 183: WRITE (I02,80002) IVTNUM 01800251 ! 184: GO TO 0041 01810251 ! 185: 20030 IVFAIL = IVFAIL + 1 01820251 ! 186: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01830251 ! 187: 0041 CONTINUE 01840251 ! 188: C 01850251 ! 189: C **** FCVS PROGRAM 251 - TEST 004 **** 01860251 ! 190: C 01870251 ! 191: C TEST 004 ASSIGNS A REAL VALUE OF 4.0 TO NVTN01 WHICH 01880251 ! 192: C WAS SPECIFIED AS TYPE REAL EXPLICITLY IN A TYPE STATEMENT. 01890251 ! 193: C REAL NVTN01 01900251 ! 194: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT REAL TYPE 01910251 ! 195: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01920251 ! 196: C SET THE TYPE AS LOGICAL. 01930251 ! 197: C IMPLICIT LOGICAL (M,N) 01940251 ! 198: C 01950251 ! 199: IVTNUM = 4 01960251 ! 200: IF (ICZERO) 30040, 0040, 30040 01970251 ! 201: 0040 CONTINUE 01980251 ! 202: RVCOMP = 10.0 01990251 ! 203: NVTN01 = 4.0 02000251 ! 204: RVCOMP = NVTN01/5 02010251 ! 205: RVCORR = 0.8 02020251 ! 206: 40040 IF ( RVCOMP - 0.79995 ) 20040, 10040, 40041 02030251 ! 207: 40041 IF ( RVCOMP - 0.80005 ) 10040, 10040, 20040 02040251 ! 208: 30040 IVDELE = IVDELE + 1 02050251 ! 209: WRITE (I02,80000) IVTNUM 02060251 ! 210: IF (ICZERO) 10040, 0051, 20040 02070251 ! 211: 10040 IVPASS = IVPASS + 1 02080251 ! 212: WRITE (I02,80002) IVTNUM 02090251 ! 213: GO TO 0051 02100251 ! 214: 20040 IVFAIL = IVFAIL + 1 02110251 ! 215: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02120251 ! 216: 0051 CONTINUE 02130251 ! 217: C 02140251 ! 218: C **** FCVS PROGRAM 251 - TEST 005 **** 02150251 ! 219: C 02160251 ! 220: C TEST 005 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVTN02 WHICH WAS 02170251 ! 221: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02180251 ! 222: C HAVING ITS FIRST LETTER M SPECIFIED AS TYPE LOGICAL IN AN 02190251 ! 223: C IMPLICIT STATEMENT. 02200251 ! 224: C IMPLICIT LOGICAL (M,N) 02210251 ! 225: C LOGICAL MVTN02 02220251 ! 226: C 02230251 ! 227: IVTNUM = 5 02240251 ! 228: IF (ICZERO) 30050, 0050, 30050 02250251 ! 229: 0050 CONTINUE 02260251 ! 230: IVCOMP = 0 02270251 ! 231: LCON02 = .TRUE. 02280251 ! 232: MVTN02 = LCON02 02290251 ! 233: IF ( MVTN02 ) IVCOMP = 1 02300251 ! 234: IVCORR = 1 02310251 ! 235: 40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050 02320251 ! 236: 30050 IVDELE = IVDELE + 1 02330251 ! 237: WRITE (I02,80000) IVTNUM 02340251 ! 238: IF (ICZERO) 10050, 0061, 20050 02350251 ! 239: 10050 IVPASS = IVPASS + 1 02360251 ! 240: WRITE (I02,80002) IVTNUM 02370251 ! 241: GO TO 0061 02380251 ! 242: 20050 IVFAIL = IVFAIL + 1 02390251 ! 243: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02400251 ! 244: 0061 CONTINUE 02410251 ! 245: C 02420251 ! 246: C **** FCVS PROGRAM 251 - TEST 006 **** 02430251 ! 247: C 02440251 ! 248: C TEST 006 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVTN02 WHICH WAS02450251 ! 249: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02460251 ! 250: C HAVING ITS FIRST LETTER N SPECIFIED AS TYPE LOGICAL IN AN 02470251 ! 251: C IMPLICIT STATEMENT. 02480251 ! 252: C IMPLICIT LOGICAL (M,N) 02490251 ! 253: C LOGICAL NVTN02 02500251 ! 254: C 02510251 ! 255: IVTNUM = 6 02520251 ! 256: IF (ICZERO) 30060, 0060, 30060 02530251 ! 257: 0060 CONTINUE 02540251 ! 258: IVCOMP = 1 02550251 ! 259: NVTN02 = .FALSE. 02560251 ! 260: IF ( NVTN02 ) IVCOMP = 0 02570251 ! 261: IVCORR = 1 02580251 ! 262: 40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060 02590251 ! 263: 30060 IVDELE = IVDELE + 1 02600251 ! 264: WRITE (I02,80000) IVTNUM 02610251 ! 265: IF (ICZERO) 10060, 0071, 20060 02620251 ! 266: 10060 IVPASS = IVPASS + 1 02630251 ! 267: WRITE (I02,80002) IVTNUM 02640251 ! 268: GO TO 0071 02650251 ! 269: 20060 IVFAIL = IVFAIL + 1 02660251 ! 270: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02670251 ! 271: 0071 CONTINUE 02680251 ! 272: C 02690251 ! 273: C **** FCVS PROGRAM 251 - TEST 007 **** 02700251 ! 274: C 02710251 ! 275: C TEST 007 ASSIGNS A LOGICAL VALUE OF .TRUE. TO THE ARRAY ELEMENT02720251 ! 276: C MATN21(1,1) WHICH WAS SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT 02730251 ! 277: C TYPE STATEMENT AFTER ALSO HAVING ITS FIRST LETTER M SPECIFIED AS 02740251 ! 278: C TYPE LOGICAL IN AN IMPLICIT STATEMENT. 02750251 ! 279: C IMPLICIT LOGICAL (M,N) 02760251 ! 280: C LOGICAL MATN21(3,3) 02770251 ! 281: C 02780251 ! 282: IVTNUM = 7 02790251 ! 283: IF (ICZERO) 30070, 0070, 30070 02800251 ! 284: 0070 CONTINUE 02810251 ! 285: IVCOMP = 0 02820251 ! 286: MATN21(1,1) = .TRUE. 02830251 ! 287: IF ( MATN21(1,1) ) IVCOMP = 1 02840251 ! 288: IVCORR = 1 02850251 ! 289: 40070 IF ( IVCOMP - 1 ) 20070, 10070, 20070 02860251 ! 290: 30070 IVDELE = IVDELE + 1 02870251 ! 291: WRITE (I02,80000) IVTNUM 02880251 ! 292: IF (ICZERO) 10070, 0081, 20070 02890251 ! 293: 10070 IVPASS = IVPASS + 1 02900251 ! 294: WRITE (I02,80002) IVTNUM 02910251 ! 295: GO TO 0081 02920251 ! 296: 20070 IVFAIL = IVFAIL + 1 02930251 ! 297: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02940251 ! 298: 0081 CONTINUE 02950251 ! 299: C 02960251 ! 300: C **** FCVS PROGRAM 251 - TEST 008 **** 02970251 ! 301: C 02980251 ! 302: C TEST 008 ASSIGNS AN INTEGER VALUE OF 4 TO AVIN01 WHICH WAS 02990251 ! 303: C SPECIFIED AS TYPE INTEGER IN AN IMPLICIT STATEMENT. 03000251 ! 304: C IMPLICIT INTEGER (A,B) 03010251 ! 305: C 03020251 ! 306: IVTNUM = 8 03030251 ! 307: IF (ICZERO) 30080, 0080, 30080 03040251 ! 308: 0080 CONTINUE 03050251 ! 309: RVCOMP = 10.0 03060251 ! 310: AVIN01 = 4 03070251 ! 311: RVCOMP = AVIN01/5 03080251 ! 312: RVCORR = 0.0 03090251 ! 313: 40080 IF ( RVCOMP ) 20080, 10080, 20080 03100251 ! 314: 30080 IVDELE = IVDELE + 1 03110251 ! 315: WRITE (I02,80000) IVTNUM 03120251 ! 316: IF (ICZERO) 10080, 0091, 20080 03130251 ! 317: 10080 IVPASS = IVPASS + 1 03140251 ! 318: WRITE (I02,80002) IVTNUM 03150251 ! 319: GO TO 0091 03160251 ! 320: 20080 IVFAIL = IVFAIL + 1 03170251 ! 321: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180251 ! 322: 0091 CONTINUE 03190251 ! 323: C 03200251 ! 324: C **** FCVS PROGRAM 251 - TEST 009 **** 03210251 ! 325: C 03220251 ! 326: C TEST 009 ASSIGNS A LOGICAL VALUE OF .TRUE. TO AVTN01 WHICH WAS 03230251 ! 327: C SPECIFIED AS TYPE LOGICAL EXPLICITLY IN A TYPE STATEMENT. 03240251 ! 328: C LOGICAL AVTN01 03250251 ! 329: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT LOGICAL TYPE 03260251 ! 330: C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 03270251 ! 331: C SET THE TYPE AS INTEGER. 03280251 ! 332: C IMPLICIT INTEGER (A,B) 03290251 ! 333: C 03300251 ! 334: IVTNUM = 9 03310251 ! 335: IF (ICZERO) 30090, 0090, 30090 03320251 ! 336: 0090 CONTINUE 03330251 ! 337: IVCOMP = 0 03340251 ! 338: AVTN01 = .TRUE. 03350251 ! 339: IF ( AVTN01 ) IVCOMP = 1 03360251 ! 340: IVCORR = 1 03370251 ! 341: 40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 03380251 ! 342: 30090 IVDELE = IVDELE + 1 03390251 ! 343: WRITE (I02,80000) IVTNUM 03400251 ! 344: IF (ICZERO) 10090, 0101, 20090 03410251 ! 345: 10090 IVPASS = IVPASS + 1 03420251 ! 346: WRITE (I02,80002) IVTNUM 03430251 ! 347: GO TO 0101 03440251 ! 348: 20090 IVFAIL = IVFAIL + 1 03450251 ! 349: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03460251 ! 350: 0101 CONTINUE 03470251 ! 351: C 03480251 ! 352: C **** FCVS PROGRAM 251 - TEST 010 **** 03490251 ! 353: C 03500251 ! 354: C TEST 010 ASSIGNS A REAL VALUE OF 4.0 TO IVIN01 WHICH WAS 03510251 ! 355: C SPECIFIED AS REAL IMPLICITLY IN AN IMPLICIT STATEMENT. 03520251 ! 356: C IMPLICIT REAL (I,J) 03530251 ! 357: C 03540251 ! 358: IVTNUM = 10 03550251 ! 359: IF (ICZERO) 30100, 0100, 30100 03560251 ! 360: 0100 CONTINUE 03570251 ! 361: RVCOMP = 10.0 03580251 ! 362: IVIN01 = 4.0 03590251 ! 363: RVCOMP = IVIN01/5 03600251 ! 364: RVCORR = 0.8 03610251 ! 365: 40100 IF ( RVCOMP - 0.79995 ) 20100, 10100, 40101 03620251 ! 366: 40101 IF ( RVCOMP - 0.80005 ) 10100, 10100, 20100 03630251 ! 367: 30100 IVDELE = IVDELE + 1 03640251 ! 368: WRITE (I02,80000) IVTNUM 03650251 ! 369: IF (ICZERO) 10100, 0111, 20100 03660251 ! 370: 10100 IVPASS = IVPASS + 1 03670251 ! 371: WRITE (I02,80002) IVTNUM 03680251 ! 372: GO TO 0111 03690251 ! 373: 20100 IVFAIL = IVFAIL + 1 03700251 ! 374: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03710251 ! 375: 0111 CONTINUE 03720251 ! 376: C 03730251 ! 377: C **** FCVS PROGRAM 251 - TEST 011 **** 03740251 ! 378: C 03750251 ! 379: C TEST 011 ASSIGNS A LOGICAL VALUE OF .FALSE. TO IVTN01 WHICH WAS03760251 ! 380: C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT. 03770251 ! 381: C LOGICAL IVTN01 03780251 ! 382: C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT TYPE STATEMENT 03790251 ! 383: C CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD SET THE TYPE 03800251 ! 384: C AS REAL. 03810251 ! 385: C IMPLICIT REAL (I,J) 03820251 ! 386: C 03830251 ! 387: IVTNUM = 11 03840251 ! 388: IF (ICZERO) 30110, 0110, 30110 03850251 ! 389: 0110 CONTINUE 03860251 ! 390: IVCOMP = 1 03870251 ! 391: IVTN01 = .FALSE. 03880251 ! 392: IF ( IVTN01 ) IVCOMP = 0 03890251 ! 393: IVCORR = 1 03900251 ! 394: 40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110 03910251 ! 395: 30110 IVDELE = IVDELE + 1 03920251 ! 396: WRITE (I02,80000) IVTNUM 03930251 ! 397: IF (ICZERO) 10110, 0121, 20110 03940251 ! 398: 10110 IVPASS = IVPASS + 1 03950251 ! 399: WRITE (I02,80002) IVTNUM 03960251 ! 400: GO TO 0121 03970251 ! 401: 20110 IVFAIL = IVFAIL + 1 03980251 ! 402: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03990251 ! 403: 0121 CONTINUE 04000251 ! 404: C 04010251 ! 405: C 04020251 ! 406: C THE NEXT TWO TESTS CHECK THE RANGE OF LETTERS THAT 04030251 ! 407: C ARE SET BY THE IMPLICIT STATEMENT AS FOLLOWS - 04040251 ! 408: C IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 04050251 ! 409: C 04060251 ! 410: C 04070251 ! 411: C 04080251 ! 412: C **** FCVS PROGRAM 251 - TEST 012 **** 04090251 ! 413: C 04100251 ! 414: C TEST 012 ASSIGNS A LOGICAL VALUE OF .TRUE. TO A SERIES OF 04110251 ! 415: C VARIABLES THAT BEGIN WITH THE FOLLOWING LETTERS - 04120251 ! 416: C 04130251 ! 417: C E F G H O P Q S T X Y 04140251 ! 418: C 04150251 ! 419: C VARIABLES THAT BEGIN WITH THESE LETTERS SHOULD BE IMPLICITLY TYPED04160251 ! 420: C LOGICAL BECAUSE OF THE IMPLICIT STATEMENT USING BOTH THE RANGE AND04170251 ! 421: C SINGLE LETTER SPECIFICATION FOR TYPE LOGICAL. THE VARIABLE XVIN0104180251 ! 422: C IS FIRST USED IN A LOGICAL IF STATEMENT. THE TRUE BRANCH SHOULD 04190251 ! 423: C BE TAKEN TO SET IVCOMP = 1. THEN EACH OF THE VARIABLES SET TO 04200251 ! 424: C .TRUE. ARE USED IN A SECOND LOGICAL IF STATEMENT WHICH IS ONE 04210251 ! 425: C LARGE LOGICAL CONJUNCTION ( VARIABLE .AND. VARIABLE .AND. ... ). 04220251 ! 426: C THE TRUE BRANCH SHOULD BE TAKEN TO INCREMENT THE VALUE OF IVCOMP 04230251 ! 427: C TO A FINAL VALUE OF THREE (3). 04240251 ! 428: C 04250251 ! 429: C 04260251 ! 430: IVTNUM = 12 04270251 ! 431: IF (ICZERO) 30120, 0120, 30120 04280251 ! 432: 0120 CONTINUE 04290251 ! 433: IVCOMP = 0 04300251 ! 434: IVCORR = 3 04310251 ! 435: EVIN01 = .TRUE. 04320251 ! 436: FVIN01 = .TRUE. 04330251 ! 437: GVIN01 = .TRUE. 04340251 ! 438: HVIN01 = .TRUE. 04350251 ! 439: OVIN01 = .TRUE. 04360251 ! 440: PVIN01 = .TRUE. 04370251 ! 441: QVIN01 = .TRUE. 04380251 ! 442: SVIN01 = .TRUE. 04390251 ! 443: TVIN01 = .TRUE. 04400251 ! 444: XVIN01 = .TRUE. 04410251 ! 445: YVIN01 = .TRUE. 04420251 ! 446: IF ( XVIN01 ) IVCOMP = 1 04430251 ! 447: IF ( EVIN01 .AND. FVIN01 .AND. GVIN01 .AND. HVIN01 .AND. OVIN01 04440251 ! 448: 1.AND. PVIN01 .AND. QVIN01 .AND. SVIN01 .AND. TVIN01 .AND. XVIN01 04450251 ! 449: 2.AND. YVIN01 ) IVCOMP = IVCOMP + 2 04460251 ! 450: 40120 IF ( IVCOMP - 3 ) 20120, 10120, 20120 04470251 ! 451: 30120 IVDELE = IVDELE + 1 04480251 ! 452: WRITE (I02,80000) IVTNUM 04490251 ! 453: IF (ICZERO) 10120, 0131, 20120 04500251 ! 454: 10120 IVPASS = IVPASS + 1 04510251 ! 455: WRITE (I02,80002) IVTNUM 04520251 ! 456: GO TO 0131 04530251 ! 457: 20120 IVFAIL = IVFAIL + 1 04540251 ! 458: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04550251 ! 459: 0131 CONTINUE 04560251 ! 460: C 04570251 ! 461: C **** FCVS PROGRAM 251 - TEST 013 **** 04580251 ! 462: C 04590251 ! 463: C TEST 013 ASSIGNS AN INTEGER VALUE OF 4 TO VVIN01 WHICH 04600251 ! 464: C WAS SPECIFIED AS TYPE INTEGER IMPLICITLY USING THE RANGE OF 04610251 ! 465: C LETTERS U-W IN THE IMPLICIT INTEGER SPECIFICATION STATEMENT. 04620251 ! 466: C DIVISION IS USED TO DETERMINE WHETHER VVIN01 IS TYPE INTEGER. 04630251 ! 467: C 04640251 ! 468: C 04650251 ! 469: IVTNUM = 13 04660251 ! 470: IF (ICZERO) 30130, 0130, 30130 04670251 ! 471: 0130 CONTINUE 04680251 ! 472: RVCOMP = 10.0 04690251 ! 473: VVIN01 = 4 04700251 ! 474: RVCOMP = VVIN01/5 04710251 ! 475: RVCORR = 0.0 04720251 ! 476: 40130 IF ( RVCOMP ) 20130, 10130, 20130 04730251 ! 477: 30130 IVDELE = IVDELE + 1 04740251 ! 478: WRITE (I02,80000) IVTNUM 04750251 ! 479: IF (ICZERO) 10130, 0141, 20130 04760251 ! 480: 10130 IVPASS = IVPASS + 1 04770251 ! 481: WRITE (I02,80002) IVTNUM 04780251 ! 482: GO TO 0141 04790251 ! 483: 20130 IVFAIL = IVFAIL + 1 04800251 ! 484: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04810251 ! 485: 0141 CONTINUE 04820251 ! 486: C 04830251 ! 487: C 04840251 ! 488: C WRITE OUT TEST SUMMARY 04850251 ! 489: C 04860251 ! 490: WRITE (I02,90004) 04870251 ! 491: WRITE (I02,90014) 04880251 ! 492: WRITE (I02,90004) 04890251 ! 493: WRITE (I02,90000) 04900251 ! 494: WRITE (I02,90004) 04910251 ! 495: WRITE (I02,90020) IVFAIL 04920251 ! 496: WRITE (I02,90022) IVPASS 04930251 ! 497: WRITE (I02,90024) IVDELE 04940251 ! 498: STOP 04950251 ! 499: 90001 FORMAT (1H ,24X,5HFM251) 04960251 ! 500: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM251) 04970251 ! 501: C 04980251 ! 502: C FORMATS FOR TEST DETAIL LINES 04990251 ! 503: C 05000251 ! 504: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 05010251 ! 505: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 05020251 ! 506: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 05030251 ! 507: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 05040251 ! 508: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 05050251 ! 509: C 05060251 ! 510: C FORMAT STATEMENTS FOR PAGE HEADERS 05070251 ! 511: C 05080251 ! 512: 90002 FORMAT (1H1) 05090251 ! 513: 90004 FORMAT (1H ) 05100251 ! 514: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05110251 ! 515: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 05120251 ! 516: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 05130251 ! 517: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 05140251 ! 518: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 05150251 ! 519: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 05160251 ! 520: C 05170251 ! 521: C FORMAT STATEMENTS FOR RUN SUMMARY 05180251 ! 522: C 05190251 ! 523: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 05200251 ! 524: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 05210251 ! 525: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 05220251 ! 526: END 05230251
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.