![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm022.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm022.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: c comment section. ! 2: c ! 3: c fm022 ! 4: c ! 5: c this routine tests arrays with fixed dimension and size limits ! 6: c set either in a blank common or dimension statement. the values ! 7: c of the array elements are set in various ways such as simple ! 8: c assignment statements, set to the values of other array elements ! 9: c (either positive or negative), set by integer to real or real to ! 10: c integer conversion, set by arithmetic expressions, or set by ! 11: c use of the equivalence statement. ! 12: c ! 13: c references ! 14: c american national standard programming language fortran, ! 15: c x3.9-1978 ! 16: c ! 17: c section 8, specification statements ! 18: c section 8.1, dimension statement ! 19: c section 8.2, equivalence statement ! 20: c section 8.3, common statement ! 21: c section 8.4, type-statements ! 22: c section 9, data statement ! 23: c ! 24: c ! 25: c ! 26: common iadn14(5), radn14(5), ladn13(2) ! 27: c ! 28: dimension iadn11(5), radn11(5), ladn11(2) ! 29: dimension iadn12(5), radn12(5), ladn12(2) ! 30: dimension iadn15(2), radn15(2) ! 31: dimension iadn16(4), iadn17(4) ! 32: c ! 33: integer radn13(5) ! 34: real iadn13(5) ! 35: logical ladn11, ladn12, ladn13, lctn01 ! 36: c ! 37: equivalence (iadn14(1), iadn15(1)), (radn14(2),radn15(2)) ! 38: equivalence (ladn13(1),lctn01), (iadn14(5), icon02) ! 39: equivalence (radn14(5), rcon01) ! 40: equivalence ( iadn16(3), iadn17(2) ) ! 41: c ! 42: data iadn12(1)/3/, radn12(1)/-512./, iadn13(1)/0.5/, radn13(1)/-3/ ! 43: c ! 44: c ! 45: c ! 46: c ********************************************************** ! 47: c ! 48: c a compiler validation system for the fortran language ! 49: c based on specifications as defined in american national standard ! 50: c programming language fortran x3.9-1978, has been developed by the ! 51: c federal cobol compiler testing service. the fortran compiler ! 52: c validation system (fcvs) consists of audit routines, their related ! 53: c data, and an executive system. each audit routine is a fortran ! 54: c program, subprogram or function which includes tests of specific ! 55: c language elements and supporting procedures indicating the result ! 56: c of executing these tests. ! 57: c ! 58: c this particular program/subprogram/function contains features ! 59: c found only in the subset as defined in x3.9-1978. ! 60: c ! 61: c suggestions and comments should be forwarded to - ! 62: c ! 63: c department of the navy ! 64: c federal cobol compiler testing service ! 65: c washington, d.c. 20376 ! 66: c ! 67: c ********************************************************** ! 68: c ! 69: c ! 70: c ! 71: c initialization section ! 72: c ! 73: c initialize constants ! 74: c ************** ! 75: c i01 contains the logical unit number for the card reader. ! 76: i01 = 5 ! 77: c i02 contains the logical unit number for the printer. ! 78: i02 = 6 ! 79: c system environment section ! 80: c ! 81: cx010 this card is replaced by contents of fexec x-010 control card. ! 82: c the cx010 card is for overriding the program default i01 = 5 ! 83: c (unit number for card reader). ! 84: cx011 this card is replaced by contents of fexec x-011 control card. ! 85: c the cx011 card is for systems which require additional ! 86: c fortran statements for files associated with cx010 above. ! 87: c ! 88: cx020 this card is replaced by contents of fexec x-020 control card. ! 89: c the cx020 card is for overriding the program default i02 = 6 ! 90: c (unit number for printer). ! 91: cx021 this card is replaced by contents of fexec x-021 control card. ! 92: c the cx021 card is for systems which require additional ! 93: c fortran statements for files associated with cx020 above. ! 94: c ! 95: ivpass=0 ! 96: ivfail=0 ! 97: ivdele=0 ! 98: iczero=0 ! 99: c ! 100: c write page headers ! 101: write (i02,90000) ! 102: write (i02,90001) ! 103: write (i02,90002) ! 104: write (i02, 90002) ! 105: write (i02,90003) ! 106: write (i02,90002) ! 107: write (i02,90004) ! 108: write (i02,90002) ! 109: write (i02,90011) ! 110: write (i02,90002) ! 111: write (i02,90002) ! 112: write (i02,90005) ! 113: write (i02,90006) ! 114: write (i02,90002) ! 115: ivtnum = 604 ! 116: c ! 117: c **** test 604 **** ! 118: c test 604 - this tests a simple assignment statement in setting ! 119: c an integer array element to a positive value of 32767. ! 120: c ! 121: if (iczero) 36040, 6040, 36040 ! 122: 6040 continue ! 123: iadn11(5) = 32767 ! 124: ivcomp = iadn11(5) ! 125: go to 46040 ! 126: 36040 ivdele = ivdele + 1 ! 127: write (i02,80003) ivtnum ! 128: if (iczero) 46040, 6051, 46040 ! 129: 46040 if ( ivcomp - 32767 ) 26040, 16040, 26040 ! 130: 16040 ivpass = ivpass + 1 ! 131: write (i02,80001) ivtnum ! 132: go to 6051 ! 133: 26040 ivfail = ivfail + 1 ! 134: ivcorr = 32767 ! 135: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 136: 6051 continue ! 137: ivtnum = 605 ! 138: c ! 139: c **** test 605 **** ! 140: c test 605 - test of a simple assign with a negative value -32766 ! 141: c ! 142: if (iczero) 36050, 6050, 36050 ! 143: 6050 continue ! 144: iadn11(1) = -32766 ! 145: ivcomp = iadn11(1) ! 146: go to 46050 ! 147: 36050 ivdele = ivdele + 1 ! 148: write (i02,80003) ivtnum ! 149: if (iczero) 46050, 6061, 46050 ! 150: 46050 if ( ivcomp + 32766 ) 26050, 16050, 26050 ! 151: 16050 ivpass = ivpass + 1 ! 152: write (i02,80001) ivtnum ! 153: go to 6061 ! 154: 26050 ivfail = ivfail + 1 ! 155: ivcorr = -32766 ! 156: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 157: 6061 continue ! 158: ivtnum = 606 ! 159: c ! 160: c **** test 606 **** ! 161: c test 606 - test of unsigned zero set to an array element ! 162: c by a simple assignment statement. ! 163: c ! 164: if (iczero) 36060, 6060, 36060 ! 165: 6060 continue ! 166: iadn11(3) = 0 ! 167: ivcomp = iadn11(3) ! 168: go to 46060 ! 169: 36060 ivdele = ivdele + 1 ! 170: write (i02,80003) ivtnum ! 171: if (iczero) 46060, 6071, 46060 ! 172: 46060 if ( ivcomp - 0 ) 26060, 16060, 26060 ! 173: 16060 ivpass = ivpass + 1 ! 174: write (i02,80001) ivtnum ! 175: go to 6071 ! 176: 26060 ivfail = ivfail + 1 ! 177: ivcorr = 0 ! 178: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 179: 6071 continue ! 180: ivtnum = 607 ! 181: c ! 182: c **** test 607 **** ! 183: c test 607 - test of a negatively signed zero compared to a ! 184: c zero unsigned both values set as integer array elements. ! 185: c ! 186: if (iczero) 36070, 6070, 36070 ! 187: 6070 continue ! 188: iadn11(2) = -0 ! 189: iadn11(3) = 0 ! 190: icon01 = 0 ! 191: if ( iadn11(2) .eq. iadn11(3) ) icon01 = 1 ! 192: go to 46070 ! 193: 36070 ivdele = ivdele + 1 ! 194: write (i02,80003) ivtnum ! 195: if (iczero) 46070, 6081, 46070 ! 196: 46070 if ( icon01 - 1 ) 26070, 16070, 26070 ! 197: 16070 ivpass = ivpass + 1 ! 198: write (i02,80001) ivtnum ! 199: go to 6081 ! 200: 26070 ivfail = ivfail + 1 ! 201: ivcomp = icon01 ! 202: ivcorr = 1 ! 203: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 204: 6081 continue ! 205: ivtnum = 608 ! 206: c ! 207: c **** test 608 **** ! 208: c test 608 - test of setting one integer array element equal to ! 209: c the value of another integer array element. the value is 32767. ! 210: c ! 211: if (iczero) 36080, 6080, 36080 ! 212: 6080 continue ! 213: iadn11(1) = 32767 ! 214: iadn12(5) = iadn11(1) ! 215: ivcomp = iadn12(5) ! 216: go to 46080 ! 217: 36080 ivdele = ivdele + 1 ! 218: write (i02,80003) ivtnum ! 219: if (iczero) 46080, 6091, 46080 ! 220: 46080 if ( ivcomp - 32767 ) 26080, 16080, 26080 ! 221: 16080 ivpass = ivpass + 1 ! 222: write (i02,80001) ivtnum ! 223: go to 6091 ! 224: 26080 ivfail = ivfail + 1 ! 225: ivcorr = 32767 ! 226: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 227: 6091 continue ! 228: ivtnum = 609 ! 229: c ! 230: c **** test 609 **** ! 231: c test 609 - test of an array element set to another array element ! 232: c which had been set at compile time by a data initialization ! 233: c statement. an integer array is used with the value 3. ! 234: c ! 235: if (iczero) 36090, 6090, 36090 ! 236: 6090 continue ! 237: iadn11(4) = iadn12(1) ! 238: ivcomp = iadn11(4) ! 239: go to 46090 ! 240: 36090 ivdele = ivdele + 1 ! 241: write (i02,80003) ivtnum ! 242: if (iczero) 46090, 6101, 46090 ! 243: 46090 if ( ivcomp - 3 ) 26090, 16090, 26090 ! 244: 16090 ivpass = ivpass + 1 ! 245: write (i02,80001) ivtnum ! 246: go to 6101 ! 247: 26090 ivfail = ivfail + 1 ! 248: ivcorr = 3 ! 249: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 250: 6101 continue ! 251: ivtnum = 610 ! 252: c ! 253: c **** test 610 **** ! 254: c test 610 - test of setting a real array element to a positive ! 255: c value in a simple assignment statement. value is 32767. ! 256: c ! 257: if (iczero) 36100, 6100, 36100 ! 258: 6100 continue ! 259: radn11(5) = 32767. ! 260: ivcomp = radn11(5) ! 261: go to 46100 ! 262: 36100 ivdele = ivdele + 1 ! 263: write (i02,80003) ivtnum ! 264: if (iczero) 46100, 6111, 46100 ! 265: 46100 if ( ivcomp - 32767 ) 26100, 16100, 26100 ! 266: 16100 ivpass = ivpass + 1 ! 267: write (i02,80001) ivtnum ! 268: go to 6111 ! 269: 26100 ivfail = ivfail + 1 ! 270: ivcorr = 32767 ! 271: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 272: 6111 continue ! 273: ivtnum = 611 ! 274: c ! 275: c **** test 611 **** ! 276: c test 611 - test of setting a real array element to a negative ! 277: c value in a simple assignment statement. value is -32766. ! 278: c ! 279: if (iczero) 36110, 6110, 36110 ! 280: 6110 continue ! 281: radn11(1) = -32766. ! 282: ivcomp = radn11(1) ! 283: go to 46110 ! 284: 36110 ivdele = ivdele + 1 ! 285: write (i02,80003) ivtnum ! 286: if (iczero) 46110, 6121, 46110 ! 287: 46110 if ( ivcomp + 32766 ) 26110, 16110, 26110 ! 288: 16110 ivpass = ivpass + 1 ! 289: write (i02,80001) ivtnum ! 290: go to 6121 ! 291: 26110 ivfail = ivfail + 1 ! 292: ivcorr = -32766 ! 293: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 294: 6121 continue ! 295: ivtnum = 612 ! 296: c ! 297: c **** test 612 **** ! 298: c test 612 - test of setting a real array element to unsigned zero ! 299: c in a simple assignment statement. ! 300: c ! 301: if (iczero) 36120, 6120, 36120 ! 302: 6120 continue ! 303: radn11(3) = 0. ! 304: ivcomp = radn11(3) ! 305: go to 46120 ! 306: 36120 ivdele = ivdele + 1 ! 307: write (i02,80003) ivtnum ! 308: if (iczero) 46120, 6131, 46120 ! 309: 46120 if ( ivcomp - 0 ) 26120, 16120, 26120 ! 310: 16120 ivpass = ivpass + 1 ! 311: write (i02,80001) ivtnum ! 312: go to 6131 ! 313: 26120 ivfail = ivfail + 1 ! 314: ivcorr = 0 ! 315: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 316: 6131 continue ! 317: ivtnum = 613 ! 318: c ! 319: c **** test 613 **** ! 320: c test 613 - test of a negatively signed zero in a real array ! 321: c element compared to a real element set to an unsigned zero. ! 322: c ! 323: if (iczero) 36130, 6130, 36130 ! 324: 6130 continue ! 325: radn11(2) = -0.0 ! 326: radn11(3) = 0.0 ! 327: icon01 = 0 ! 328: if ( radn11(2) .eq. radn11(3) ) icon01 = 1 ! 329: go to 46130 ! 330: 36130 ivdele = ivdele + 1 ! 331: write (i02,80003) ivtnum ! 332: if (iczero) 46130, 6141, 46130 ! 333: 46130 if ( icon01 - 1 ) 26130, 16130, 26130 ! 334: 16130 ivpass = ivpass + 1 ! 335: write (i02,80001) ivtnum ! 336: go to 6141 ! 337: 26130 ivfail = ivfail + 1 ! 338: ivcomp = icon01 ! 339: ivcorr = 1 ! 340: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 341: 6141 continue ! 342: ivtnum = 614 ! 343: c ! 344: c **** test 614 **** ! 345: c test 614 - test of setting one real array element equal to the ! 346: c value of another real array element. the value is 32767. ! 347: c ! 348: if (iczero) 36140, 6140, 36140 ! 349: 6140 continue ! 350: radn11(1) = 32767. ! 351: radn12(5) = radn11(1) ! 352: ivcomp = radn12(5) ! 353: go to 46140 ! 354: 36140 ivdele = ivdele + 1 ! 355: write (i02,80003) ivtnum ! 356: if (iczero) 46140, 6151, 46140 ! 357: 46140 if ( ivcomp - 32767 ) 26140, 16140, 26140 ! 358: 16140 ivpass = ivpass + 1 ! 359: write (i02,80001) ivtnum ! 360: go to 6151 ! 361: 26140 ivfail = ivfail + 1 ! 362: ivcorr = 32767 ! 363: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 364: 6151 continue ! 365: ivtnum = 615 ! 366: c ! 367: c **** test 615 **** ! 368: c test 615 - test of a real array element set to another real ! 369: c array element which had been set at compile time by a data ! 370: c initialization statement. the value is -512. ! 371: c ! 372: if (iczero) 36150, 6150, 36150 ! 373: 6150 continue ! 374: radn11(4) = radn12(1) ! 375: ivcomp = radn11(4) ! 376: go to 46150 ! 377: 36150 ivdele = ivdele + 1 ! 378: write (i02,80003) ivtnum ! 379: if (iczero) 46150, 6161, 46150 ! 380: 46150 if ( ivcomp + 512 ) 26150, 16150, 26150 ! 381: 16150 ivpass = ivpass + 1 ! 382: write (i02,80001) ivtnum ! 383: go to 6161 ! 384: 26150 ivfail = ivfail + 1 ! 385: ivcorr = - 512 ! 386: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 387: 6161 continue ! 388: ivtnum = 616 ! 389: c ! 390: c **** test 616 **** ! 391: c test 616 - test of setting the value of an integer array element ! 392: c by an arithmetic expression. ! 393: c ! 394: if (iczero) 36160, 6160, 36160 ! 395: 6160 continue ! 396: icon01 = 1 ! 397: iadn11(3) = icon01 + 1 ! 398: ivcomp = iadn11(3) ! 399: go to 46160 ! 400: 36160 ivdele = ivdele + 1 ! 401: write (i02,80003) ivtnum ! 402: if (iczero) 46160, 6171, 46160 ! 403: 46160 if ( ivcomp - 2 ) 26160, 16160, 26160 ! 404: 16160 ivpass = ivpass + 1 ! 405: write (i02,80001) ivtnum ! 406: go to 6171 ! 407: 26160 ivfail = ivfail + 1 ! 408: ivcorr = 2 ! 409: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 410: 6171 continue ! 411: ivtnum = 617 ! 412: c ! 413: c **** test 617 **** ! 414: c test 617 - test of setting the value of a real array element ! 415: c by an arithmetic expression. ! 416: c ! 417: if (iczero) 36170, 6170, 36170 ! 418: 6170 continue ! 419: rcon01 = 1. ! 420: radn11(3) = rcon01 + 1. ! 421: ivcomp = radn11(3) ! 422: go to 46170 ! 423: 36170 ivdele = ivdele + 1 ! 424: write (i02,80003) ivtnum ! 425: if (iczero) 46170, 6181, 46170 ! 426: 46170 if ( ivcomp - 2 ) 26170, 16170, 26170 ! 427: 16170 ivpass = ivpass + 1 ! 428: write (i02,80001) ivtnum ! 429: go to 6181 ! 430: 26170 ivfail = ivfail + 1 ! 431: ivcorr = 2 ! 432: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 433: 6181 continue ! 434: ivtnum = 618 ! 435: c ! 436: c **** test 618 **** ! 437: c test 618 - test of setting the value of an integer array element ! 438: c to another integer array element and changing the sign. ! 439: c ! 440: if (iczero) 36180, 6180, 36180 ! 441: 6180 continue ! 442: iadn11(2) = 32766 ! 443: iadn11(4) = - iadn11(2) ! 444: ivcomp = iadn11(4) ! 445: go to 46180 ! 446: 36180 ivdele = ivdele + 1 ! 447: write (i02,80003) ivtnum ! 448: if (iczero) 46180, 6191, 46180 ! 449: 46180 if ( ivcomp + 32766 ) 26180, 16180, 26180 ! 450: 16180 ivpass = ivpass + 1 ! 451: write (i02,80001) ivtnum ! 452: go to 6191 ! 453: 26180 ivfail = ivfail + 1 ! 454: ivcorr = -32766 ! 455: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 456: 6191 continue ! 457: ivtnum = 619 ! 458: c ! 459: c **** test 619 **** ! 460: c test 619 - test of setting the value of a real array element ! 461: c to the value of another real array element and changing the sign. ! 462: c ! 463: if (iczero) 36190, 6190, 36190 ! 464: 6190 continue ! 465: radn11(2) = 32766. ! 466: radn11(4) = - radn11(2) ! 467: ivcomp = radn11(4) ! 468: go to 46190 ! 469: 36190 ivdele = ivdele + 1 ! 470: write (i02,80003) ivtnum ! 471: if (iczero) 46190, 6201, 46190 ! 472: 46190 if ( ivcomp + 32766 ) 26190, 16190, 26190 ! 473: 16190 ivpass = ivpass + 1 ! 474: write (i02,80001) ivtnum ! 475: go to 6201 ! 476: 26190 ivfail = ivfail + 1 ! 477: ivcorr = -32766 ! 478: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 479: 6201 continue ! 480: ivtnum = 620 ! 481: c ! 482: c **** test 620 **** ! 483: c test 620 - test of setting the value of a logical array element ! 484: c to the value of another logical array element. ! 485: c ! 486: if (iczero) 36200, 6200, 36200 ! 487: 6200 continue ! 488: ladn11(1) = .true. ! 489: ladn12(1) = ladn11(1) ! 490: icon01 = 0 ! 491: if ( ladn12(1) ) icon01 = 1 ! 492: go to 46200 ! 493: 36200 ivdele = ivdele + 1 ! 494: write (i02,80003) ivtnum ! 495: if (iczero) 46200, 6211, 46200 ! 496: 46200 if ( icon01 - 1 ) 26200, 16200, 26200 ! 497: 16200 ivpass = ivpass + 1 ! 498: write (i02,80001) ivtnum ! 499: go to 6211 ! 500: 26200 ivfail = ivfail + 1 ! 501: ivcomp = icon01 ! 502: ivcorr = 1 ! 503: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 504: 6211 continue ! 505: ivtnum = 621 ! 506: c ! 507: c **** test 621 **** ! 508: c test 621 - test of setting the value of a logical array element ! 509: c to the value of another logical array element and changing ! 510: c the value from .true. to .false. by using the .not. statement. ! 511: c ! 512: if (iczero) 36210, 6210, 36210 ! 513: 6210 continue ! 514: ladn11(2) = .true. ! 515: ladn12(2) = .not. ladn11(2) ! 516: icon01 = 1 ! 517: if ( ladn12(2) ) icon01 = 0 ! 518: go to 46210 ! 519: 36210 ivdele = ivdele + 1 ! 520: write (i02,80003) ivtnum ! 521: if (iczero) 46210, 6221, 46210 ! 522: 46210 if ( icon01 - 1 ) 26210, 16210, 26210 ! 523: 16210 ivpass = ivpass + 1 ! 524: write (i02,80001) ivtnum ! 525: go to 6221 ! 526: 26210 ivfail = ivfail + 1 ! 527: ivcomp = icon01 ! 528: ivcorr = 1 ! 529: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 530: 6221 continue ! 531: ivtnum = 622 ! 532: c ! 533: c **** test 622 **** ! 534: c test 622 - test of the type statement and the data ! 535: c initialization statement. the explicitly real array element ! 536: c should have the value of .5 ! 537: c ! 538: if (iczero) 36220, 6220, 36220 ! 539: 6220 continue ! 540: ivcomp = 2. * iadn13(1) ! 541: go to 46220 ! 542: 36220 ivdele = ivdele + 1 ! 543: write (i02,80003) ivtnum ! 544: if (iczero) 46220, 6231, 46220 ! 545: 46220 if ( ivcomp - 1 ) 26220, 16220, 26220 ! 546: 16220 ivpass = ivpass + 1 ! 547: write (i02,80001) ivtnum ! 548: go to 6231 ! 549: 26220 ivfail = ivfail + 1 ! 550: ivcorr = 1 ! 551: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 552: 6231 continue ! 553: ivtnum = 623 ! 554: c ! 555: c **** test 623 **** ! 556: c test 623 - test of real to integer conversion using arrays. ! 557: c the initialized value of 0.5 should be truncated to zero. ! 558: c ! 559: if (iczero) 36230, 6230, 36230 ! 560: 6230 continue ! 561: iadn11(1) = iadn13(1) ! 562: ivcomp = iadn11(1) ! 563: go to 46230 ! 564: 36230 ivdele = ivdele + 1 ! 565: write (i02,80003) ivtnum ! 566: if (iczero) 46230, 6241, 46230 ! 567: 46230 if ( ivcomp - 0 ) 26230, 16230, 26230 ! 568: 16230 ivpass = ivpass + 1 ! 569: write (i02,80001) ivtnum ! 570: go to 6241 ! 571: 26230 ivfail = ivfail + 1 ! 572: ivcorr = 0 ! 573: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 574: 6241 continue ! 575: ivtnum = 624 ! 576: c ! 577: c **** test 624 **** ! 578: c test 624 - test of the common statement by setting the value of ! 579: c an integer array element in a dimensioned array to the value ! 580: c of a real array element in common. the element in common had its ! 581: c value set in a simple assignment statement to 9999. ! 582: c ! 583: if (iczero) 36240, 6240, 36240 ! 584: 6240 continue ! 585: radn14(1) = 9999. ! 586: iadn11(1) = radn14(1) ! 587: ivcomp = iadn11(1) ! 588: go to 46240 ! 589: 36240 ivdele = ivdele + 1 ! 590: write (i02,80003) ivtnum ! 591: if (iczero) 46240, 6251, 46240 ! 592: 46240 if ( ivcomp - 9999 ) 26240, 16240, 26240 ! 593: 16240 ivpass = ivpass + 1 ! 594: write (i02,80001) ivtnum ! 595: go to 6251 ! 596: 26240 ivfail = ivfail + 1 ! 597: ivcorr = 9999 ! 598: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 599: 6251 continue ! 600: ivtnum = 625 ! 601: c ! 602: c **** test 625 **** ! 603: c test 625 - test of setting the value of an integer array element ! 604: c in common to the value of a real array element also in blank ! 605: c common and changing the sign. the value used is 9999. ! 606: c ! 607: if (iczero) 36250, 6250, 36250 ! 608: 6250 continue ! 609: radn14(1) = 9999. ! 610: iadn14(1) = - radn14(1) ! 611: ivcomp = iadn14(1) ! 612: go to 46250 ! 613: 36250 ivdele = ivdele + 1 ! 614: write (i02,80003) ivtnum ! 615: if (iczero) 46250, 6261, 46250 ! 616: 46250 if ( ivcomp + 9999 ) 26250, 16250, 26250 ! 617: 16250 ivpass = ivpass + 1 ! 618: write (i02,80001) ivtnum ! 619: go to 6261 ! 620: 26250 ivfail = ivfail + 1 ! 621: ivcorr = - 9999 ! 622: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 623: 6261 continue ! 624: ivtnum = 626 ! 625: c ! 626: c **** test 626 **** ! 627: c test 626 - test of setting the value of a logical array element ! 628: c in blank common to .not. .true. ! 629: c the value of another logical array element also in common is then ! 630: c set to .not. of the value of the first. ! 631: c value of the first element should be .false. ! 632: c value of the second element should be .true. ! 633: c ! 634: if (iczero) 36260, 6260, 36260 ! 635: 6260 continue ! 636: ladn13(1) = .not. .true. ! 637: ladn13(2) = .not. ladn13(1) ! 638: icon01 = 0 ! 639: if ( ladn13(2) ) icon01 = 1 ! 640: go to 46260 ! 641: 36260 ivdele = ivdele + 1 ! 642: write (i02,80003) ivtnum ! 643: if (iczero) 46260, 6271, 46260 ! 644: 46260 if ( icon01 - 1 ) 26260, 16260, 26260 ! 645: 16260 ivpass = ivpass + 1 ! 646: write (i02,80001) ivtnum ! 647: go to 6271 ! 648: 26260 ivfail = ivfail + 1 ! 649: ivcomp = icon01 ! 650: ivcorr = 1 ! 651: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 652: 6271 continue ! 653: ivtnum = 627 ! 654: c ! 655: c **** test 627 **** ! 656: c test 627 - test of equivalence on the first elements of integer ! 657: c arrays one of which is in common and the other one is dimensioned. ! 658: c ! 659: if (iczero) 36270, 6270, 36270 ! 660: 6270 continue ! 661: iadn14(2) = 32767 ! 662: ivcomp = iadn15(2) ! 663: go to 46270 ! 664: 36270 ivdele = ivdele + 1 ! 665: write (i02,80003) ivtnum ! 666: if (iczero) 46270, 6281, 46270 ! 667: 46270 if ( ivcomp - 32767 ) 26270, 16270, 26270 ! 668: 16270 ivpass = ivpass + 1 ! 669: write (i02,80001) ivtnum ! 670: go to 6281 ! 671: 26270 ivfail = ivfail + 1 ! 672: ivcorr = 32767 ! 673: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 674: 6281 continue ! 675: ivtnum = 628 ! 676: c ! 677: c **** test 628 **** ! 678: c test 628 - test of equivalence on real arrays one of which is ! 679: c in common and the other one is dimensioned. the arrays were ! 680: c aligned on their second elements. ! 681: c ! 682: if (iczero) 36280, 6280, 36280 ! 683: 6280 continue ! 684: radn15(1) = -32766. ! 685: ivcomp = radn14(1) ! 686: go to 46280 ! 687: 36280 ivdele = ivdele + 1 ! 688: write (i02,80003) ivtnum ! 689: if (iczero) 46280, 6291, 46280 ! 690: 46280 if ( ivcomp + 32766 ) 26280, 16280, 26280 ! 691: 16280 ivpass = ivpass + 1 ! 692: write (i02,80001) ivtnum ! 693: go to 6291 ! 694: 26280 ivfail = ivfail + 1 ! 695: ivcorr = -32766 ! 696: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 697: 6291 continue ! 698: ivtnum = 629 ! 699: c ! 700: c **** test 629 **** ! 701: c test 629 - test of equivalence with logical elements. an array ! 702: c element in common is equivalenced to a logical variable. ! 703: c ! 704: if (iczero) 36290, 6290, 36290 ! 705: 6290 continue ! 706: ladn13(2) = .true. ! 707: lctn01 = .not. ladn13(2) ! 708: icon01 = 1 ! 709: if ( ladn13(1) ) icon01 = 0 ! 710: go to 46290 ! 711: 36290 ivdele = ivdele + 1 ! 712: write (i02,80003) ivtnum ! 713: if (iczero) 46290, 6301, 46290 ! 714: 46290 if ( icon01 - 1 ) 26290, 16290, 26290 ! 715: 16290 ivpass = ivpass + 1 ! 716: write (i02,80001) ivtnum ! 717: go to 6301 ! 718: 26290 ivfail = ivfail + 1 ! 719: ivcomp = icon01 ! 720: ivcorr = 1 ! 721: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 722: 6301 continue ! 723: ivtnum = 630 ! 724: c ! 725: c **** test 630 **** ! 726: c test 630 - test of equivalence with real and integer elements ! 727: c which are equivalenced to array elements in common. ! 728: c ! 729: if (iczero) 36300, 6300, 36300 ! 730: 6300 continue ! 731: rcon01 = 1. ! 732: icon02 = - radn14(5) ! 733: ivcomp = iadn14(5) ! 734: go to 46300 ! 735: 36300 ivdele = ivdele + 1 ! 736: write (i02,80003) ivtnum ! 737: if (iczero) 46300, 6311, 46300 ! 738: 46300 if ( ivcomp + 1 ) 26300, 16300, 26300 ! 739: 16300 ivpass = ivpass + 1 ! 740: write (i02,80001) ivtnum ! 741: go to 6311 ! 742: 26300 ivfail = ivfail + 1 ! 743: ivcorr = -1 ! 744: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 745: 6311 continue ! 746: ivtnum = 631 ! 747: c ! 748: c **** test 631 **** ! 749: c test 631 - test of equivalence on integer array elements. ! 750: c both arrays are dimensioned. the fourth element ! 751: c of the first of the arrays should be equal to the third element of ! 752: c the second array. ! 753: c ! 754: if (iczero) 36310, 6310, 36310 ! 755: 6310 continue ! 756: iadn16(4) = 9999 ! 757: ivcomp = iadn17(3) ! 758: go to 46310 ! 759: 36310 ivdele = ivdele + 1 ! 760: write (i02,80003) ivtnum ! 761: if (iczero) 46310, 6321, 46310 ! 762: 46310 if ( ivcomp - 9999 ) 26310, 16310, 26310 ! 763: 16310 ivpass = ivpass + 1 ! 764: write (i02,80001) ivtnum ! 765: go to 6321 ! 766: 26310 ivfail = ivfail + 1 ! 767: ivcorr = 9999 ! 768: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 769: 6321 continue ! 770: c ! 771: c write page footings and run summaries ! 772: 99999 continue ! 773: write (i02,90002) ! 774: write (i02,90006) ! 775: write (i02,90002) ! 776: write (i02,90002) ! 777: write (i02,90007) ! 778: write (i02,90002) ! 779: write (i02,90008) ivfail ! 780: write (i02,90009) ivpass ! 781: write (i02,90010) ivdele ! 782: c ! 783: c ! 784: c terminate routine execution ! 785: stop ! 786: c ! 787: c format statements for page headers ! 788: 90000 format (1h1) ! 789: 90002 format (1h ) ! 790: 90001 format (1h ,10x,34hfortran compiler validation system) ! 791: 90003 format (1h ,21x,11hversion 1.0) ! 792: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 793: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 794: 90006 format (1h ,5x,46h----------------------------------------------) ! 795: 90011 format (1h ,18x,17hsubset level test) ! 796: c ! 797: c format statements for run summaries ! 798: 90008 format (1h ,15x,i5,19h errors encountered) ! 799: 90009 format (1h ,15x,i5,13h tests passed) ! 800: 90010 format (1h ,15x,i5,14h tests deleted) ! 801: c ! 802: c format statements for test results ! 803: 80001 format (1h ,4x,i5,7x,4hpass) ! 804: 80002 format (1h ,4x,i5,7x,4hfail) ! 805: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 806: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 807: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 808: c ! 809: 90007 format (1h ,20x,20hend of program fm022) ! 810: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.