![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm098.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 fm098.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 fm098 ! 4: c ! 5: c this routine tests intrinsic functions where the function type is ! 6: c integer and the arguments are either integer or real. the real ! 7: c and integer variables and the real and integer constants contain ! 8: c both positive and negative values. the intrinsic functions tested ! 9: c by fm098 include ! 10: c type of ! 11: c intrinsic function name argument function ! 12: c ------------------ ---- -------- -------- ! 13: c absolute value iabs integer integer ! 14: c truncation int real integer ! 15: c remaindering mod integer integer ! 16: c choosing largest value max0 integer integer ! 17: c max1 real integer ! 18: c choosing smallest value min0 integer integer ! 19: c min1 real integer ! 20: c fix ifix real integer ! 21: c transfer of sign isign integer integer ! 22: c positive difference idim integer integer ! 23: c ! 24: c references ! 25: c american national standard programming language fortran, ! 26: c x3.9-1978 ! 27: c ! 28: c section 4.1.2, type rules for data and procedure identifiers ! 29: c section 15.3, intrinsic function ! 30: c section 15.3.2, intrinsic functions and their reference ! 31: c ! 32: c ! 33: c ********************************************************** ! 34: c ! 35: c a compiler validation system for the fortran language ! 36: c based on specifications as defined in american national standard ! 37: c programming language fortran x3.9-1978, has been developed by the ! 38: c federal cobol compiler testing service. the fortran compiler ! 39: c validation system (fcvs) consists of audit routines, their related ! 40: c data, and an executive system. each audit routine is a fortran ! 41: c program, subprogram or function which includes tests of specific ! 42: c language elements and supporting procedures indicating the result ! 43: c of executing these tests. ! 44: c ! 45: c this particular program/subprogram/function contains features ! 46: c found only in the subset as defined in x3.9-1978. ! 47: c ! 48: c suggestions and comments should be forwarded to - ! 49: c ! 50: c department of the navy ! 51: c federal cobol compiler testing service ! 52: c washington, d.c. 20376 ! 53: c ! 54: c ********************************************************** ! 55: c ! 56: c ! 57: c ! 58: c initialization section ! 59: c ! 60: c initialize constants ! 61: c ************** ! 62: c i01 contains the logical unit number for the card reader. ! 63: i01 = 5 ! 64: c i02 contains the logical unit number for the printer. ! 65: i02 = 6 ! 66: c system environment section ! 67: c ! 68: cx010 this card is replaced by contents of fexec x-010 control card. ! 69: c the cx010 card is for overriding the program default i01 = 5 ! 70: c (unit number for card reader). ! 71: cx011 this card is replaced by contents of fexec x-011 control card. ! 72: c the cx011 card is for systems which require additional ! 73: c fortran statements for files associated with cx010 above. ! 74: c ! 75: cx020 this card is replaced by contents of fexec x-020 control card. ! 76: c the cx020 card is for overriding the program default i02 = 6 ! 77: c (unit number for printer). ! 78: cx021 this card is replaced by contents of fexec x-021 control card. ! 79: c the cx021 card is for systems which require additional ! 80: c fortran statements for files associated with cx020 above. ! 81: c ! 82: ivpass=0 ! 83: ivfail=0 ! 84: ivdele=0 ! 85: iczero=0 ! 86: c ! 87: c write page headers ! 88: write (i02,90000) ! 89: write (i02,90001) ! 90: write (i02,90002) ! 91: write (i02, 90002) ! 92: write (i02,90003) ! 93: write (i02,90002) ! 94: write (i02,90004) ! 95: write (i02,90002) ! 96: write (i02,90011) ! 97: write (i02,90002) ! 98: write (i02,90002) ! 99: write (i02,90005) ! 100: write (i02,90006) ! 101: write (i02,90002) ! 102: c ! 103: c test section ! 104: c ! 105: c test 907 through test 909 contain intrinsic function tests for ! 106: c absolute value where argument and function are integer ! 107: c ! 108: 9071 continue ! 109: ivtnum = 907 ! 110: c ! 111: c **** test 907 **** ! 112: c ! 113: if (iczero) 39070, 9070, 39070 ! 114: 9070 continue ! 115: ivcomp = iabs (-382) ! 116: go to 49070 ! 117: 39070 ivdele = ivdele + 1 ! 118: write (i02,80003) ivtnum ! 119: if (iczero) 49070, 9081, 49070 ! 120: 49070 if (ivcomp - 382) 29070,19070,29070 ! 121: 19070 ivpass = ivpass + 1 ! 122: write (i02,80001) ivtnum ! 123: go to 9081 ! 124: 29070 ivfail = ivfail + 1 ! 125: ivcorr = 382 ! 126: write (i02,80004) ivtnum, ivcomp, ivcorr ! 127: 9081 continue ! 128: ivtnum = 908 ! 129: c ! 130: c **** test 908 **** ! 131: c ! 132: if (iczero) 39080, 9080, 39080 ! 133: 9080 continue ! 134: ivon01 = 445 ! 135: ivcomp = iabs (ivon01) ! 136: go to 49080 ! 137: 39080 ivdele = ivdele + 1 ! 138: write (i02,80003) ivtnum ! 139: if (iczero) 49080, 9091, 49080 ! 140: 49080 if (ivcomp - 445) 29080,19080,29080 ! 141: 19080 ivpass = ivpass + 1 ! 142: write (i02,80001) ivtnum ! 143: go to 9091 ! 144: 29080 ivfail = ivfail + 1 ! 145: ivcorr = 445 ! 146: write (i02,80004) ivtnum, ivcomp, ivcorr ! 147: 9091 continue ! 148: ivtnum = 909 ! 149: c ! 150: c **** test 909 **** ! 151: c ! 152: if (iczero) 39090, 9090, 39090 ! 153: 9090 continue ! 154: ivon01 = -32176 ! 155: ivcomp = iabs (ivon01) ! 156: go to 49090 ! 157: 39090 ivdele = ivdele + 1 ! 158: write (i02,80003) ivtnum ! 159: if (iczero) 49090, 9101, 49090 ! 160: 49090 if (ivcomp - 32176) 29090,19090,29090 ! 161: 19090 ivpass = ivpass + 1 ! 162: write (i02,80001) ivtnum ! 163: go to 9101 ! 164: 29090 ivfail = ivfail + 1 ! 165: ivcorr = 32176 ! 166: write (i02,80004) ivtnum, ivcomp, ivcorr ! 167: c ! 168: c test 910 through test 913 contain intrinsic function tests for ! 169: c truncation where argument is real and function is integer ! 170: c ! 171: 9101 continue ! 172: ivtnum = 910 ! 173: c ! 174: c **** test 910 **** ! 175: c ! 176: if (iczero) 39100, 9100, 39100 ! 177: 9100 continue ! 178: ivcomp = int (38.2) ! 179: go to 49100 ! 180: 39100 ivdele = ivdele + 1 ! 181: write (i02,80003) ivtnum ! 182: if (iczero) 49100, 9111, 49100 ! 183: 49100 if (ivcomp - 38) 29100,19100,29100 ! 184: 19100 ivpass = ivpass + 1 ! 185: write (i02,80001) ivtnum ! 186: go to 9111 ! 187: 29100 ivfail = ivfail + 1 ! 188: ivcorr = 38 ! 189: write (i02,80004) ivtnum, ivcomp, ivcorr ! 190: 9111 continue ! 191: ivtnum = 911 ! 192: c ! 193: c **** test 911 **** ! 194: c ! 195: if (iczero) 39110, 9110, 39110 ! 196: 9110 continue ! 197: rvon01 = -445.95 ! 198: ivcomp = int (rvon01) ! 199: go to 49110 ! 200: 39110 ivdele = ivdele + 1 ! 201: write (i02,80003) ivtnum ! 202: if (iczero) 49110, 9121, 49110 ! 203: 49110 if (ivcomp + 445) 29110,19110,29110 ! 204: 19110 ivpass = ivpass + 1 ! 205: write (i02,80001) ivtnum ! 206: go to 9121 ! 207: 29110 ivfail = ivfail + 1 ! 208: ivcorr = -445 ! 209: write (i02,80004) ivtnum, ivcomp, ivcorr ! 210: 9121 continue ! 211: ivtnum = 912 ! 212: c ! 213: c **** test 912 **** ! 214: c ! 215: if (iczero) 39120, 9120, 39120 ! 216: 9120 continue ! 217: rvon01 = 466.01 ! 218: ivcomp = int (rvon01) ! 219: go to 49120 ! 220: 39120 ivdele = ivdele + 1 ! 221: write (i02,80003) ivtnum ! 222: if (iczero) 49120, 9131, 49120 ! 223: 49120 if (ivcomp - 466) 29120,19120,29120 ! 224: 19120 ivpass = ivpass + 1 ! 225: write (i02,80001) ivtnum ! 226: go to 9131 ! 227: 29120 ivfail = ivfail + 1 ! 228: ivcorr = 466 ! 229: write (i02,80004) ivtnum, ivcomp, ivcorr ! 230: 9131 continue ! 231: ivtnum = 913 ! 232: c ! 233: c **** test 913 **** ! 234: c ! 235: if (iczero) 39130, 9130, 39130 ! 236: 9130 continue ! 237: rvon01 = 382e-1 ! 238: ivcomp = int (rvon01) ! 239: go to 49130 ! 240: 39130 ivdele = ivdele + 1 ! 241: write (i02,80003) ivtnum ! 242: if (iczero) 49130, 9141, 49130 ! 243: 49130 if (ivcomp - 38) 29130,19130,29130 ! 244: 19130 ivpass = ivpass + 1 ! 245: write (i02,80001) ivtnum ! 246: go to 9141 ! 247: 29130 ivfail = ivfail + 1 ! 248: ivcorr = 38 ! 249: write (i02,80004) ivtnum, ivcomp, ivcorr ! 250: c ! 251: c test 914 through test 917 contain intrinsic function tests for ! 252: c remaindering where arguments and function are integers ! 253: c ! 254: 9141 continue ! 255: ivtnum = 914 ! 256: c ! 257: c **** test 914 **** ! 258: c ! 259: if (iczero) 39140, 9140, 39140 ! 260: 9140 continue ! 261: ivcomp = mod (42,19) ! 262: go to 49140 ! 263: 39140 ivdele = ivdele + 1 ! 264: write (i02,80003) ivtnum ! 265: if (iczero) 49140, 9151, 49140 ! 266: 49140 if (ivcomp - 4) 29140,19140,29140 ! 267: 19140 ivpass = ivpass + 1 ! 268: write (i02,80001) ivtnum ! 269: go to 9151 ! 270: 29140 ivfail = ivfail + 1 ! 271: ivcorr = 4 ! 272: write (i02,80004) ivtnum, ivcomp, ivcorr ! 273: 9151 continue ! 274: ivtnum = 915 ! 275: c ! 276: c **** test 915 **** ! 277: c ! 278: if (iczero) 39150, 9150, 39150 ! 279: 9150 continue ! 280: ivon01 = 6667 ! 281: ivon02 = 2 ! 282: ivcomp = mod (ivon01,ivon02) ! 283: go to 49150 ! 284: 39150 ivdele = ivdele + 1 ! 285: write (i02,80003) ivtnum ! 286: if (iczero) 49150, 9161, 49150 ! 287: 49150 if (ivcomp - 1) 29150,19150,29150 ! 288: 19150 ivpass = ivpass + 1 ! 289: write (i02,80001) ivtnum ! 290: go to 9161 ! 291: 29150 ivfail = ivfail + 1 ! 292: ivcorr = 1 ! 293: write (i02,80004) ivtnum, ivcomp, ivcorr ! 294: 9161 continue ! 295: ivtnum = 916 ! 296: c ! 297: c **** test 916 **** ! 298: c ! 299: if (iczero) 39160, 9160, 39160 ! 300: 9160 continue ! 301: ivon01 = 225 ! 302: ivon02 = 50 ! 303: ivcomp = mod (ivon01,ivon02) ! 304: go to 49160 ! 305: 39160 ivdele = ivdele + 1 ! 306: write (i02,80003) ivtnum ! 307: if (iczero) 49160, 9171, 49160 ! 308: 49160 if (ivcomp - 25) 29160,19160,29160 ! 309: 19160 ivpass = ivpass + 1 ! 310: write (i02,80001) ivtnum ! 311: go to 9171 ! 312: 29160 ivfail = ivfail + 1 ! 313: ivcorr = 25 ! 314: write (i02,80004) ivtnum, ivcomp, ivcorr ! 315: 9171 continue ! 316: ivtnum = 917 ! 317: c ! 318: c **** test 917 **** ! 319: c ! 320: if (iczero) 39170, 9170, 39170 ! 321: 9170 continue ! 322: ivon01 = -39 ! 323: ivon02 = 500 ! 324: ivcomp = mod (ivon01,ivon02) ! 325: go to 49170 ! 326: 39170 ivdele = ivdele + 1 ! 327: write (i02,80003) ivtnum ! 328: if (iczero) 49170, 9181, 49170 ! 329: 49170 if (ivcomp + 39) 29170,19170,29170 ! 330: 19170 ivpass = ivpass + 1 ! 331: write (i02,80001) ivtnum ! 332: go to 9181 ! 333: 29170 ivfail = ivfail + 1 ! 334: ivcorr = -39 ! 335: write (i02,80004) ivtnum, ivcomp, ivcorr ! 336: c ! 337: c test 918 and 919 contain intrinsic function tests for choosing ! 338: c largest value where arguments and function are integer ! 339: c ! 340: 9181 continue ! 341: ivtnum = 918 ! 342: c ! 343: c **** test 918 **** ! 344: c ! 345: if (iczero) 39180, 9180, 39180 ! 346: 9180 continue ! 347: ivon01 = 317 ! 348: ivon02 = -99 ! 349: ivon03 = 1 ! 350: ivcomp = max0 (263,ivon01,ivon02,ivon03) ! 351: go to 49180 ! 352: 39180 ivdele = ivdele + 1 ! 353: write (i02,80003) ivtnum ! 354: if (iczero) 49180, 9191, 49180 ! 355: 49180 if (ivcomp - 317) 29180,19180,29180 ! 356: 19180 ivpass = ivpass + 1 ! 357: write (i02,80001) ivtnum ! 358: go to 9191 ! 359: 29180 ivfail = ivfail + 1 ! 360: ivcorr = 317 ! 361: write (i02,80004) ivtnum, ivcomp, ivcorr ! 362: 9191 continue ! 363: ivtnum = 919 ! 364: c ! 365: c **** test 919 **** ! 366: c ! 367: if (iczero) 39190, 9190, 39190 ! 368: 9190 continue ! 369: ivon01 = 2572 ! 370: ivon02 = 2570 ! 371: ivcomp = max0 (ivon01,ivon02) ! 372: go to 49190 ! 373: 39190 ivdele = ivdele + 1 ! 374: write (i02,80003) ivtnum ! 375: if (iczero) 49190, 9201, 49190 ! 376: 49190 if (ivcomp - 2572) 29190,19190,29190 ! 377: 19190 ivpass = ivpass + 1 ! 378: write (i02,80001) ivtnum ! 379: go to 9201 ! 380: 29190 ivfail = ivfail + 1 ! 381: ivcorr = 2572 ! 382: write (i02,80004) ivtnum, ivcomp, ivcorr ! 383: c ! 384: c test 920 and 921 contain intrinsic function tests for choosing ! 385: c largest value where arguments are real and function is integer ! 386: c ! 387: 9201 continue ! 388: ivtnum = 920 ! 389: c ! 390: c **** test 920 **** ! 391: c ! 392: if (iczero) 39200, 9200, 39200 ! 393: 9200 continue ! 394: rvon01 = .326e+2 ! 395: rvon02 = 22.075 ! 396: rvon03 = 76e-1 ! 397: ivcomp = max1 (rvon01,rvon02,rvon03) ! 398: go to 49200 ! 399: 39200 ivdele = ivdele + 1 ! 400: write (i02,80003) ivtnum ! 401: if (iczero) 49200, 9211, 49200 ! 402: 49200 if (ivcomp - 32) 29200,19200,29200 ! 403: 19200 ivpass = ivpass + 1 ! 404: write (i02,80001) ivtnum ! 405: go to 9211 ! 406: 29200 ivfail = ivfail + 1 ! 407: ivcorr = 32 ! 408: write (i02,80004) ivtnum, ivcomp, ivcorr ! 409: 9211 continue ! 410: ivtnum = 921 ! 411: c ! 412: c **** test 921 **** ! 413: c ! 414: if (iczero) 39210, 9210, 39210 ! 415: 9210 continue ! 416: rvon01 = -6.3e2 ! 417: rvon02 = -21.0 ! 418: ivcomp = max1 (-463.3,rvon01,rvon02) ! 419: go to 49210 ! 420: 39210 ivdele = ivdele + 1 ! 421: write (i02,80003) ivtnum ! 422: if (iczero) 49210, 9221, 49210 ! 423: 49210 if (ivcomp + 21) 29210,19210,29210 ! 424: 19210 ivpass = ivpass + 1 ! 425: write (i02,80001) ivtnum ! 426: go to 9221 ! 427: 29210 ivfail = ivfail + 1 ! 428: ivcorr = -21 ! 429: write (i02,80004) ivtnum, ivcomp, ivcorr ! 430: c ! 431: c test 922 and 923 contain intrinsic function tests for choosing ! 432: c smallest value where arguments and function are integer ! 433: c ! 434: 9221 continue ! 435: ivtnum = 922 ! 436: c ! 437: c **** test 922 **** ! 438: c ! 439: if (iczero) 39220, 9220, 39220 ! 440: 9220 continue ! 441: ivon01 = -75 ! 442: ivon02 = -243 ! 443: ivcomp = min0 (ivon01,ivon02) ! 444: go to 49220 ! 445: 39220 ivdele = ivdele + 1 ! 446: write (i02,80003) ivtnum ! 447: if (iczero) 49220, 9231, 49220 ! 448: 49220 if (ivcomp + 243) 29220,19220,29220 ! 449: 19220 ivpass = ivpass + 1 ! 450: write (i02,80001) ivtnum ! 451: go to 9231 ! 452: 29220 ivfail = ivfail + 1 ! 453: ivcorr = -243 ! 454: write (i02,80004) ivtnum, ivcomp, ivcorr ! 455: 9231 continue ! 456: ivtnum = 923 ! 457: c ! 458: c **** test 923 **** ! 459: c ! 460: if (iczero) 39230, 9230, 39230 ! 461: 9230 continue ! 462: ivon01 = -11 ! 463: ivon02 = 11 ! 464: ivcomp = min0 (0,ivon01,ivon02) ! 465: go to 49230 ! 466: 39230 ivdele = ivdele + 1 ! 467: write (i02,80003) ivtnum ! 468: if (iczero) 49230, 9241, 49230 ! 469: 49230 if (ivcomp + 11) 29230,19230,29230 ! 470: 19230 ivpass = ivpass + 1 ! 471: write (i02,80001) ivtnum ! 472: go to 9241 ! 473: 29230 ivfail = ivfail + 1 ! 474: ivcorr = -11 ! 475: write (i02,80004) ivtnum, ivcomp, ivcorr ! 476: c ! 477: c test 924 and 925 contain intrinsic function tests for choosing ! 478: c smallest value where arguments are real and function is integer ! 479: c ! 480: 9241 continue ! 481: ivtnum = 924 ! 482: c ! 483: c **** test 924 **** ! 484: c ! 485: if (iczero) 39240, 9240, 39240 ! 486: 9240 continue ! 487: rvon01 = 1.1111 ! 488: rvon02 = 22.222 ! 489: rvon03 = 333.33 ! 490: ivcomp = min1 (rvon01,rvon02,rvon03) ! 491: go to 49240 ! 492: 39240 ivdele = ivdele + 1 ! 493: write (i02,80003) ivtnum ! 494: if (iczero) 49240, 9251, 49240 ! 495: 49240 if (ivcomp - 1) 29240,19240,29240 ! 496: 19240 ivpass = ivpass + 1 ! 497: write (i02,80001) ivtnum ! 498: go to 9251 ! 499: 29240 ivfail = ivfail + 1 ! 500: ivcorr = 1 ! 501: write (i02,80004) ivtnum, ivcomp, ivcorr ! 502: 9251 continue ! 503: ivtnum = 925 ! 504: c ! 505: c **** test 925 **** ! 506: c ! 507: if (iczero) 39250, 9250, 39250 ! 508: 9250 continue ! 509: rvon01 = 28.8 ! 510: rvon02 = 2.88e1 ! 511: rvon03 = 288e-1 ! 512: rvon04 = 35.0 ! 513: ivcomp = min1 (rvon01,rvon02,rvon03,rvon04) ! 514: go to 49250 ! 515: 39250 ivdele = ivdele + 1 ! 516: write (i02,80003) ivtnum ! 517: if (iczero) 49250, 9261, 49250 ! 518: 49250 if (ivcomp - 28) 29250,19250,29250 ! 519: 19250 ivpass = ivpass + 1 ! 520: write (i02,80001) ivtnum ! 521: go to 9261 ! 522: 29250 ivfail = ivfail + 1 ! 523: ivcorr = 28 ! 524: write (i02,80004) ivtnum, ivcomp, ivcorr ! 525: c ! 526: c test 926 through test 929 contain the intrinsic function fix ! 527: c which converts real arguments to integer function results ! 528: c ! 529: 9261 continue ! 530: ivtnum = 926 ! 531: c ! 532: c **** test 926 **** ! 533: c ! 534: if (iczero) 39260, 9260, 39260 ! 535: 9260 continue ! 536: ivcomp = ifix (-6.06) ! 537: go to 49260 ! 538: 39260 ivdele = ivdele + 1 ! 539: write (i02,80003) ivtnum ! 540: if (iczero) 49260, 9271, 49260 ! 541: 49260 if (ivcomp + 6) 29260,19260,29260 ! 542: 19260 ivpass = ivpass + 1 ! 543: write (i02,80001) ivtnum ! 544: go to 9271 ! 545: 29260 ivfail = ivfail + 1 ! 546: ivcorr = -6 ! 547: write (i02,80004) ivtnum, ivcomp, ivcorr ! 548: 9271 continue ! 549: ivtnum = 927 ! 550: c ! 551: c **** test 927 **** ! 552: c ! 553: if (iczero) 39270, 9270, 39270 ! 554: 9270 continue ! 555: rvon01 = 71.01 ! 556: ivcomp = ifix (rvon01) ! 557: go to 49270 ! 558: 39270 ivdele = ivdele + 1 ! 559: write (i02,80003) ivtnum ! 560: if (iczero) 49270, 9281, 49270 ! 561: 49270 if (ivcomp - 71) 29270,19270,29270 ! 562: 19270 ivpass = ivpass + 1 ! 563: write (i02,80001) ivtnum ! 564: go to 9281 ! 565: 29270 ivfail = ivfail + 1 ! 566: ivcorr = 71 ! 567: write (i02,80004) ivtnum, ivcomp, ivcorr ! 568: 9281 continue ! 569: ivtnum = 928 ! 570: c ! 571: c **** test 928 **** ! 572: c ! 573: if (iczero) 39280, 9280, 39280 ! 574: 9280 continue ! 575: rvon01 = 3.211e2 ! 576: ivcomp = ifix (rvon01) ! 577: go to 49280 ! 578: 39280 ivdele = ivdele + 1 ! 579: write (i02,80003) ivtnum ! 580: if (iczero) 49280, 9291, 49280 ! 581: 49280 if (ivcomp - 321) 29280,19280,29280 ! 582: 19280 ivpass = ivpass + 1 ! 583: write (i02,80001) ivtnum ! 584: go to 9291 ! 585: 29280 ivfail = ivfail + 1 ! 586: ivcorr = 321 ! 587: write (i02,80004) ivtnum, ivcomp, ivcorr ! 588: 9291 continue ! 589: ivtnum = 929 ! 590: c ! 591: c **** test 929 **** ! 592: c ! 593: if (iczero) 39290, 9290, 39290 ! 594: 9290 continue ! 595: rvon01 = 777e-1 ! 596: ivcomp = ifix (rvon01) ! 597: go to 49290 ! 598: 39290 ivdele = ivdele + 1 ! 599: write (i02,80003) ivtnum ! 600: if (iczero) 49290, 9301, 49290 ! 601: 49290 if (ivcomp - 77) 29290,19290,29290 ! 602: 19290 ivpass = ivpass + 1 ! 603: write (i02,80001) ivtnum ! 604: go to 9301 ! 605: 29290 ivfail = ivfail + 1 ! 606: ivcorr = 77 ! 607: write (i02,80004) ivtnum, ivcomp, ivcorr ! 608: c ! 609: c test 930 through test 932 contain intrinsic function tests for ! 610: c transfer of sign where arguments and function are integer ! 611: c ! 612: 9301 continue ! 613: ivtnum = 930 ! 614: c ! 615: c **** test 930 **** ! 616: c ! 617: if (iczero) 39300, 9300, 39300 ! 618: 9300 continue ! 619: ivon01 = 643 ! 620: ivcomp = isign (ivon01,-1) ! 621: go to 49300 ! 622: 39300 ivdele = ivdele + 1 ! 623: write (i02,80003) ivtnum ! 624: if (iczero) 49300, 9311, 49300 ! 625: 49300 if (ivcomp + 643) 29300,19300,29300 ! 626: 19300 ivpass = ivpass + 1 ! 627: write (i02,80001) ivtnum ! 628: go to 9311 ! 629: 29300 ivfail = ivfail + 1 ! 630: ivcorr = -643 ! 631: write (i02,80004) ivtnum, ivcomp, ivcorr ! 632: 9311 continue ! 633: ivtnum = 931 ! 634: c ! 635: c **** test 931 **** ! 636: c ! 637: if (iczero) 39310, 9310, 39310 ! 638: 9310 continue ! 639: ivon01 = -22 ! 640: ivon02 = 723 ! 641: ivcomp = isign (ivon01,ivon02) ! 642: go to 49310 ! 643: 39310 ivdele = ivdele + 1 ! 644: write (i02,80003) ivtnum ! 645: if (iczero) 49310, 9321, 49310 ! 646: 49310 if (ivcomp - 22) 29310,19310,29310 ! 647: 19310 ivpass = ivpass + 1 ! 648: write (i02,80001) ivtnum ! 649: go to 9321 ! 650: 29310 ivfail = ivfail + 1 ! 651: ivcorr = 22 ! 652: write (i02,80004) ivtnum, ivcomp, ivcorr ! 653: 9321 continue ! 654: ivtnum = 932 ! 655: c ! 656: c **** test 932 **** ! 657: c ! 658: if (iczero) 39320, 9320, 39320 ! 659: 9320 continue ! 660: ivon01 = 3532 ! 661: ivon02 = 1 ! 662: ivcomp = isign (ivon01,ivon02) ! 663: go to 49320 ! 664: 39320 ivdele = ivdele + 1 ! 665: write (i02,80003) ivtnum ! 666: if (iczero) 49320, 9331, 49320 ! 667: 49320 if (ivcomp - 3532) 29320,19320,29320 ! 668: 19320 ivpass = ivpass + 1 ! 669: write (i02,80001) ivtnum ! 670: go to 9331 ! 671: 29320 ivfail = ivfail + 1 ! 672: ivcorr = 3532 ! 673: write (i02,80004) ivtnum, ivcomp, ivcorr ! 674: c ! 675: c test 933 through test 936 contain intrinsic function tests for ! 676: c positive difference where arguments and function are integers ! 677: c ! 678: 9331 continue ! 679: ivtnum = 933 ! 680: c ! 681: c **** test 933 **** ! 682: c ! 683: if (iczero) 39330, 9330, 39330 ! 684: 9330 continue ! 685: ivon01 = 222 ! 686: ivcomp = idim (ivon01,1) ! 687: go to 49330 ! 688: 39330 ivdele = ivdele + 1 ! 689: write (i02,80003) ivtnum ! 690: if (iczero) 49330, 9341, 49330 ! 691: 49330 if (ivcomp - 221) 29330,19330,29330 ! 692: 19330 ivpass = ivpass + 1 ! 693: write (i02,80001) ivtnum ! 694: go to 9341 ! 695: 29330 ivfail = ivfail + 1 ! 696: ivcorr = 221 ! 697: write (i02,80004) ivtnum, ivcomp, ivcorr ! 698: 9341 continue ! 699: ivtnum = 934 ! 700: c ! 701: c **** test 934 **** ! 702: c ! 703: if (iczero) 39340, 9340, 39340 ! 704: 9340 continue ! 705: ivon01 = 45 ! 706: ivon02 = 41 ! 707: ivcomp = idim (ivon01,ivon02) ! 708: go to 49340 ! 709: 39340 ivdele = ivdele + 1 ! 710: write (i02,80003) ivtnum ! 711: if (iczero) 49340, 9351, 49340 ! 712: 49340 if (ivcomp - 4) 29340,19340,29340 ! 713: 19340 ivpass = ivpass + 1 ! 714: write (i02,80001) ivtnum ! 715: go to 9351 ! 716: 29340 ivfail = ivfail + 1 ! 717: ivcorr = 4 ! 718: write (i02,80004) ivtnum, ivcomp, ivcorr ! 719: 9351 continue ! 720: ivtnum = 935 ! 721: c ! 722: c **** test 935 **** ! 723: c ! 724: if (iczero) 39350, 9350, 39350 ! 725: 9350 continue ! 726: ivon01 = 2 ! 727: ivon02 = 10 ! 728: ivcomp = idim (ivon01,ivon02) ! 729: go to 49350 ! 730: 39350 ivdele = ivdele + 1 ! 731: write (i02,80003) ivtnum ! 732: if (iczero) 49350, 9361, 49350 ! 733: 49350 if (ivcomp) 29350,19350,29350 ! 734: 19350 ivpass = ivpass + 1 ! 735: write (i02,80001) ivtnum ! 736: go to 9361 ! 737: 29350 ivfail = ivfail + 1 ! 738: ivcorr = 0 ! 739: write (i02,80004) ivtnum, ivcomp, ivcorr ! 740: 9361 continue ! 741: ivtnum = 936 ! 742: c ! 743: c **** test 936 **** ! 744: c ! 745: if (iczero) 39360, 9360, 39360 ! 746: 9360 continue ! 747: ivon01 = 165 ! 748: ivon02 = -2 ! 749: ivcomp = idim (ivon01,ivon02) ! 750: go to 49360 ! 751: 39360 ivdele = ivdele + 1 ! 752: write (i02,80003) ivtnum ! 753: if (iczero) 49360, 9371, 49360 ! 754: 49360 if (ivcomp - 167) 29360,19360,29360 ! 755: 19360 ivpass = ivpass + 1 ! 756: write (i02,80001) ivtnum ! 757: go to 9371 ! 758: 29360 ivfail = ivfail + 1 ! 759: ivcorr = 167 ! 760: write (i02,80004) ivtnum, ivcomp, ivcorr ! 761: c ! 762: c tests 937 and 938 contain expressions containing more than one ! 763: c intrinsic function - the functions are integer and the arguments ! 764: c are real and integer ! 765: c ! 766: 9371 continue ! 767: ivtnum = 937 ! 768: c ! 769: c **** test 937 **** ! 770: c ! 771: if (iczero) 39370, 9370, 39370 ! 772: 9370 continue ! 773: rvon01 = 33.3 ! 774: ivon01 = -12 ! 775: ivcomp = int (rvon01) + iabs (ivon01) ! 776: go to 49370 ! 777: 39370 ivdele = ivdele + 1 ! 778: write (i02,80003) ivtnum ! 779: if (iczero) 49370, 9381, 49370 ! 780: 49370 if (ivcomp - 45) 29370,19370,29370 ! 781: 19370 ivpass = ivpass + 1 ! 782: write (i02,80001) ivtnum ! 783: go to 9381 ! 784: 29370 ivfail = ivfail + 1 ! 785: ivcorr = 45 ! 786: write (i02,80004) ivtnum, ivcomp, ivcorr ! 787: 9381 continue ! 788: ivtnum = 938 ! 789: c ! 790: c **** test 938 **** ! 791: c ! 792: if (iczero) 39380, 9380, 39380 ! 793: 9380 continue ! 794: ivon01 = 76 ! 795: ivon02 = 21 ! 796: ivon03 = 30 ! 797: ivcomp = max0 (ivon01,ivon02,ivon03) - min0 (ivon01,ivon02,ivon03) ! 798: go to 49380 ! 799: 39380 ivdele = ivdele + 1 ! 800: write (i02,80003) ivtnum ! 801: if (iczero) 49380, 9391, 49380 ! 802: 49380 if (ivcomp - 55) 29380,19380,29380 ! 803: 19380 ivpass = ivpass + 1 ! 804: write (i02,80001) ivtnum ! 805: go to 9391 ! 806: 29380 ivfail = ivfail + 1 ! 807: ivcorr = 55 ! 808: write (i02,80004) ivtnum, ivcomp, ivcorr ! 809: 9391 continue ! 810: c ! 811: c write page footings and run summaries ! 812: 99999 continue ! 813: write (i02,90002) ! 814: write (i02,90006) ! 815: write (i02,90002) ! 816: write (i02,90002) ! 817: write (i02,90007) ! 818: write (i02,90002) ! 819: write (i02,90008) ivfail ! 820: write (i02,90009) ivpass ! 821: write (i02,90010) ivdele ! 822: c ! 823: c ! 824: c terminate routine execution ! 825: stop ! 826: c ! 827: c format statements for page headers ! 828: 90000 format (1h1) ! 829: 90002 format (1h ) ! 830: 90001 format (1h ,10x,34hfortran compiler validation system) ! 831: 90003 format (1h ,21x,11hversion 1.0) ! 832: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 833: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 834: 90006 format (1h ,5x,46h----------------------------------------------) ! 835: 90011 format (1h ,18x,17hsubset level test) ! 836: c ! 837: c format statements for run summaries ! 838: 90008 format (1h ,15x,i5,19h errors encountered) ! 839: 90009 format (1h ,15x,i5,13h tests passed) ! 840: 90010 format (1h ,15x,i5,14h tests deleted) ! 841: c ! 842: c format statements for test results ! 843: 80001 format (1h ,4x,i5,7x,4hpass) ! 844: 80002 format (1h ,4x,i5,7x,4hfail) ! 845: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 846: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 847: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 848: c ! 849: 90007 format (1h ,20x,20hend of program fm098) ! 850: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.