![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM301.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM301.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: PROGRAM FM301 00010301 ! 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 00020301 ! 6: C 00030301 ! 7: C FM301 TESTS THE USE OF THE TYPE-STATEMENT TO EXPLICITLY 00040301 ! 8: C DEFINE THE DATA TYPE FOR VARIABLES, ARRAYS, AND STATEMENT 00050301 ! 9: C FUNCTIONS. ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA 00060301 ! 10: C TYPES ARE TESTED IN THIS ROUTINE. INTEGER AND REAL VARIABLES 00070301 ! 11: C AND ARRAYS ARE TESTED IN A MANNER WHICH BOTH CONFIRMS AND 00080301 ! 12: C OVERRIDES THE IMPLICIT TYPING OF THE DATA ENTITIES. 00090301 ! 13: C 00100301 ! 14: C FM301 DOES NOT ATTEMPT TO TEST ALL OF THE ELEMENTARY SYNTAX 00110301 ! 15: C FORMS OF THE TYPE-STATEMENT. THESE FORMS ARE TESTED ADEQUATELY 00120301 ! 16: C WITHIN THE BOILER PLATE AND OTHER AUDIT PROGRAMS. 00130301 ! 17: C 00140301 ! 18: C REFERENCES. 00150301 ! 19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160301 ! 20: C X3.9-1978 00170301 ! 21: C 00180301 ! 22: C SECTION 4.1, DATA TYPES 00190301 ! 23: C SECTION 8.4, TYPE-STATEMENT 00200301 ! 24: C SECTION 8.5, IMPLICIT STATEMENT 00210301 ! 25: C SECTION 15.4, STATEMENT FUNCTION 00220301 ! 26: C 00230301 ! 27: C 00240301 ! 28: C ******************************************************************00250301 ! 29: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00260301 ! 30: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00270301 ! 31: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00280301 ! 32: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00290301 ! 33: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00300301 ! 34: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00310301 ! 35: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00320301 ! 36: C THE RESULT OF EXECUTING THESE TESTS. 00330301 ! 37: C 00340301 ! 38: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00350301 ! 39: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00360301 ! 40: C 00370301 ! 41: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00380301 ! 42: C DEPARTMENT OF THE NAVY 00390301 ! 43: C FEDERAL COBOL COMPILER TESTING SERVICE 00400301 ! 44: C WASHINGTON, D.C. 20376 00410301 ! 45: C 00420301 ! 46: C ******************************************************************00430301 ! 47: C 00440301 ! 48: C 00450301 ! 49: IMPLICIT LOGICAL (L) 00460301 ! 50: IMPLICIT CHARACTER*14 (C) 00470301 ! 51: C 00480301 ! 52: 00490301 ! 53: C 00500301 ! 54: C *** IMPLICIT STATEMENT FOR TEST 006 *** 00510301 ! 55: C 00520301 ! 56: IMPLICIT LOGICAL (M) 00530301 ! 57: C 00540301 ! 58: C *** IMPLICIT STATEMENT FOR TEST 017 *** 00550301 ! 59: C 00560301 ! 60: IMPLICIT INTEGER (G) 00570301 ! 61: C 00580301 ! 62: C *** IMPLICIT STATEMENT FOR TEST 018 *** 00590301 ! 63: C 00600301 ! 64: IMPLICIT CHARACTER*2 (F) 00610301 ! 65: C 00620301 ! 66: C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00630301 ! 67: C 00640301 ! 68: INTEGER AVTN01 00650301 ! 69: C 00660301 ! 70: C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00670301 ! 71: C 00680301 ! 72: REAL KVTN01 00690301 ! 73: C 00700301 ! 74: C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00710301 ! 75: C 00720301 ! 76: INTEGER KVTN02, AVTN02, KVTN03 00730301 ! 77: C 00740301 ! 78: C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00750301 ! 79: C 00760301 ! 80: REAL AVTN03, AVTN04, KVTN04 00770301 ! 81: C 00780301 ! 82: C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00790301 ! 83: C 00800301 ! 84: LOGICAL HVTN01 00810301 ! 85: C 00820301 ! 86: C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00830301 ! 87: C (ALSO SEE THE IMPLICIT STATEMENTS FOR TEST 006) 00840301 ! 88: C 00850301 ! 89: REAL MVTN01 00860301 ! 90: C 00870301 ! 91: C *** SPECIFICATION STATEMENTS FOR TEST 007 *** 00880301 ! 92: C 00890301 ! 93: INTEGER NVTN11(4) 00900301 ! 94: C 00910301 ! 95: C *** SPECIFICATION STATEMENTS FOR TEST 008 *** 00920301 ! 96: C 00930301 ! 97: REAL NVTN22(2,2) 00940301 ! 98: C 00950301 ! 99: C *** SPECIFICATION STATEMENTS FOR TESTS 009 AND 010 *** 00960301 ! 100: C 00970301 ! 101: INTEGER NVTN33(3,3,3), AVTN15(5) 00980301 ! 102: C 00990301 ! 103: C *** SPECIFICATION STATEMENTS FOR TEST 011 *** 01000301 ! 104: C 01010301 ! 105: DIMENSION NVTN14(5) 01020301 ! 106: INTEGER NVTN14 01030301 ! 107: C 01040301 ! 108: C *** SPECIFICATION STATEMENTS FOR TEST 012 *** 01050301 ! 109: C 01060301 ! 110: DIMENSION AVTN16(4) 01070301 ! 111: INTEGER AVTN16 01080301 ! 112: C 01090301 ! 113: C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 01100301 ! 114: C 01110301 ! 115: CHARACTER CVTN01*14, CATN12(4)*14 01120301 ! 116: C 01130301 ! 117: C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 01140301 ! 118: C 01150301 ! 119: DIMENSION CADN13(6) 01160301 ! 120: CHARACTER CADN13*14 01170301 ! 121: C 01180301 ! 122: C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 01190301 ! 123: C 01200301 ! 124: CHARACTER KVTN05 01210301 ! 125: C 01220301 ! 126: C *** SPECIFICATION STATEMENTS FOR TEST 017 *** 01230301 ! 127: C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 017) 01240301 ! 128: C 01250301 ! 129: CHARACTER GVTN01*3 01260301 ! 130: C 01270301 ! 131: C *** SPECIFICATION STATEMENTS FOR TEST 018 *** 01280301 ! 132: C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 018) 01290301 ! 133: C 01300301 ! 134: CHARACTER FVTN01*3 01310301 ! 135: C 01320301 ! 136: C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01330301 ! 137: C 01340301 ! 138: INTEGER IFTN01 01350301 ! 139: IFTN01(IDON01) = IDON01 + 1 01360301 ! 140: C 01370301 ! 141: C 01380301 ! 142: C 01390301 ! 143: C INITIALIZATION SECTION. 01400301 ! 144: C 01410301 ! 145: C INITIALIZE CONSTANTS 01420301 ! 146: C ******************** 01430301 ! 147: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01440301 ! 148: I01 = 5 01450301 ! 149: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01460301 ! 150: I02 = 6 01470301 ! 151: C SYSTEM ENVIRONMENT SECTION 01480301 ! 152: C 01490301 ! 153: I01 = 5 01500301 ! 154: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01510301 ! 155: C (UNIT NUMBER FOR CARD READER). 01520301 ! 156: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01530301 ! 157: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01540301 ! 158: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01550301 ! 159: C 01560301 ! 160: I02 = 6 01570301 ! 161: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01580301 ! 162: C (UNIT NUMBER FOR PRINTER). 01590301 ! 163: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01600301 ! 164: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01610301 ! 165: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01620301 ! 166: C 01630301 ! 167: IVPASS = 0 01640301 ! 168: IVFAIL = 0 01650301 ! 169: IVDELE = 0 01660301 ! 170: ICZERO = 0 01670301 ! 171: C 01680301 ! 172: C WRITE OUT PAGE HEADERS 01690301 ! 173: C 01700301 ! 174: WRITE (I02,90002) 01710301 ! 175: WRITE (I02,90006) 01720301 ! 176: WRITE (I02,90008) 01730301 ! 177: WRITE (I02,90004) 01740301 ! 178: WRITE (I02,90010) 01750301 ! 179: WRITE (I02,90004) 01760301 ! 180: WRITE (I02,90016) 01770301 ! 181: WRITE (I02,90001) 01780301 ! 182: WRITE (I02,90004) 01790301 ! 183: WRITE (I02,90012) 01800301 ! 184: WRITE (I02,90014) 01810301 ! 185: WRITE (I02,90004) 01820301 ! 186: C 01830301 ! 187: C 01840301 ! 188: C **** FCVS PROGRAM 301 - TEST 001 **** 01850301 ! 189: C 01860301 ! 190: C TEST 001 DEFINES AN INTEGER VARIABLE OVERRIDING THE IMPLICIT 01870301 ! 191: C COMPILER DEFAULT TYPE SPECIFYING REAL. 01880301 ! 192: C 01890301 ! 193: C 01900301 ! 194: IVTNUM = 1 01910301 ! 195: IF (ICZERO) 30010, 0010, 30010 01920301 ! 196: 0010 CONTINUE 01930301 ! 197: IVCOMP = 0 01940301 ! 198: AVTN01 = 100 01950301 ! 199: IVCORR = 100 01960301 ! 200: IVCOMP = AVTN01 01970301 ! 201: 40010 IF (IVCOMP - 100) 20010, 10010, 20010 01980301 ! 202: 30010 IVDELE = IVDELE + 1 01990301 ! 203: WRITE (I02,80000) IVTNUM 02000301 ! 204: IF (ICZERO) 10010, 0021, 20010 02010301 ! 205: 10010 IVPASS = IVPASS + 1 02020301 ! 206: WRITE (I02,80002) IVTNUM 02030301 ! 207: GO TO 0021 02040301 ! 208: 20010 IVFAIL = IVFAIL + 1 02050301 ! 209: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02060301 ! 210: 0021 CONTINUE 02070301 ! 211: C 02080301 ! 212: C **** FCVS PROGRAM 301 - TEST 002 **** 02090301 ! 213: C 02100301 ! 214: C TEST 002 DEFINES A REAL VARIABLE OVERRIDING THE IMPLICIT 02110301 ! 215: C COMPILER DEFAULT TYPE SPECIFYING INTEGER. 02120301 ! 216: C 02130301 ! 217: C 02140301 ! 218: IVTNUM = 2 02150301 ! 219: IF (ICZERO) 30020, 0020, 30020 02160301 ! 220: 0020 CONTINUE 02170301 ! 221: RVCOMP = 0.0 02180301 ! 222: KVTN01 = 1.004 02190301 ! 223: RVCORR = 1.004 02200301 ! 224: RVCOMP = KVTN01 02210301 ! 225: 40020 IF (RVCOMP - 1.0035) 20020, 10020, 40021 02220301 ! 226: 40021 IF (RVCOMP - 1.0045) 10020, 10020, 20020 02230301 ! 227: 30020 IVDELE = IVDELE + 1 02240301 ! 228: WRITE (I02,80000) IVTNUM 02250301 ! 229: IF (ICZERO) 10020, 0031, 20020 02260301 ! 230: 10020 IVPASS = IVPASS + 1 02270301 ! 231: WRITE (I02,80002) IVTNUM 02280301 ! 232: GO TO 0031 02290301 ! 233: 20020 IVFAIL = IVFAIL + 1 02300301 ! 234: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02310301 ! 235: 0031 CONTINUE 02320301 ! 236: C 02330301 ! 237: C **** FCVS PROGRAM 301 - TEST 003 **** 02340301 ! 238: C 02350301 ! 239: C TEST 003 DEFINES A SERIES OF INTEGER VARIABLES IN ONE TYPE- 02360301 ! 240: C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT INTEGER TYPING. 02370301 ! 241: C THE OTHER VARIABLE OVERRIDES THE IMPLICIT TYPING. 02380301 ! 242: C 02390301 ! 243: C 02400301 ! 244: IVTNUM = 3 02410301 ! 245: IF (ICZERO) 30030, 0030, 30030 02420301 ! 246: 0030 CONTINUE 02430301 ! 247: IVCOMP = 0 02440301 ! 248: KVTN02 = 20 02450301 ! 249: KVTN03 = 30 02460301 ! 250: AVTN02 = 200 02470301 ! 251: IVCORR = 20 02480301 ! 252: IVCOMP = KVTN02 02490301 ! 253: 40030 IF (IVCOMP - 20) 20030, 40031, 20030 02500301 ! 254: 40031 IVCORR = 30 02510301 ! 255: IVCOMP = KVTN03 02520301 ! 256: 40033 IF (IVCOMP - 30) 20030, 40034, 20030 02530301 ! 257: 40034 IVCORR = 200 02540301 ! 258: IVCOMP = AVTN02 02550301 ! 259: 40035 IF (IVCOMP - 200) 20030, 10030, 20030 02560301 ! 260: 30030 IVDELE = IVDELE + 1 02570301 ! 261: WRITE (I02,80000) IVTNUM 02580301 ! 262: IF (ICZERO) 10030, 0041, 20030 02590301 ! 263: 10030 IVPASS = IVPASS + 1 02600301 ! 264: WRITE (I02,80002) IVTNUM 02610301 ! 265: GO TO 0041 02620301 ! 266: 20030 IVFAIL = IVFAIL + 1 02630301 ! 267: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02640301 ! 268: 0041 CONTINUE 02650301 ! 269: C 02660301 ! 270: C **** FCVS PROGRAM 301 - TEST 004 **** 02670301 ! 271: C 02680301 ! 272: C TEST 004 DEFINES A SERIES OF REAL VARIABLES IN ONE TYPE- 02690301 ! 273: C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT REAL TYPING. THE 02700301 ! 274: C THIRD VARIABLE OVERRIDES THE IMPLICIT TYPING. 02710301 ! 275: C 02720301 ! 276: C 02730301 ! 277: IVTNUM = 4 02740301 ! 278: IF (ICZERO) 30040, 0040, 30040 02750301 ! 279: 0040 CONTINUE 02760301 ! 280: RVCOMP = 0.0 02770301 ! 281: AVTN03 = 3.0 02780301 ! 282: AVTN04 = 4. 02790301 ! 283: KVTN04 = .4 02800301 ! 284: RVCORR = 3.0 02810301 ! 285: RVCOMP = AVTN03 02820301 ! 286: 40040 IF (RVCOMP - 2.9995) 20040, 40042, 40041 02830301 ! 287: 40041 IF (RVCOMP - 3.0005) 40042, 40042, 20040 02840301 ! 288: 40042 RVCORR = 4. 02850301 ! 289: RVCOMP = AVTN04 02860301 ! 290: 40043 IF (RVCOMP - 3.9995) 20040, 40045, 40044 02870301 ! 291: 40044 IF (RVCOMP - 4.0005) 40045, 40045, 20040 02880301 ! 292: 40045 RVCORR = .4 02890301 ! 293: RVCOMP = KVTN04 02900301 ! 294: 40046 IF (RVCOMP - .39995) 20040, 10040, 40047 02910301 ! 295: 40047 IF (RVCOMP - .40005) 10040, 10040, 20040 02920301 ! 296: 30040 IVDELE = IVDELE + 1 02930301 ! 297: WRITE (I02,80000) IVTNUM 02940301 ! 298: IF (ICZERO) 10040, 0051, 20040 02950301 ! 299: 10040 IVPASS = IVPASS + 1 02960301 ! 300: WRITE (I02,80002) IVTNUM 02970301 ! 301: GO TO 0051 02980301 ! 302: 20040 IVFAIL = IVFAIL + 1 02990301 ! 303: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03000301 ! 304: 0051 CONTINUE 03010301 ! 305: C 03020301 ! 306: C **** FCVS PROGRAM 301 - TEST 005 **** 03030301 ! 307: C 03040301 ! 308: C TEST 005 DEFINES A LOGICAL VARIABLE. 03050301 ! 309: C 03060301 ! 310: C 03070301 ! 311: IVTNUM = 5 03080301 ! 312: IF (ICZERO) 30050, 0050, 30050 03090301 ! 313: 0050 CONTINUE 03100301 ! 314: HVTN01 = .TRUE. 03110301 ! 315: IVCORR = 1 03120301 ! 316: IVCOMP = 0 03130301 ! 317: IF (HVTN01) IVCOMP = 1 03140301 ! 318: 40050 IF (IVCOMP - 1) 20050, 10050, 20050 03150301 ! 319: 30050 IVDELE = IVDELE + 1 03160301 ! 320: WRITE (I02,80000) IVTNUM 03170301 ! 321: IF (ICZERO) 10050, 0061, 20050 03180301 ! 322: 10050 IVPASS = IVPASS + 1 03190301 ! 323: WRITE (I02,80002) IVTNUM 03200301 ! 324: GO TO 0061 03210301 ! 325: 20050 IVFAIL = IVFAIL + 1 03220301 ! 326: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230301 ! 327: 0061 CONTINUE 03240301 ! 328: C 03250301 ! 329: C **** FCVS PROGRAM 301 - TEST 006 **** 03260301 ! 330: C 03270301 ! 331: C TEST 006 DEFINES A REAL VARIABLE WITH A TYPE-STATEMENT THAT 03280301 ! 332: C OVERRIDES THE IMPLICIT STATEMENT TYPING OF THE INTEGER LETTER 'M' 03290301 ! 333: C AS LOGICAL. 03300301 ! 334: C 03310301 ! 335: C 03320301 ! 336: IVTNUM = 6 03330301 ! 337: IF (ICZERO) 30060, 0060, 30060 03340301 ! 338: 0060 CONTINUE 03350301 ! 339: RVCOMP = 0.0 03360301 ! 340: MVTN01 = 12.345 03370301 ! 341: RVCORR = 12.345 03380301 ! 342: RVCOMP = MVTN01 03390301 ! 343: 40060 IF (RVCOMP - 12.340) 20060, 10060, 40061 03400301 ! 344: 40061 IF (RVCOMP - 12.350) 10060, 10060, 20060 03410301 ! 345: 30060 IVDELE = IVDELE + 1 03420301 ! 346: WRITE (I02,80000) IVTNUM 03430301 ! 347: IF (ICZERO) 10060, 0071, 20060 03440301 ! 348: 10060 IVPASS = IVPASS + 1 03450301 ! 349: WRITE (I02,80002) IVTNUM 03460301 ! 350: GO TO 0071 03470301 ! 351: 20060 IVFAIL = IVFAIL + 1 03480301 ! 352: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03490301 ! 353: 0071 CONTINUE 03500301 ! 354: C 03510301 ! 355: C **** FCVS PROGRAM 301 - TEST 007 **** 03520301 ! 356: C 03530301 ! 357: C TEST 007 DEFINES A ONE DIMENSIONAL INTEGER ARRAY. 03540301 ! 358: C 03550301 ! 359: C 03560301 ! 360: IVTNUM = 7 03570301 ! 361: IF (ICZERO) 30070, 0070, 30070 03580301 ! 362: 0070 CONTINUE 03590301 ! 363: IVCOMP = 0 03600301 ! 364: NVTN11(3) = 3 03610301 ! 365: IVCORR = 3 03620301 ! 366: IVCOMP = NVTN11(3) 03630301 ! 367: 40070 IF (IVCOMP - 3) 20070, 10070, 20070 03640301 ! 368: 30070 IVDELE = IVDELE + 1 03650301 ! 369: WRITE (I02,80000) IVTNUM 03660301 ! 370: IF (ICZERO) 10070, 0081, 20070 03670301 ! 371: 10070 IVPASS = IVPASS + 1 03680301 ! 372: WRITE (I02,80002) IVTNUM 03690301 ! 373: GO TO 0081 03700301 ! 374: 20070 IVFAIL = IVFAIL + 1 03710301 ! 375: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720301 ! 376: 0081 CONTINUE 03730301 ! 377: C 03740301 ! 378: C **** FCVS PROGRAM 301 - TEST 008 **** 03750301 ! 379: C 03760301 ! 380: C TEST 008 DEFINES A TWO DIMENSIONAL REAL ARRAY THAT OVERRIDES 03770301 ! 381: C THE IMPLICIT TYPING OF INTEGER. 03780301 ! 382: C 03790301 ! 383: C 03800301 ! 384: IVTNUM = 8 03810301 ! 385: IF (ICZERO) 30080, 0080, 30080 03820301 ! 386: 0080 CONTINUE 03830301 ! 387: RVCOMP = 0.0 03840301 ! 388: NVTN22(1,2) = 2.12 03850301 ! 389: RVCORR = 2.12 03860301 ! 390: RVCOMP = NVTN22(1,2) 03870301 ! 391: 40080 IF (RVCOMP - 2.1195) 20080, 10080, 40081 03880301 ! 392: 40081 IF (RVCOMP - 2.1205) 10080, 10080, 20080 03890301 ! 393: 30080 IVDELE = IVDELE + 1 03900301 ! 394: WRITE (I02,80000) IVTNUM 03910301 ! 395: IF (ICZERO) 10080, 0091, 20080 03920301 ! 396: 10080 IVPASS = IVPASS + 1 03930301 ! 397: WRITE (I02,80002) IVTNUM 03940301 ! 398: GO TO 0091 03950301 ! 399: 20080 IVFAIL = IVFAIL + 1 03960301 ! 400: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03970301 ! 401: 0091 CONTINUE 03980301 ! 402: C 03990301 ! 403: C **** FCVS PROGRAM 301 - TEST 009 **** 04000301 ! 404: C 04010301 ! 405: C TEST 009 DEFINES TWO INTEGER ARRAYS WITH ONE TYPE-STATEMENT. 04020301 ! 406: C ONE ARRAY IS THREE DIMENSIONAL WHILE THE OTHER ARRAY OVERRIDES 04030301 ! 407: C THE IMPLICIT TYPING OF REAL. ONLY THE THREE DIMENSIONAL ARRAY 04040301 ! 408: C IS CHECKED IN THIS TEST. 04050301 ! 409: C 04060301 ! 410: C 04070301 ! 411: IVTNUM = 9 04080301 ! 412: IF (ICZERO) 30090, 0090, 30090 04090301 ! 413: 0090 CONTINUE 04100301 ! 414: IVCOMP = 0 04110301 ! 415: NVTN33(1,2,3) = 123 04120301 ! 416: IVCORR = 123 04130301 ! 417: IVCOMP = NVTN33(1,2,3) 04140301 ! 418: 40090 IF (IVCOMP - 123) 20090, 10090, 20090 04150301 ! 419: 30090 IVDELE = IVDELE + 1 04160301 ! 420: WRITE (I02,80000) IVTNUM 04170301 ! 421: IF (ICZERO) 10090, 0101, 20090 04180301 ! 422: 10090 IVPASS = IVPASS + 1 04190301 ! 423: WRITE (I02,80002) IVTNUM 04200301 ! 424: GO TO 0101 04210301 ! 425: 20090 IVFAIL = IVFAIL + 1 04220301 ! 426: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04230301 ! 427: 0101 CONTINUE 04240301 ! 428: C 04250301 ! 429: C **** FCVS PROGRAM 301 - TEST 010 **** 04260301 ! 430: C 04270301 ! 431: C TEST 010 CHECKS THE SECOND ARRAY DESCRIBED IN THE PREVIOUS 04280301 ! 432: C TEST. 04290301 ! 433: C 04300301 ! 434: C 04310301 ! 435: IVTNUM = 10 04320301 ! 436: IF (ICZERO) 30100, 0100, 30100 04330301 ! 437: 0100 CONTINUE 04340301 ! 438: IVCOMP = 0 04350301 ! 439: AVTN15(2) = 5 04360301 ! 440: IVCORR = 5 04370301 ! 441: IVCOMP = AVTN15(2) 04380301 ! 442: 40100 IF (IVCOMP - 5) 20100, 10100, 20100 04390301 ! 443: 30100 IVDELE = IVDELE + 1 04400301 ! 444: WRITE (I02,80000) IVTNUM 04410301 ! 445: IF (ICZERO) 10100, 0111, 20100 04420301 ! 446: 10100 IVPASS = IVPASS + 1 04430301 ! 447: WRITE (I02,80002) IVTNUM 04440301 ! 448: GO TO 0111 04450301 ! 449: 20100 IVFAIL = IVFAIL + 1 04460301 ! 450: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470301 ! 451: 0111 CONTINUE 04480301 ! 452: C 04490301 ! 453: C **** FCVS PROGRAM 301 - TEST 011 **** 04500301 ! 454: C 04510301 ! 455: C TEST 011 USES THE TYPE-STATEMENT TO EXPLICITLY TYPE AN ARRAY 04520301 ! 456: C THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04530301 ! 457: C 04540301 ! 458: C 04550301 ! 459: IVTNUM = 11 04560301 ! 460: IF (ICZERO) 30110, 0110, 30110 04570301 ! 461: 0110 CONTINUE 04580301 ! 462: IVCOMP = 0 04590301 ! 463: NVTN14(5) = 5 04600301 ! 464: IVCORR = 5 04610301 ! 465: IVCOMP = NVTN14(5) 04620301 ! 466: 40110 IF (IVCOMP - 5) 20110, 10110, 20110 04630301 ! 467: 30110 IVDELE = IVDELE + 1 04640301 ! 468: WRITE (I02,80000) IVTNUM 04650301 ! 469: IF (ICZERO) 10110, 0121, 20110 04660301 ! 470: 10110 IVPASS = IVPASS + 1 04670301 ! 471: WRITE (I02,80002) IVTNUM 04680301 ! 472: GO TO 0121 04690301 ! 473: 20110 IVFAIL = IVFAIL + 1 04700301 ! 474: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04710301 ! 475: 0121 CONTINUE 04720301 ! 476: C 04730301 ! 477: C **** FCVS PROGRAM 301 - TEST 012 **** 04740301 ! 478: C 04750301 ! 479: C TEST 012 USES THE TYPE-STATEMENT TO OVERRIDE THE TYPING OF 04760301 ! 480: C AN ARRAY THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04770301 ! 481: C 04780301 ! 482: IVTNUM = 12 04790301 ! 483: IF (ICZERO) 30120, 0120, 30120 04800301 ! 484: 0120 CONTINUE 04810301 ! 485: IVCOMP = 0 04820301 ! 486: AVTN16(3) = 163 04830301 ! 487: IVCORR = 163 04840301 ! 488: IVCOMP = AVTN16(3) 04850301 ! 489: 40120 IF (IVCOMP - 163) 20120, 10120, 20120 04860301 ! 490: 30120 IVDELE = IVDELE + 1 04870301 ! 491: WRITE (I02,80000) IVTNUM 04880301 ! 492: IF (ICZERO) 10120, 0131, 20120 04890301 ! 493: 10120 IVPASS = IVPASS + 1 04900301 ! 494: WRITE (I02,80002) IVTNUM 04910301 ! 495: GO TO 0131 04920301 ! 496: 20120 IVFAIL = IVFAIL + 1 04930301 ! 497: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940301 ! 498: 0131 CONTINUE 04950301 ! 499: C 04960301 ! 500: C **** FCVS PROGRAM 301 - TEST 013 **** 04970301 ! 501: C 04980301 ! 502: C TEST 013 USES ONE CHARACTER TYPE-STATEMENT TO SPECIFY BOTH A 04990301 ! 503: C VARIABLE AND AN ARRAY DECLARATOR. ONLY THE VARIABLE IS CHECKED 05000301 ! 504: C IN THIS TEST. 05010301 ! 505: C 05020301 ! 506: IVTNUM = 13 05030301 ! 507: IF (ICZERO) 30130, 0130, 30130 05040301 ! 508: 0130 CONTINUE 05050301 ! 509: CVTN01 = '12345678901234' 05060301 ! 510: CVCOMP = ' ' 05070301 ! 511: CVCORR = '12345678901234' 05080301 ! 512: CVCOMP = CVTN01 05090301 ! 513: 40130 IF (CVCOMP .EQ. '12345678901234') GO TO 10130 05100301 ! 514: 40131 GO TO 20130 05110301 ! 515: 30130 IVDELE = IVDELE + 1 05120301 ! 516: WRITE (I02,80000) IVTNUM 05130301 ! 517: IF (ICZERO) 10130, 0141, 20130 05140301 ! 518: 10130 IVPASS = IVPASS + 1 05150301 ! 519: WRITE (I02,80002) IVTNUM 05160301 ! 520: GO TO 0141 05170301 ! 521: 20130 IVFAIL = IVFAIL + 1 05180301 ! 522: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05190301 ! 523: 0141 CONTINUE 05200301 ! 524: C 05210301 ! 525: C **** FCVS PROGRAM 301 - TEST 014 **** 05220301 ! 526: C 05230301 ! 527: C TEST 014 CHECKS THE ARRAY DECLARATOR FROM THE PREVIOUS TEST. 05240301 ! 528: C 05250301 ! 529: IVTNUM = 14 05260301 ! 530: IF (ICZERO) 30140, 0140, 30140 05270301 ! 531: 0140 CONTINUE 05280301 ! 532: CVCOMP = ' ' 05290301 ! 533: CATN12(2) = 'ABCDEFGHIJKLMN' 05300301 ! 534: CVCORR = 'ABCDEFGHIJKLMN' 05310301 ! 535: CVCOMP = CATN12(2) 05320301 ! 536: 40140 IF (CVCOMP .EQ. 'ABCDEFGHIJKLMN') GO TO 10140 05330301 ! 537: 40141 GO TO 20140 05340301 ! 538: 30140 IVDELE = IVDELE + 1 05350301 ! 539: WRITE (I02,80000) IVTNUM 05360301 ! 540: IF (ICZERO) 10140, 0151, 20140 05370301 ! 541: 10140 IVPASS = IVPASS + 1 05380301 ! 542: WRITE (I02,80002) IVTNUM 05390301 ! 543: GO TO 0151 05400301 ! 544: 20140 IVFAIL = IVFAIL + 1 05410301 ! 545: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420301 ! 546: 0151 CONTINUE 05430301 ! 547: C 05440301 ! 548: C **** FCVS PROGRAM 301 - TEST 015 **** 05450301 ! 549: C 05460301 ! 550: C TEST 015 USES THE CHARACTER TYPE-STATEMENT TO SPECIFY AN 05470301 ! 551: C ARRAY-NAME. THE ARRAY IS DECLARED IN A DIMENSION STATEMENT. 05480301 ! 552: C 05490301 ! 553: IVTNUM = 15 05500301 ! 554: IF (ICZERO) 30150, 0150, 30150 05510301 ! 555: 0150 CONTINUE 05520301 ! 556: CVCOMP = ' ' 05530301 ! 557: CADN13(3) = '12345678901234' 05540301 ! 558: CVCORR = '12345678901234' 05550301 ! 559: CVCOMP = CADN13(3) 05560301 ! 560: 40150 IF (CVCOMP .EQ. '12345678901234') GO TO 10150 05570301 ! 561: 40151 GO TO 20150 05580301 ! 562: 30150 IVDELE = IVDELE + 1 05590301 ! 563: WRITE (I02,80000) IVTNUM 05600301 ! 564: IF (ICZERO) 10150, 0161, 20150 05610301 ! 565: 10150 IVPASS = IVPASS + 1 05620301 ! 566: WRITE (I02,80002) IVTNUM 05630301 ! 567: GO TO 0161 05640301 ! 568: 20150 IVFAIL = IVFAIL + 1 05650301 ! 569: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05660301 ! 570: 0161 CONTINUE 05670301 ! 571: C 05680301 ! 572: C **** FCVS PROGRAM 301 - TEST 016 **** 05690301 ! 573: C 05700301 ! 574: C TEST 016 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05710301 ! 575: C IMPLICIT (DEFAULT) TYPING OF INTEGER. 05720301 ! 576: C 05730301 ! 577: IVTNUM = 16 05740301 ! 578: IF (ICZERO) 30160, 0160, 30160 05750301 ! 579: 0160 CONTINUE 05760301 ! 580: CVCOMP = ' ' 05770301 ! 581: KVTN05 = 'A' 05780301 ! 582: CVCORR = 'A' 05790301 ! 583: CVCOMP = KVTN05 05800301 ! 584: 40160 IF (CVCOMP .EQ. 'A') GO TO 10160 05810301 ! 585: 40161 GO TO 20160 05820301 ! 586: 30160 IVDELE = IVDELE + 1 05830301 ! 587: WRITE (I02,80000) IVTNUM 05840301 ! 588: IF (ICZERO) 10160, 0171, 20160 05850301 ! 589: 10160 IVPASS = IVPASS + 1 05860301 ! 590: WRITE (I02,80002) IVTNUM 05870301 ! 591: GO TO 0171 05880301 ! 592: 20160 IVFAIL = IVFAIL + 1 05890301 ! 593: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05900301 ! 594: 0171 CONTINUE 05910301 ! 595: C 05920301 ! 596: C **** FCVS PROGRAM 301 - TEST 017 **** 05930301 ! 597: C 05940301 ! 598: C TEST 017 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05950301 ! 599: C IMPLICIT TYPING OF THE LETTER 'G' AS INTEGER. 05960301 ! 600: C 05970301 ! 601: IVTNUM = 17 05980301 ! 602: IF (ICZERO) 30170, 0170, 30170 05990301 ! 603: 0170 CONTINUE 06000301 ! 604: CVCOMP = ' ' 06010301 ! 605: GVTN01 = 'ABC' 06020301 ! 606: CVCORR = 'ABC' 06030301 ! 607: CVCOMP = GVTN01 06040301 ! 608: 40170 IF (CVCOMP .EQ. 'ABC') GO TO 10170 06050301 ! 609: 40171 GO TO 20170 06060301 ! 610: 30170 IVDELE = IVDELE + 1 06070301 ! 611: WRITE (I02,80000) IVTNUM 06080301 ! 612: IF (ICZERO) 10170, 0181, 20170 06090301 ! 613: 10170 IVPASS = IVPASS + 1 06100301 ! 614: WRITE (I02,80002) IVTNUM 06110301 ! 615: GO TO 0181 06120301 ! 616: 20170 IVFAIL = IVFAIL + 1 06130301 ! 617: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06140301 ! 618: 0181 CONTINUE 06150301 ! 619: C 06160301 ! 620: C **** FCVS PROGRAM 301 - TEST 018 **** 06170301 ! 621: C 06180301 ! 622: C TEST 018 USES THE CHARAACTER TYPE-STATEMENT TO OVERRIDE THE 06190301 ! 623: C LENGTH OF A CHARACTER FIELD DEFINED BY AN IMPLICIT STATEMENT. 06200301 ! 624: C 06210301 ! 625: IVTNUM = 18 06220301 ! 626: IF (ICZERO) 30180, 0180, 30180 06230301 ! 627: 0180 CONTINUE 06240301 ! 628: CVCOMP = ' ' 06250301 ! 629: FVTN01 = 'ABC' 06260301 ! 630: CVCORR = 'ABC' 06270301 ! 631: CVCOMP = FVTN01 06280301 ! 632: 40180 IF (CVCOMP .EQ. 'ABC') GO TO 10180 06290301 ! 633: 40181 GO TO 20180 06300301 ! 634: 30180 IVDELE = IVDELE + 1 06310301 ! 635: WRITE (I02,80000) IVTNUM 06320301 ! 636: IF (ICZERO) 10180, 0191, 20180 06330301 ! 637: 10180 IVPASS = IVPASS + 1 06340301 ! 638: WRITE (I02,80002) IVTNUM 06350301 ! 639: GO TO 0191 06360301 ! 640: 20180 IVFAIL = IVFAIL + 1 06370301 ! 641: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06380301 ! 642: 0191 CONTINUE 06390301 ! 643: C 06400301 ! 644: C **** FCVS PROGRAM 301 - TEST 019 **** 06410301 ! 645: C 06420301 ! 646: C TEST 019 USES THE TYPE-STATEMENT TO SPECIFY AN INTEGER 06430301 ! 647: C STATEMENT FUNCTION. 06440301 ! 648: C 06450301 ! 649: IVTNUM = 19 06460301 ! 650: IF (ICZERO) 30190, 0190, 30190 06470301 ! 651: 0190 CONTINUE 06480301 ! 652: IVCOMP = 0 06490301 ! 653: IVON01 = 5 06500301 ! 654: IVON02 = IFTN01(IVON01) 06510301 ! 655: IVCORR = 6 06520301 ! 656: IVCOMP = IVON02 06530301 ! 657: 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06540301 ! 658: 30190 IVDELE = IVDELE + 1 06550301 ! 659: WRITE (I02,80000) IVTNUM 06560301 ! 660: IF (ICZERO) 10190, 0201, 20190 06570301 ! 661: 10190 IVPASS = IVPASS + 1 06580301 ! 662: WRITE (I02,80002) IVTNUM 06590301 ! 663: GO TO 0201 06600301 ! 664: 20190 IVFAIL = IVFAIL + 1 06610301 ! 665: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06620301 ! 666: 0201 CONTINUE 06630301 ! 667: C 06640301 ! 668: C 06650301 ! 669: C WRITE OUT TEST SUMMARY 06660301 ! 670: C 06670301 ! 671: WRITE (I02,90004) 06680301 ! 672: WRITE (I02,90014) 06690301 ! 673: WRITE (I02,90004) 06700301 ! 674: WRITE (I02,90000) 06710301 ! 675: WRITE (I02,90004) 06720301 ! 676: WRITE (I02,90020) IVFAIL 06730301 ! 677: WRITE (I02,90022) IVPASS 06740301 ! 678: WRITE (I02,90024) IVDELE 06750301 ! 679: STOP 06760301 ! 680: 90001 FORMAT (1H ,24X,5HFM301) 06770301 ! 681: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM301) 06780301 ! 682: C 06790301 ! 683: C FORMATS FOR TEST DETAIL LINES 06800301 ! 684: C 06810301 ! 685: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06820301 ! 686: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06830301 ! 687: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06840301 ! 688: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06850301 ! 689: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06860301 ! 690: C 06870301 ! 691: C FORMAT STATEMENTS FOR PAGE HEADERS 06880301 ! 692: C 06890301 ! 693: 90002 FORMAT (1H1) 06900301 ! 694: 90004 FORMAT (1H ) 06910301 ! 695: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06920301 ! 696: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06930301 ! 697: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06940301 ! 698: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06950301 ! 699: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06960301 ! 700: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06970301 ! 701: C 06980301 ! 702: C FORMAT STATEMENTS FOR RUN SUMMARY 06990301 ! 703: C 07000301 ! 704: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 07010301 ! 705: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 07020301 ! 706: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 07030301 ! 707: END 07040301
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.