![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM300.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 FM300.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 FM300 00010300 ! 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 00020300 ! 6: C 00030300 ! 7: C THIS ROUTINE TESTS THE USE OF THE EQUIVALENCE STATEMENT TO 00040300 ! 8: C EQUATE STORAGE UNITS OF VARIABLES, ARRAYS AND ARRAY ELEMENTS. 00050300 ! 9: C ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA TYPES ARE TESTED. 00060300 ! 10: C NO ATTEMPT IS MADE TO TEST DATA OF DIFFERENT TYPES THAT ARE 00070300 ! 11: C EQUATED WITH THE EQUIVALENCE STATEMENT. 00080300 ! 12: C 00090300 ! 13: C REFERENCES. 00100300 ! 14: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110300 ! 15: C X3.9-1978 00120300 ! 16: C 00130300 ! 17: C SECTION 8.1, DIMENSION STATEMENT 00140300 ! 18: C SECTION 8.2, EQUIVALENCE STATEMENT 00150300 ! 19: C SECTION 9, DATA STATEMENT 00160300 ! 20: C 00170300 ! 21: C 00180300 ! 22: C ******************************************************************00190300 ! 23: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200300 ! 24: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210300 ! 25: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220300 ! 26: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230300 ! 27: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240300 ! 28: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250300 ! 29: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260300 ! 30: C THE RESULT OF EXECUTING THESE TESTS. 00270300 ! 31: C 00280300 ! 32: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290300 ! 33: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300300 ! 34: C 00310300 ! 35: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320300 ! 36: C DEPARTMENT OF THE NAVY 00330300 ! 37: C FEDERAL COBOL COMPILER TESTING SERVICE 00340300 ! 38: C WASHINGTON, D.C. 20376 00350300 ! 39: C 00360300 ! 40: C ******************************************************************00370300 ! 41: C 00380300 ! 42: C 00390300 ! 43: IMPLICIT LOGICAL (L) 00400300 ! 44: IMPLICIT CHARACTER*14 (C) 00410300 ! 45: C 00420300 ! 46: 00430300 ! 47: C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00440300 ! 48: C 00450300 ! 49: EQUIVALENCE (IVOE01, IVOE02) 00460300 ! 50: C 00470300 ! 51: C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00480300 ! 52: C 00490300 ! 53: EQUIVALENCE (RVOE01, RVOE02) 00500300 ! 54: C 00510300 ! 55: C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00520300 ! 56: C 00530300 ! 57: EQUIVALENCE (LVOE01, LVOE02) 00540300 ! 58: C 00550300 ! 59: C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00560300 ! 60: C 00570300 ! 61: CHARACTER CVTE01*3, CVTE02*3, CVCOMP*3 00580300 ! 62: EQUIVALENCE (CVTE01, CVTE02) 00590300 ! 63: C 00600300 ! 64: C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00610300 ! 65: C 00620300 ! 66: EQUIVALENCE (IVOE03, IVOE04, IVOE05) 00630300 ! 67: C 00640300 ! 68: C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00650300 ! 69: C 00660300 ! 70: EQUIVALENCE (IVOE06, IVOE07, RVOE03) 00670300 ! 71: C 00680300 ! 72: C *** SPECIFICATION STATEMENTS FOR TESTS 007 AND 008 *** 00690300 ! 73: C 00700300 ! 74: EQUIVALENCE (IVOE08, IVOE09), (IVOE10, IVOE11) 00710300 ! 75: C 00720300 ! 76: C *** SPECIFICATION STATEMENTS FOR TEST 009 *** 00730300 ! 77: C 00740300 ! 78: EQUIVALENCE (IVOE12, IVOE13), (IVOE13, IVOE14) 00750300 ! 79: C 00760300 ! 80: C *** SPECIFICATION STATEMENTS FOR TEST 010 *** 00770300 ! 81: C 00780300 ! 82: EQUIVALENCE (IVOE15, IVOE16) 00790300 ! 83: EQUIVALENCE (IVOE16, IVOE17) 00800300 ! 84: C 00810300 ! 85: C *** SPECIFICATION STATEMENTS FOR TESTS 011 AND 012 *** 00820300 ! 86: C 00830300 ! 87: DIMENSION IADE11(2), IADE12(3) 00840300 ! 88: EQUIVALENCE (IADE11, IADE12) 00850300 ! 89: C 00860300 ! 90: C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 00870300 ! 91: C 00880300 ! 92: DIMENSION RADE11(5), RADE12(5) 00890300 ! 93: EQUIVALENCE (RADE11(4), RADE12(2)) 00900300 ! 94: C 00910300 ! 95: C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 00920300 ! 96: C 00930300 ! 97: DIMENSION IADE13(4), IADE14(4) 00940300 ! 98: EQUIVALENCE (IADE13, IADE14(3)) 00950300 ! 99: C 00960300 ! 100: C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 00970300 ! 101: C 00980300 ! 102: DIMENSION IADE15(3) 00990300 ! 103: EQUIVALENCE (IADE15(2), IVOE18) 01000300 ! 104: C 01010300 ! 105: C *** SPECIFICATION STATEMENTS FOR TESTS 017 AND 018 *** 01020300 ! 106: C 01030300 ! 107: DIMENSION IADE21(2,2), IADE16(4) 01040300 ! 108: EQUIVALENCE (IADE21, IADE16) 01050300 ! 109: C 01060300 ! 110: C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01070300 ! 111: C 01080300 ! 112: EQUIVALENCE (IVOE19, IVOE20) 01090300 ! 113: DATA IVOE19/19/ 01100300 ! 114: C 01110300 ! 115: C 01120300 ! 116: C 01130300 ! 117: C INITIALIZATION SECTION. 01140300 ! 118: C 01150300 ! 119: C INITIALIZE CONSTANTS 01160300 ! 120: C ******************** 01170300 ! 121: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01180300 ! 122: I01 = 5 01190300 ! 123: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01200300 ! 124: I02 = 6 01210300 ! 125: C SYSTEM ENVIRONMENT SECTION 01220300 ! 126: C 01230300 ! 127: I01 = 5 01240300 ! 128: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01250300 ! 129: C (UNIT NUMBER FOR CARD READER). 01260300 ! 130: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01270300 ! 131: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01280300 ! 132: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01290300 ! 133: C 01300300 ! 134: I02 = 6 01310300 ! 135: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01320300 ! 136: C (UNIT NUMBER FOR PRINTER). 01330300 ! 137: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01340300 ! 138: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350300 ! 139: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01360300 ! 140: C 01370300 ! 141: IVPASS = 0 01380300 ! 142: IVFAIL = 0 01390300 ! 143: IVDELE = 0 01400300 ! 144: ICZERO = 0 01410300 ! 145: C 01420300 ! 146: C WRITE OUT PAGE HEADERS 01430300 ! 147: C 01440300 ! 148: WRITE (I02,90002) 01450300 ! 149: WRITE (I02,90006) 01460300 ! 150: WRITE (I02,90008) 01470300 ! 151: WRITE (I02,90004) 01480300 ! 152: WRITE (I02,90010) 01490300 ! 153: WRITE (I02,90004) 01500300 ! 154: WRITE (I02,90016) 01510300 ! 155: WRITE (I02,90001) 01520300 ! 156: WRITE (I02,90004) 01530300 ! 157: WRITE (I02,90012) 01540300 ! 158: WRITE (I02,90014) 01550300 ! 159: WRITE (I02,90004) 01560300 ! 160: C 01570300 ! 161: C 01580300 ! 162: C **** FCVS PROGRAM 300 - TEST 001 **** 01590300 ! 163: C 01600300 ! 164: C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES. 01610300 ! 165: C 01620300 ! 166: C 01630300 ! 167: IVTNUM = 1 01640300 ! 168: IF (ICZERO) 30010, 0010, 30010 01650300 ! 169: 0010 CONTINUE 01660300 ! 170: IVCOMP = 0 01670300 ! 171: IVOE01 = 5 01680300 ! 172: IVOE02 = 7 01690300 ! 173: IVCORR = 7 01700300 ! 174: IVCOMP = IVOE01 01710300 ! 175: 40010 IF (IVCOMP - 7) 20010,10010,20010 01720300 ! 176: 30010 IVDELE = IVDELE + 1 01730300 ! 177: WRITE (I02,80000) IVTNUM 01740300 ! 178: IF (ICZERO) 10010, 0021, 20010 01750300 ! 179: 10010 IVPASS = IVPASS + 1 01760300 ! 180: WRITE (I02,80002) IVTNUM 01770300 ! 181: GO TO 0021 01780300 ! 182: 20010 IVFAIL = IVFAIL + 1 01790300 ! 183: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800300 ! 184: 0021 CONTINUE 01810300 ! 185: C 01820300 ! 186: C **** FCVS PROGRAM 300 - TEST 002 **** 01830300 ! 187: C 01840300 ! 188: C THIS IS A TEST FOR EQUATING TWO REAL VARIABLES. 01850300 ! 189: C 01860300 ! 190: C 01870300 ! 191: IVTNUM = 2 01880300 ! 192: IF (ICZERO) 30020, 0020, 30020 01890300 ! 193: 0020 CONTINUE 01900300 ! 194: RVCOMP = 0.0 01910300 ! 195: RVOE01 = 4.5 01920300 ! 196: RVOE02 = 1.2 01930300 ! 197: RVCORR = 1.2 01940300 ! 198: RVCOMP = RVOE01 01950300 ! 199: 40020 IF (RVCOMP - 1.1995) 20020,10020,40021 01960300 ! 200: 40021 IF (RVCOMP - 1.2005) 10020,10020,20020 01970300 ! 201: 30020 IVDELE = IVDELE + 1 01980300 ! 202: WRITE (I02,80000) IVTNUM 01990300 ! 203: IF (ICZERO) 10020, 0031, 20020 02000300 ! 204: 10020 IVPASS = IVPASS + 1 02010300 ! 205: WRITE (I02,80002) IVTNUM 02020300 ! 206: GO TO 0031 02030300 ! 207: 20020 IVFAIL = IVFAIL + 1 02040300 ! 208: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02050300 ! 209: 0031 CONTINUE 02060300 ! 210: C 02070300 ! 211: C **** FCVS PROGRAM 300 - TEST 003 **** 02080300 ! 212: C 02090300 ! 213: C THIS IS A TEST FOR EQUATING TWO LOGICAL VARIABLES. 02100300 ! 214: C 02110300 ! 215: C 02120300 ! 216: IVTNUM = 3 02130300 ! 217: IF (ICZERO) 30030, 0030, 30030 02140300 ! 218: 0030 CONTINUE 02150300 ! 219: LVOE01 = .TRUE. 02160300 ! 220: LVOE02 = .FALSE. 02170300 ! 221: IVCORR = 0 02180300 ! 222: IVCOMP = 0 02190300 ! 223: IF (LVOE01) IVCOMP = 1 02200300 ! 224: 40030 IF (IVCOMP) 20030,10030,20030 02210300 ! 225: 30030 IVDELE = IVDELE + 1 02220300 ! 226: WRITE (I02,80000) IVTNUM 02230300 ! 227: IF (ICZERO) 10030, 0041, 20030 02240300 ! 228: 10030 IVPASS = IVPASS + 1 02250300 ! 229: WRITE (I02,80002) IVTNUM 02260300 ! 230: GO TO 0041 02270300 ! 231: 20030 IVFAIL = IVFAIL + 1 02280300 ! 232: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02290300 ! 233: 0041 CONTINUE 02300300 ! 234: C 02310300 ! 235: C **** FCVS PROGRAM 300 - TEST 004 **** 02320300 ! 236: C 02330300 ! 237: C THIS IS A TEST FOR EQUATING TWO CHARACTER VARIABLES. 02340300 ! 238: C 02350300 ! 239: C 02360300 ! 240: IVTNUM = 4 02370300 ! 241: IF (ICZERO) 30040, 0040, 30040 02380300 ! 242: 0040 CONTINUE 02390300 ! 243: CVCOMP = ' ' 02400300 ! 244: CVTE01 = 'ABC' 02410300 ! 245: CVTE02 = 'DEF' 02420300 ! 246: CVCORR = 'DEF' 02430300 ! 247: CVCOMP = CVTE01 02440300 ! 248: 40040 IF (CVCOMP .EQ. 'DEF') GO TO 10040 02450300 ! 249: 40041 GO TO 20040 02460300 ! 250: 30040 IVDELE = IVDELE + 1 02470300 ! 251: WRITE (I02,80000) IVTNUM 02480300 ! 252: IF (ICZERO) 10040, 0051, 20040 02490300 ! 253: 10040 IVPASS = IVPASS + 1 02500300 ! 254: WRITE (I02,80002) IVTNUM 02510300 ! 255: GO TO 0051 02520300 ! 256: 20040 IVFAIL = IVFAIL + 1 02530300 ! 257: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02540300 ! 258: 0051 CONTINUE 02550300 ! 259: C 02560300 ! 260: C **** FCVS PROGRAM 300 - TEST 005 **** 02570300 ! 261: C 02580300 ! 262: C THIS IS A TEST FOR EQUATING THREE INTEGER VARIABLES. 02590300 ! 263: C 02600300 ! 264: C 02610300 ! 265: IVTNUM = 5 02620300 ! 266: IF (ICZERO) 30050, 0050, 30050 02630300 ! 267: 0050 CONTINUE 02640300 ! 268: IVCOMP = 0 02650300 ! 269: IVOE03 = 3 02660300 ! 270: IVOE04 = 4 02670300 ! 271: IVOE05 = 5 02680300 ! 272: IVCORR = 5 02690300 ! 273: IVCOMP = IVOE03 02700300 ! 274: 40050 IF (IVCOMP - 5) 20050,40051,20050 02710300 ! 275: 40051 IVCOMP = IVOE04 02720300 ! 276: 40052 IF (IVCOMP - 5) 20050,10050,20050 02730300 ! 277: 30050 IVDELE = IVDELE + 1 02740300 ! 278: WRITE (I02,80000) IVTNUM 02750300 ! 279: IF (ICZERO) 10050, 0061, 20050 02760300 ! 280: 10050 IVPASS = IVPASS + 1 02770300 ! 281: WRITE (I02,80002) IVTNUM 02780300 ! 282: GO TO 0061 02790300 ! 283: 20050 IVFAIL = IVFAIL + 1 02800300 ! 284: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02810300 ! 285: 0061 CONTINUE 02820300 ! 286: C 02830300 ! 287: C **** FCVS PROGRAM 300 - TEST 006 **** 02840300 ! 288: C 02850300 ! 289: C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES AND ONE 02860300 ! 290: C REAL VARIABLE WITHIN ONE EQUIVALENCE STATEMENT LIST OF NAMES. THE02870300 ! 291: C VALUE OF THE REAL VARIABLE IS NOT TESTED. 02880300 ! 292: C 02890300 ! 293: C 02900300 ! 294: IVTNUM = 6 02910300 ! 295: IF (ICZERO) 30060, 0060, 30060 02920300 ! 296: 0060 CONTINUE 02930300 ! 297: IVCOMP = 0 02940300 ! 298: RVOE03 = 3.445 02950300 ! 299: IVOE06 = 6 02960300 ! 300: IVOE07 = 7 02970300 ! 301: IVCORR = 7 02980300 ! 302: IVCOMP = IVOE06 02990300 ! 303: 40060 IF (IVCOMP - 7) 20060,10060,20060 03000300 ! 304: 30060 IVDELE = IVDELE + 1 03010300 ! 305: WRITE (I02,80000) IVTNUM 03020300 ! 306: IF (ICZERO) 10060, 0071, 20060 03030300 ! 307: 10060 IVPASS = IVPASS + 1 03040300 ! 308: WRITE (I02,80002) IVTNUM 03050300 ! 309: GO TO 0071 03060300 ! 310: 20060 IVFAIL = IVFAIL + 1 03070300 ! 311: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03080300 ! 312: 0071 CONTINUE 03090300 ! 313: C 03100300 ! 314: C **** FCVS PROGRAM 300 - TEST 007 **** 03110300 ! 315: C 03120300 ! 316: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES USING TWO LISTS 03130300 ! 317: C OF NAMES IN ONE EQUIVALENCE STATEMENT. NAMES SPECIFIED IN THE 03140300 ! 318: C FIRST LIST ARE NOT EQUATED TO NAMES IN THE SECOND LIST. THIS 03150300 ! 319: C TEST CHECKS THE EQUIVALINCE OF THE VARIABLES IN THE FIRST LIST. 03160300 ! 320: C 03170300 ! 321: C 03180300 ! 322: IVTNUM = 7 03190300 ! 323: IF (ICZERO) 30070, 0070, 30070 03200300 ! 324: 0070 CONTINUE 03210300 ! 325: IVCOMP = 0 03220300 ! 326: IVOE08 = 8 03230300 ! 327: IVOE09 = 9 03240300 ! 328: IVOE10 = 10 03250300 ! 329: IVOE11 = 11 03260300 ! 330: IVCORR = 9 03270300 ! 331: IVCOMP = IVOE08 03280300 ! 332: 40070 IF (IVCOMP - 9) 20070,10070,20070 03290300 ! 333: 30070 IVDELE = IVDELE + 1 03300300 ! 334: WRITE (I02,80000) IVTNUM 03310300 ! 335: IF (ICZERO) 10070, 0081, 20070 03320300 ! 336: 10070 IVPASS = IVPASS + 1 03330300 ! 337: WRITE (I02,80002) IVTNUM 03340300 ! 338: GO TO 0081 03350300 ! 339: 20070 IVFAIL = IVFAIL + 1 03360300 ! 340: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03370300 ! 341: 0081 CONTINUE 03380300 ! 342: C 03390300 ! 343: C **** FCVS PROGRAM 300 - TEST 008 **** 03400300 ! 344: C 03410300 ! 345: C THIS TEST CHECKS THE EQUIVALENCE OF THE VARIABLES IN THE 03420300 ! 346: C SECOND LIST. 03430300 ! 347: C 03440300 ! 348: C 03450300 ! 349: IVTNUM = 8 03460300 ! 350: IF (ICZERO) 30080, 0080, 30080 03470300 ! 351: 0080 CONTINUE 03480300 ! 352: IVCOMP = 0 03490300 ! 353: IVCORR = 11 03500300 ! 354: IVCOMP = IVOE10 03510300 ! 355: 40080 IF (IVCOMP - 11) 20080,10080,20080 03520300 ! 356: 30080 IVDELE = IVDELE + 1 03530300 ! 357: WRITE (I02,80000) IVTNUM 03540300 ! 358: IF (ICZERO) 10080, 0091, 20080 03550300 ! 359: 10080 IVPASS = IVPASS + 1 03560300 ! 360: WRITE (I02,80002) IVTNUM 03570300 ! 361: GO TO 0091 03580300 ! 362: 20080 IVFAIL = IVFAIL + 1 03590300 ! 363: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03600300 ! 364: 0091 CONTINUE 03610300 ! 365: C 03620300 ! 366: C **** FCVS PROGRAM 300 - TEST 009 **** 03630300 ! 367: C 03640300 ! 368: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES IN ONE LIST 03650300 ! 369: C WITH INTEGER VARIABLES IN A SECOND LIST OF THE SAME EQUIVALENCE 03660300 ! 370: C STATEMENT. ALL VARIABLES SHOULD BE EQUATED AND SHARE THE SAME 03670300 ! 371: C STORAGE UNIT. 03680300 ! 372: C 03690300 ! 373: C 03700300 ! 374: IVTNUM = 9 03710300 ! 375: IF (ICZERO) 30090, 0090, 30090 03720300 ! 376: 0090 CONTINUE 03730300 ! 377: IVCOMP = 0 03740300 ! 378: IVOE12 = 12 03750300 ! 379: IVOE13 = 13 03760300 ! 380: IVOE14 = 14 03770300 ! 381: IVCORR = 14 03780300 ! 382: IVCOMP = IVOE13 03790300 ! 383: 40090 IF (IVCOMP - 14) 20090,40091,20090 03800300 ! 384: 40091 IVCOMP = IVOE12 03810300 ! 385: 40092 IF (IVCOMP - 14) 20090,10090,20090 03820300 ! 386: 30090 IVDELE = IVDELE + 1 03830300 ! 387: WRITE (I02,80000) IVTNUM 03840300 ! 388: IF (ICZERO) 10090, 0101, 20090 03850300 ! 389: 10090 IVPASS = IVPASS + 1 03860300 ! 390: WRITE (I02,80002) IVTNUM 03870300 ! 391: GO TO 0101 03880300 ! 392: 20090 IVFAIL = IVFAIL + 1 03890300 ! 393: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03900300 ! 394: 0101 CONTINUE 03910300 ! 395: C 03920300 ! 396: C **** FCVS PROGRAM 300 - TEST 010 **** 03930300 ! 397: C 03940300 ! 398: C THIS IS A TEST FOR EQUATING INTEGER VARIABLES SPECIFIED IN ONE 03950300 ! 399: C EQUIVALENCE STATEMENT WITH INTEGER VARIABLES SPECIFIED IN A 03960300 ! 400: C SECOND EQUIVALENCE STATEMENT. ONE VARIABLE IS SPECIFIED IN BOTH 03970300 ! 401: C STATEMENTS, THEREFORE ALL VARIABLES SHOULD BE EQUATED AND SHARE 03980300 ! 402: C THE SAME STORAGE UNIT. 03990300 ! 403: C 04000300 ! 404: C 04010300 ! 405: IVTNUM = 10 04020300 ! 406: IF (ICZERO) 30100, 0100, 30100 04030300 ! 407: 0100 CONTINUE 04040300 ! 408: IVCOMP = 0 04050300 ! 409: IVOE15 = 15 04060300 ! 410: IVOE16 = 16 04070300 ! 411: IVOE17 = 17 04080300 ! 412: IVCORR = 17 04090300 ! 413: IVCOMP = IVOE16 04100300 ! 414: 40100 IF (IVCOMP - 17) 20100,40101,20100 04110300 ! 415: 40101 IVCOMP = IVOE15 04120300 ! 416: 40102 IF (IVCOMP - 17) 20100,10100,20100 04130300 ! 417: 30100 IVDELE = IVDELE + 1 04140300 ! 418: WRITE (I02,80000) IVTNUM 04150300 ! 419: IF (ICZERO) 10100, 0111, 20100 04160300 ! 420: 10100 IVPASS = IVPASS + 1 04170300 ! 421: WRITE (I02,80002) IVTNUM 04180300 ! 422: GO TO 0111 04190300 ! 423: 20100 IVFAIL = IVFAIL + 1 04200300 ! 424: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04210300 ! 425: 0111 CONTINUE 04220300 ! 426: C 04230300 ! 427: C **** FCVS PROGRAM 300 - TEST 011 **** 04240300 ! 428: C 04250300 ! 429: C THIS IS A TEST FOR EQUATING TWO INTEGER ARRAYS UNQUALIFIED 04260300 ! 430: C BY A SUBSCRIPT IN THE EQUIVALENCE STATEMENT. ALL ARRAY ELEMENTS 04270300 ! 431: C SPECIFIED BY THE SAME SUBSCRIPT VALUE, BEGINNING WITH THE FIRST 04280300 ! 432: C ARRAY ELEMENT, SHOULD BE EQUATED AND SHARE THE SAME STORAGE UNIT. 04290300 ! 433: C THIS TEST CHECKS THE EQUIVALENCE OF THE FIRST ARRAY ELEMENTS. 04300300 ! 434: C 04310300 ! 435: C 04320300 ! 436: IVTNUM = 11 04330300 ! 437: IF (ICZERO) 30110, 0110, 30110 04340300 ! 438: 0110 CONTINUE 04350300 ! 439: IVCOMP = 0 04360300 ! 440: IADE11(1) = 111 04370300 ! 441: IADE11(2) = 112 04380300 ! 442: IADE12(1) = 121 04390300 ! 443: IADE12(2) = 122 04400300 ! 444: IADE12(3) = 123 04410300 ! 445: IVCORR = 121 04420300 ! 446: IVCOMP = IADE11(1) 04430300 ! 447: 40110 IF (IVCOMP - 121) 20110,10110,20110 04440300 ! 448: 30110 IVDELE = IVDELE + 1 04450300 ! 449: WRITE (I02,80000) IVTNUM 04460300 ! 450: IF (ICZERO) 10110, 0121, 20110 04470300 ! 451: 10110 IVPASS = IVPASS + 1 04480300 ! 452: WRITE (I02,80002) IVTNUM 04490300 ! 453: GO TO 0121 04500300 ! 454: 20110 IVFAIL = IVFAIL + 1 04510300 ! 455: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04520300 ! 456: 0121 CONTINUE 04530300 ! 457: C 04540300 ! 458: C **** FCVS PROGRAM 300 - TEST 012 **** 04550300 ! 459: C 04560300 ! 460: C THIS TEST CHECKS THE EQUIVALENCE OF THE SECOND ARRAY ELEMENTS. 04570300 ! 461: C 04580300 ! 462: C 04590300 ! 463: IVTNUM = 12 04600300 ! 464: IF (ICZERO) 30120, 0120, 30120 04610300 ! 465: 0120 CONTINUE 04620300 ! 466: IVCOMP = 0 04630300 ! 467: IVCORR = 122 04640300 ! 468: IVCOMP = IADE11(2) 04650300 ! 469: 40120 IF (IVCOMP - 122) 20120,10120,20120 04660300 ! 470: 30120 IVDELE = IVDELE + 1 04670300 ! 471: WRITE (I02,80000) IVTNUM 04680300 ! 472: IF (ICZERO) 10120, 0131, 20120 04690300 ! 473: 10120 IVPASS = IVPASS + 1 04700300 ! 474: WRITE (I02,80002) IVTNUM 04710300 ! 475: GO TO 0131 04720300 ! 476: 20120 IVFAIL = IVFAIL + 1 04730300 ! 477: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04740300 ! 478: 0131 CONTINUE 04750300 ! 479: C 04760300 ! 480: C **** FCVS PROGRAM 300 - TEST 013 **** 04770300 ! 481: C 04780300 ! 482: C THIS IS A TEST FOR EQUATING TWO REAL ARRAY ELEMENTS. THIS 04790300 ! 483: C TEST CHECKS THE EQUIVALENCE OF THE TWO ARRAY ELEMENTS SPECIFIED 04800300 ! 484: C IN THE EQUIVALENCE STATEMENT. 04810300 ! 485: C 04820300 ! 486: C 04830300 ! 487: IVTNUM = 13 04840300 ! 488: IF (ICZERO) 30130, 0130, 30130 04850300 ! 489: 0130 CONTINUE 04860300 ! 490: RVCOMP = 0.0 04870300 ! 491: RADE11(4) = 11.4 04880300 ! 492: RADE12(2) = 1.22 04890300 ! 493: RVCORR = 1.22 04900300 ! 494: RVCOMP = RADE11(4) 04910300 ! 495: 40130 IF (RVCOMP - 1.2195) 20130,10130,40131 04920300 ! 496: 40131 IF (RVCOMP - 1.2205) 10130,10130,20130 04930300 ! 497: 30130 IVDELE = IVDELE + 1 04940300 ! 498: WRITE (I02,80000) IVTNUM 04950300 ! 499: IF (ICZERO) 10130, 0141, 20130 04960300 ! 500: 10130 IVPASS = IVPASS + 1 04970300 ! 501: WRITE (I02,80002) IVTNUM 04980300 ! 502: GO TO 0141 04990300 ! 503: 20130 IVFAIL = IVFAIL + 1 05000300 ! 504: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05010300 ! 505: 0141 CONTINUE 05020300 ! 506: C 05030300 ! 507: C **** FCVS PROGRAM 300 - TEST 014 **** 05040300 ! 508: C 05050300 ! 509: C THIS TEST CHECKS THE EQUIVALENCE OF THE ARRAY ELEMENTS 05060300 ! 510: C WITH A SUBSCRIPT VALUE ONE LESS THAN THOSE TESTED IN THE 05070300 ! 511: C PREVIOUS TEST. THESE ELEMENTS SHOULD BE EQUATED AND SHARE THE 05080300 ! 512: C SAME STORAGE UNIT DUE TO THE WAY ARRAY ELEMENTS OCCUPY 05090300 ! 513: C CONSECUTIVE STORAGE UNITS. 05100300 ! 514: C 05110300 ! 515: C 05120300 ! 516: IVTNUM = 14 05130300 ! 517: IF (ICZERO) 30140, 0140, 30140 05140300 ! 518: 0140 CONTINUE 05150300 ! 519: RVCOMP = 0.0 05160300 ! 520: RADE11(3) = .113 05170300 ! 521: RADE12(1) = 122. 05180300 ! 522: RVCORR = 122. 05190300 ! 523: RVCOMP = RADE11(3) 05200300 ! 524: 40140 IF (RVCOMP - 121.95) 20140,10140,40141 05210300 ! 525: 40141 IF (RVCOMP - 122.05) 10140,10140,20140 05220300 ! 526: 30140 IVDELE = IVDELE + 1 05230300 ! 527: WRITE (I02,80000) IVTNUM 05240300 ! 528: IF (ICZERO) 10140, 0151, 20140 05250300 ! 529: 10140 IVPASS = IVPASS + 1 05260300 ! 530: WRITE (I02,80002) IVTNUM 05270300 ! 531: GO TO 0151 05280300 ! 532: 20140 IVFAIL = IVFAIL + 1 05290300 ! 533: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300300 ! 534: 0151 CONTINUE 05310300 ! 535: C 05320300 ! 536: C **** FCVS PROGRAM 300 - TEST 015 **** 05330300 ! 537: C 05340300 ! 538: C THIS IS A TEST TO EQUATE AN ARRAY NAME TO AN ARRAY ELEMENT 05350300 ! 539: C NAME. 05360300 ! 540: C 05370300 ! 541: C 05380300 ! 542: IVTNUM = 15 05390300 ! 543: IF (ICZERO) 30150, 0150, 30150 05400300 ! 544: 0150 CONTINUE 05410300 ! 545: IVCOMP = 0 05420300 ! 546: IADE13(1) = 131 05430300 ! 547: IADE14(3) = 143 05440300 ! 548: IVCORR = 143 05450300 ! 549: IVCOMP = IADE13(1) 05460300 ! 550: 40150 IF (IVCOMP - 143) 20150,10150,20150 05470300 ! 551: 30150 IVDELE = IVDELE + 1 05480300 ! 552: WRITE (I02,80000) IVTNUM 05490300 ! 553: IF (ICZERO) 10150, 0161, 20150 05500300 ! 554: 10150 IVPASS = IVPASS + 1 05510300 ! 555: WRITE (I02,80002) IVTNUM 05520300 ! 556: GO TO 0161 05530300 ! 557: 20150 IVFAIL = IVFAIL + 1 05540300 ! 558: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05550300 ! 559: 0161 CONTINUE 05560300 ! 560: C 05570300 ! 561: C **** FCVS PROGRAM 300 - TEST 016 **** 05580300 ! 562: C 05590300 ! 563: C THIS IS A TEST TO EQUATE AN ARRAY ELEMENT TO AN INTEGER 05600300 ! 564: C VARIABLE. 05610300 ! 565: C 05620300 ! 566: C 05630300 ! 567: IVTNUM = 16 05640300 ! 568: IF (ICZERO) 30160, 0160, 30160 05650300 ! 569: 0160 CONTINUE 05660300 ! 570: IVCOMP = 0 05670300 ! 571: IADE15(2) = 152 05680300 ! 572: IVOE18 = 18 05690300 ! 573: IVCORR = 18 05700300 ! 574: IVCOMP = IADE15(2) 05710300 ! 575: 40160 IF (IVCOMP - 18) 20160,10160,20160 05720300 ! 576: 30160 IVDELE = IVDELE + 1 05730300 ! 577: WRITE (I02,80000) IVTNUM 05740300 ! 578: IF (ICZERO) 10160, 0171, 20160 05750300 ! 579: 10160 IVPASS = IVPASS + 1 05760300 ! 580: WRITE (I02,80002) IVTNUM 05770300 ! 581: GO TO 0171 05780300 ! 582: 20160 IVFAIL = IVFAIL + 1 05790300 ! 583: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800300 ! 584: 0171 CONTINUE 05810300 ! 585: C 05820300 ! 586: C **** FCVS PROGRAM 300 - TEST 017 **** 05830300 ! 587: C 05840300 ! 588: C THIS IS A TEST TO EQUATE A ONE DIMENSIONAL ARRAY TO A TWO 05850300 ! 589: C DIMENSIONAL ARRAY. THIS TEST CHECKS THE SECOND ARRAY ELEMENTS. 05860300 ! 590: C 05870300 ! 591: C 05880300 ! 592: IVTNUM = 17 05890300 ! 593: IF (ICZERO) 30170, 0170, 30170 05900300 ! 594: 0170 CONTINUE 05910300 ! 595: IVCOMP = 0 05920300 ! 596: IADE21(2,1) = 212 05930300 ! 597: IADE16(2) = 162 05940300 ! 598: IVCORR = 162 05950300 ! 599: IVCOMP = IADE21(2,1) 05960300 ! 600: 40170 IF (IVCOMP - 162) 20170,10170,20170 05970300 ! 601: 30170 IVDELE = IVDELE + 1 05980300 ! 602: WRITE (I02,80000) IVTNUM 05990300 ! 603: IF (ICZERO) 10170, 0181, 20170 06000300 ! 604: 10170 IVPASS = IVPASS + 1 06010300 ! 605: WRITE (I02,80002) IVTNUM 06020300 ! 606: GO TO 0181 06030300 ! 607: 20170 IVFAIL = IVFAIL + 1 06040300 ! 608: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050300 ! 609: 0181 CONTINUE 06060300 ! 610: C 06070300 ! 611: C **** FCVS PROGRAM 300 - TEST 018 **** 06080300 ! 612: C 06090300 ! 613: C THIS TEST CHECKS THE THIRD ARRAY ELEMENTS FROM THE PREVIOUS 06100300 ! 614: C TEST. 06110300 ! 615: C 06120300 ! 616: C 06130300 ! 617: IVTNUM = 18 06140300 ! 618: IF (ICZERO) 30180, 0180, 30180 06150300 ! 619: 0180 CONTINUE 06160300 ! 620: IVCOMP = 0 06170300 ! 621: IADE21(1,2) = 2112 06180300 ! 622: IADE16(3) = 163 06190300 ! 623: IVCORR = 163 06200300 ! 624: IVCOMP = IADE21(1,2) 06210300 ! 625: 40180 IF (IVCOMP - 163) 20180,10180,20180 06220300 ! 626: 30180 IVDELE = IVDELE + 1 06230300 ! 627: WRITE (I02,80000) IVTNUM 06240300 ! 628: IF (ICZERO) 10180, 0191, 20180 06250300 ! 629: 10180 IVPASS = IVPASS + 1 06260300 ! 630: WRITE (I02,80002) IVTNUM 06270300 ! 631: GO TO 0191 06280300 ! 632: 20180 IVFAIL = IVFAIL + 1 06290300 ! 633: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06300300 ! 634: 0191 CONTINUE 06310300 ! 635: C 06320300 ! 636: C **** FCVS PROGRAM 300 - TEST 019 **** 06330300 ! 637: C 06340300 ! 638: C THIS IS A TEST TO EQUATE TWO INTEGER VARIABLES ONE OF WHICH 06350300 ! 639: C IS INITIALIZED IN A DATA STATEMENT. 06360300 ! 640: C 06370300 ! 641: C 06380300 ! 642: IVTNUM = 19 06390300 ! 643: IF (ICZERO) 30190, 0190, 30190 06400300 ! 644: 0190 CONTINUE 06410300 ! 645: IVCOMP = 0 06420300 ! 646: IVCORR = 19 06430300 ! 647: IVCOMP = IVOE20 06440300 ! 648: 40190 IF (IVCOMP - 19) 20190,10190,20190 06450300 ! 649: 30190 IVDELE = IVDELE + 1 06460300 ! 650: WRITE (I02,80000) IVTNUM 06470300 ! 651: IF (ICZERO) 10190, 0201, 20190 06480300 ! 652: 10190 IVPASS = IVPASS + 1 06490300 ! 653: WRITE (I02,80002) IVTNUM 06500300 ! 654: GO TO 0201 06510300 ! 655: 20190 IVFAIL = IVFAIL + 1 06520300 ! 656: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06530300 ! 657: 0201 CONTINUE 06540300 ! 658: C 06550300 ! 659: C 06560300 ! 660: C WRITE OUT TEST SUMMARY 06570300 ! 661: C 06580300 ! 662: WRITE (I02,90004) 06590300 ! 663: WRITE (I02,90014) 06600300 ! 664: WRITE (I02,90004) 06610300 ! 665: WRITE (I02,90000) 06620300 ! 666: WRITE (I02,90004) 06630300 ! 667: WRITE (I02,90020) IVFAIL 06640300 ! 668: WRITE (I02,90022) IVPASS 06650300 ! 669: WRITE (I02,90024) IVDELE 06660300 ! 670: STOP 06670300 ! 671: 90001 FORMAT (1H ,24X,5HFM300) 06680300 ! 672: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM300) 06690300 ! 673: C 06700300 ! 674: C FORMATS FOR TEST DETAIL LINES 06710300 ! 675: C 06720300 ! 676: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06730300 ! 677: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06740300 ! 678: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06750300 ! 679: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06760300 ! 680: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06770300 ! 681: C 06780300 ! 682: C FORMAT STATEMENTS FOR PAGE HEADERS 06790300 ! 683: C 06800300 ! 684: 90002 FORMAT (1H1) 06810300 ! 685: 90004 FORMAT (1H ) 06820300 ! 686: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06830300 ! 687: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06840300 ! 688: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06850300 ! 689: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06860300 ! 690: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06870300 ! 691: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06880300 ! 692: C 06890300 ! 693: C FORMAT STATEMENTS FOR RUN SUMMARY 06900300 ! 694: C 06910300 ! 695: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 06920300 ! 696: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 06930300 ! 697: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 06940300 ! 698: END 06950300
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.