![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM099.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 FM099.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C COMMENT SECTION 00010099 ! 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 00020099 ! 6: C FM099 00030099 ! 7: C 00040099 ! 8: C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE 00050099 ! 9: C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND 00060099 ! 10: C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE 00070099 ! 11: C FUNCTIONS TESTED IN FM099 INCLUDE 00080099 ! 12: C 00090099 ! 13: C TYPE OF 00100099 ! 14: C FUNCTION NAME ARGUMENT FUNCTION 00110099 ! 15: C ---------------- ---- -------- -------- 00120099 ! 16: C EXPONENTIAL EXP REAL REAL 00130099 ! 17: C NATURAL LOGARITHM ALOG REAL REAL 00140099 ! 18: C COMMON LOGARITHM ALOG10 REAL REAL 00150099 ! 19: C SQUARE ROOT SQRT REAL REAL 00160099 ! 20: C TRIGONOMETRIC SINE SIN REAL REAL 00170099 ! 21: C TRIGONOMETRIC COSINE COS REAL REAL 00180099 ! 22: C HYPERBOLIC TANGENT TANH REAL REAL 00190099 ! 23: C ARCTANGENT ATAN REAL REAL 00200099 ! 24: C ATAN2 REAL REAL 00210099 ! 25: C 00220099 ! 26: C REFERENCES 00230099 ! 27: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240099 ! 28: C X3.9-1978 00250099 ! 29: C 00260099 ! 30: C SECTION 8.7, EXTERNAL STATEMENT 00270099 ! 31: C SECTION 15.5.2, FUNCTION REFERENCE 00280099 ! 32: C 00290099 ! 33: C 00300099 ! 34: C ********************************************************** 00310099 ! 35: C 00320099 ! 36: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00330099 ! 37: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00340099 ! 38: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00350099 ! 39: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00360099 ! 40: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00370099 ! 41: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00380099 ! 42: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00390099 ! 43: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00400099 ! 44: C OF EXECUTING THESE TESTS. 00410099 ! 45: C 00420099 ! 46: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00430099 ! 47: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00440099 ! 48: C 00450099 ! 49: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00460099 ! 50: C 00470099 ! 51: C DEPARTMENT OF THE NAVY 00480099 ! 52: C FEDERAL COBOL COMPILER TESTING SERVICE 00490099 ! 53: C WASHINGTON, D.C. 20376 00500099 ! 54: C 00510099 ! 55: C ********************************************************** 00520099 ! 56: C 00530099 ! 57: C 00540099 ! 58: C 00550099 ! 59: C INITIALIZATION SECTION 00560099 ! 60: C 00570099 ! 61: C INITIALIZE CONSTANTS 00580099 ! 62: C ************** 00590099 ! 63: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00600099 ! 64: I01 = 5 00610099 ! 65: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00620099 ! 66: I02 = 6 00630099 ! 67: C SYSTEM ENVIRONMENT SECTION 00640099 ! 68: C 00650099 ! 69: I01 = 5 00660099 ! 70: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670099 ! 71: C (UNIT NUMBER FOR CARD READER). 00680099 ! 72: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00690099 ! 73: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700099 ! 74: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710099 ! 75: C 00720099 ! 76: I02 = 6 00730099 ! 77: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740099 ! 78: C (UNIT NUMBER FOR PRINTER). 00750099 ! 79: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00760099 ! 80: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770099 ! 81: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780099 ! 82: C 00790099 ! 83: IVPASS=0 00800099 ! 84: IVFAIL=0 00810099 ! 85: IVDELE=0 00820099 ! 86: ICZERO=0 00830099 ! 87: C 00840099 ! 88: C WRITE PAGE HEADERS 00850099 ! 89: WRITE (I02,90000) 00860099 ! 90: WRITE (I02,90001) 00870099 ! 91: WRITE (I02,90002) 00880099 ! 92: WRITE (I02, 90002) 00890099 ! 93: WRITE (I02,90003) 00900099 ! 94: WRITE (I02,90002) 00910099 ! 95: WRITE (I02,90004) 00920099 ! 96: WRITE (I02,90002) 00930099 ! 97: WRITE (I02,90011) 00940099 ! 98: WRITE (I02,90002) 00950099 ! 99: WRITE (I02,90002) 00960099 ! 100: WRITE (I02,90005) 00970099 ! 101: WRITE (I02,90006) 00980099 ! 102: WRITE (I02,90002) 00990099 ! 103: C 01000099 ! 104: C TEST SECTION 01010099 ! 105: C 01020099 ! 106: C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL 01030099 ! 107: C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01040099 ! 108: C 01050099 ! 109: IVTNUM = 939 01060099 ! 110: C 01070099 ! 111: C **** TEST 939 **** 01080099 ! 112: C 01090099 ! 113: IF (ICZERO) 39390, 9390, 39390 01100099 ! 114: 9390 CONTINUE 01110099 ! 115: RVON01 = 0.0 01120099 ! 116: RVCOMP = EXP (RVON01) 01130099 ! 117: GO TO 49390 01140099 ! 118: 39390 IVDELE = IVDELE + 1 01150099 ! 119: WRITE (I02,80003) IVTNUM 01160099 ! 120: IF (ICZERO) 49390, 9401, 49390 01170099 ! 121: 49390 IF (RVCOMP - 0.95) 29390,19390,49391 01180099 ! 122: 49391 IF (RVCOMP - 1.05) 19390,19390,29390 01190099 ! 123: 19390 IVPASS = IVPASS + 1 01200099 ! 124: WRITE (I02,80001) IVTNUM 01210099 ! 125: GO TO 9401 01220099 ! 126: 29390 IVFAIL = IVFAIL + 1 01230099 ! 127: RVCORR = 1.00 01240099 ! 128: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01250099 ! 129: 9401 CONTINUE 01260099 ! 130: IVTNUM = 940 01270099 ! 131: C 01280099 ! 132: C **** TEST 940 **** 01290099 ! 133: C 01300099 ! 134: IF (ICZERO) 39400, 9400, 39400 01310099 ! 135: 9400 CONTINUE 01320099 ! 136: RVCOMP = EXP (0.5) 01330099 ! 137: GO TO 49400 01340099 ! 138: 39400 IVDELE = IVDELE + 1 01350099 ! 139: WRITE (I02,80003) IVTNUM 01360099 ! 140: IF (ICZERO) 49400, 9411, 49400 01370099 ! 141: 49400 IF (RVCOMP - 1.60) 29400,19400,49401 01380099 ! 142: 49401 IF (RVCOMP - 1.70) 19400,19400,29400 01390099 ! 143: 19400 IVPASS = IVPASS + 1 01400099 ! 144: WRITE (I02,80001) IVTNUM 01410099 ! 145: GO TO 9411 01420099 ! 146: 29400 IVFAIL = IVFAIL + 1 01430099 ! 147: RVCORR = 1.65 01440099 ! 148: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01450099 ! 149: 9411 CONTINUE 01460099 ! 150: IVTNUM = 941 01470099 ! 151: C 01480099 ! 152: C **** TEST 941 **** 01490099 ! 153: C 01500099 ! 154: IF (ICZERO) 39410, 9410, 39410 01510099 ! 155: 9410 CONTINUE 01520099 ! 156: RVON01 = .1E1 01530099 ! 157: RVCOMP = EXP (RVON01) 01540099 ! 158: GO TO 49410 01550099 ! 159: 39410 IVDELE = IVDELE + 1 01560099 ! 160: WRITE (I02,80003) IVTNUM 01570099 ! 161: IF (ICZERO) 49410, 9421, 49410 01580099 ! 162: 49410 IF (RVCOMP - 2.67) 29410,19410,49411 01590099 ! 163: 49411 IF (RVCOMP - 2.77) 19410,19410,29410 01600099 ! 164: 19410 IVPASS = IVPASS + 1 01610099 ! 165: WRITE (I02,80001) IVTNUM 01620099 ! 166: GO TO 9421 01630099 ! 167: 29410 IVFAIL = IVFAIL + 1 01640099 ! 168: RVCORR = 2.72 01650099 ! 169: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01660099 ! 170: 9421 CONTINUE 01670099 ! 171: IVTNUM = 942 01680099 ! 172: C 01690099 ! 173: C **** TEST 942 **** 01700099 ! 174: C 01710099 ! 175: IF (ICZERO) 39420, 9420, 39420 01720099 ! 176: 9420 CONTINUE 01730099 ! 177: RVON01 = -1.0 01740099 ! 178: RVCOMP = EXP (RVON01) 01750099 ! 179: GO TO 49420 01760099 ! 180: 39420 IVDELE = IVDELE + 1 01770099 ! 181: WRITE (I02,80003) IVTNUM 01780099 ! 182: IF (ICZERO) 49420, 9431, 49420 01790099 ! 183: 49420 IF (RVCOMP - 0.363) 29420,19420,49421 01800099 ! 184: 49421 IF (RVCOMP - 0.373) 19420,19420,29420 01810099 ! 185: 19420 IVPASS = IVPASS + 1 01820099 ! 186: WRITE (I02,80001) IVTNUM 01830099 ! 187: GO TO 9431 01840099 ! 188: 29420 IVFAIL = IVFAIL + 1 01850099 ! 189: RVCORR = 0.368 01860099 ! 190: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01870099 ! 191: 9431 CONTINUE 01880099 ! 192: C 01890099 ! 193: C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL 01900099 ! 194: C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01910099 ! 195: C 01920099 ! 196: IVTNUM = 943 01930099 ! 197: C 01940099 ! 198: C **** TEST 943 **** 01950099 ! 199: C 01960099 ! 200: IF (ICZERO) 39430, 9430, 39430 01970099 ! 201: 9430 CONTINUE 01980099 ! 202: RVON01 = 5E1 01990099 ! 203: RVCOMP = ALOG (RVON01) 02000099 ! 204: GO TO 49430 02010099 ! 205: 39430 IVDELE = IVDELE + 1 02020099 ! 206: WRITE (I02,80003) IVTNUM 02030099 ! 207: IF (ICZERO) 49430, 9441, 49430 02040099 ! 208: 49430 IF (RVCOMP - 3.9115) 29430,19430,49431 02050099 ! 209: 49431 IF (RVCOMP - 3.9125) 19430,19430,29430 02060099 ! 210: 19430 IVPASS = IVPASS + 1 02070099 ! 211: WRITE (I02,80001) IVTNUM 02080099 ! 212: GO TO 9441 02090099 ! 213: 29430 IVFAIL = IVFAIL + 1 02100099 ! 214: RVCORR = 3.9120 02110099 ! 215: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02120099 ! 216: 9441 CONTINUE 02130099 ! 217: IVTNUM = 944 02140099 ! 218: C 02150099 ! 219: C **** TEST 944 **** 02160099 ! 220: C 02170099 ! 221: IF (ICZERO) 39440, 9440, 39440 02180099 ! 222: 9440 CONTINUE 02190099 ! 223: RVON01 = 1.0 02200099 ! 224: RVCOMP = ALOG (RVON01) 02210099 ! 225: GO TO 49440 02220099 ! 226: 39440 IVDELE = IVDELE + 1 02230099 ! 227: WRITE (I02,80003) IVTNUM 02240099 ! 228: IF (ICZERO) 49440, 9451, 49440 02250099 ! 229: 49440 IF (RVCOMP + .00005) 29440,19440,49441 02260099 ! 230: 49441 IF (RVCOMP - .00005) 19440,19440,29440 02270099 ! 231: 19440 IVPASS = IVPASS + 1 02280099 ! 232: WRITE (I02,80001) IVTNUM 02290099 ! 233: GO TO 9451 02300099 ! 234: 29440 IVFAIL = IVFAIL + 1 02310099 ! 235: RVCORR = 0.00000 02320099 ! 236: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02330099 ! 237: 9451 CONTINUE 02340099 ! 238: IVTNUM = 945 02350099 ! 239: C 02360099 ! 240: C **** TEST 945 **** 02370099 ! 241: C 02380099 ! 242: IF (ICZERO) 39450, 9450, 39450 02390099 ! 243: 9450 CONTINUE 02400099 ! 244: RVCOMP = ALOG (2.0) 02410099 ! 245: GO TO 49450 02420099 ! 246: 39450 IVDELE = IVDELE + 1 02430099 ! 247: WRITE (I02,80003) IVTNUM 02440099 ! 248: IF (ICZERO) 49450, 9461, 49450 02450099 ! 249: 49450 IF (RVCOMP - 0.688) 29450,19450,49451 02460099 ! 250: 49451 IF (RVCOMP - 0.698) 19450,19450,29450 02470099 ! 251: 19450 IVPASS = IVPASS + 1 02480099 ! 252: WRITE (I02,80001) IVTNUM 02490099 ! 253: GO TO 9461 02500099 ! 254: 29450 IVFAIL = IVFAIL + 1 02510099 ! 255: RVCORR = 0.693 02520099 ! 256: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530099 ! 257: 9461 CONTINUE 02540099 ! 258: C 02550099 ! 259: C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON 02560099 ! 260: C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 02570099 ! 261: C 02580099 ! 262: IVTNUM = 946 02590099 ! 263: C 02600099 ! 264: C **** TEST 946 **** 02610099 ! 265: C 02620099 ! 266: IF (ICZERO) 39460, 9460, 39460 02630099 ! 267: 9460 CONTINUE 02640099 ! 268: RVON01 = 2E2 02650099 ! 269: RVCOMP = ALOG10 (RVON01) 02660099 ! 270: GO TO 49460 02670099 ! 271: 39460 IVDELE = IVDELE + 1 02680099 ! 272: WRITE (I02,80003) IVTNUM 02690099 ! 273: IF (ICZERO) 49460, 9471, 49460 02700099 ! 274: 49460 IF (RVCOMP - 2.296) 29460,19460,49461 02710099 ! 275: 49461 IF (RVCOMP - 2.306) 19460,19460,29460 02720099 ! 276: 19460 IVPASS = IVPASS + 1 02730099 ! 277: WRITE (I02,80001) IVTNUM 02740099 ! 278: GO TO 9471 02750099 ! 279: 29460 IVFAIL = IVFAIL + 1 02760099 ! 280: RVCORR = 2.301 02770099 ! 281: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02780099 ! 282: 9471 CONTINUE 02790099 ! 283: IVTNUM = 947 02800099 ! 284: C 02810099 ! 285: C **** TEST 947 **** 02820099 ! 286: C 02830099 ! 287: IF (ICZERO) 39470, 9470, 39470 02840099 ! 288: 9470 CONTINUE 02850099 ! 289: RVON01 = .3E+3 02860099 ! 290: RVCOMP = ALOG10 (RVON01) 02870099 ! 291: GO TO 49470 02880099 ! 292: 39470 IVDELE = IVDELE + 1 02890099 ! 293: WRITE (I02,80003) IVTNUM 02900099 ! 294: IF (ICZERO) 49470, 9481, 49470 02910099 ! 295: 49470 IF (RVCOMP - 2.472) 29470,19470,49471 02920099 ! 296: 49471 IF (RVCOMP - 2.482) 19470,19470,29470 02930099 ! 297: 19470 IVPASS = IVPASS + 1 02940099 ! 298: WRITE (I02,80001) IVTNUM 02950099 ! 299: GO TO 9481 02960099 ! 300: 29470 IVFAIL = IVFAIL + 1 02970099 ! 301: RVCORR = 2.477 02980099 ! 302: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02990099 ! 303: 9481 CONTINUE 03000099 ! 304: IVTNUM = 948 03010099 ! 305: C 03020099 ! 306: C **** TEST 948 **** 03030099 ! 307: C 03040099 ! 308: IF (ICZERO) 39480, 9480, 39480 03050099 ! 309: 9480 CONTINUE 03060099 ! 310: RVON01 = 1350.0 03070099 ! 311: RVCOMP = ALOG10 (RVON01) 03080099 ! 312: GO TO 49480 03090099 ! 313: 39480 IVDELE = IVDELE + 1 03100099 ! 314: WRITE (I02,80003) IVTNUM 03110099 ! 315: IF (ICZERO) 49480, 9491, 49480 03120099 ! 316: 49480 IF (RVCOMP - 3.125) 29480,19480,49481 03130099 ! 317: 49481 IF (RVCOMP - 3.135) 19480,19480,29480 03140099 ! 318: 19480 IVPASS = IVPASS + 1 03150099 ! 319: WRITE (I02,80001) IVTNUM 03160099 ! 320: GO TO 9491 03170099 ! 321: 29480 IVFAIL = IVFAIL + 1 03180099 ! 322: RVCORR = 3.130 03190099 ! 323: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03200099 ! 324: 9491 CONTINUE 03210099 ! 325: C 03220099 ! 326: C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT 03230099 ! 327: C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03240099 ! 328: C 03250099 ! 329: IVTNUM = 949 03260099 ! 330: C 03270099 ! 331: C **** TEST 949 **** 03280099 ! 332: C 03290099 ! 333: IF (ICZERO) 39490, 9490, 39490 03300099 ! 334: 9490 CONTINUE 03310099 ! 335: RVON01 = 1.0 03320099 ! 336: RVCOMP = SQRT (RVON01) 03330099 ! 337: GO TO 49490 03340099 ! 338: 39490 IVDELE = IVDELE + 1 03350099 ! 339: WRITE (I02,80003) IVTNUM 03360099 ! 340: IF (ICZERO) 49490, 9501, 49490 03370099 ! 341: 49490 IF (RVCOMP - 0.95) 29490,19490,49491 03380099 ! 342: 49491 IF (RVCOMP - 1.05) 19490,19490,29490 03390099 ! 343: 19490 IVPASS = IVPASS + 1 03400099 ! 344: WRITE (I02,80001) IVTNUM 03410099 ! 345: GO TO 9501 03420099 ! 346: 29490 IVFAIL = IVFAIL + 1 03430099 ! 347: RVCORR = 1.00 03440099 ! 348: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03450099 ! 349: 9501 CONTINUE 03460099 ! 350: IVTNUM = 950 03470099 ! 351: C 03480099 ! 352: C **** TEST 950 **** 03490099 ! 353: C 03500099 ! 354: IF (ICZERO) 39500, 9500, 39500 03510099 ! 355: 9500 CONTINUE 03520099 ! 356: RVCOMP = SQRT (2.0) 03530099 ! 357: GO TO 49500 03540099 ! 358: 39500 IVDELE = IVDELE + 1 03550099 ! 359: WRITE (I02,80003) IVTNUM 03560099 ! 360: IF (ICZERO) 49500, 9511, 49500 03570099 ! 361: 49500 IF (RVCOMP - 1.36) 29500,19500,49501 03580099 ! 362: 49501 IF (RVCOMP - 1.46) 19500,19500,29500 03590099 ! 363: 19500 IVPASS = IVPASS + 1 03600099 ! 364: WRITE (I02,80001) IVTNUM 03610099 ! 365: GO TO 9511 03620099 ! 366: 29500 IVFAIL = IVFAIL + 1 03630099 ! 367: RVCORR = 1.41 03640099 ! 368: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03650099 ! 369: 9511 CONTINUE 03660099 ! 370: IVTNUM = 951 03670099 ! 371: C 03680099 ! 372: C **** TEST 951 **** 03690099 ! 373: C 03700099 ! 374: IF (ICZERO) 39510, 9510, 39510 03710099 ! 375: 9510 CONTINUE 03720099 ! 376: RVON01 = .229E1 03730099 ! 377: RVCOMP = SQRT (RVON01) 03740099 ! 378: GO TO 49510 03750099 ! 379: 39510 IVDELE = IVDELE + 1 03760099 ! 380: WRITE (I02,80003) IVTNUM 03770099 ! 381: IF (ICZERO) 49510, 9521, 49510 03780099 ! 382: 49510 IF (RVCOMP - 1.46) 29510,19510,49511 03790099 ! 383: 49511 IF (RVCOMP - 1.56) 19510,19510,29510 03800099 ! 384: 19510 IVPASS = IVPASS + 1 03810099 ! 385: WRITE (I02,80001) IVTNUM 03820099 ! 386: GO TO 9521 03830099 ! 387: 29510 IVFAIL = IVFAIL + 1 03840099 ! 388: RVCORR = 1.51 03850099 ! 389: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03860099 ! 390: 9521 CONTINUE 03870099 ! 391: C 03880099 ! 392: C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC03890099 ! 393: C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03900099 ! 394: C 03910099 ! 395: IVTNUM = 952 03920099 ! 396: C 03930099 ! 397: C **** TEST 952 **** 03940099 ! 398: C 03950099 ! 399: IF (ICZERO) 39520, 9520, 39520 03960099 ! 400: 9520 CONTINUE 03970099 ! 401: RVON01 = 0.00000 03980099 ! 402: RVCOMP = SIN (RVON01) 03990099 ! 403: GO TO 49520 04000099 ! 404: 39520 IVDELE = IVDELE + 1 04010099 ! 405: WRITE (I02,80003) IVTNUM 04020099 ! 406: IF (ICZERO) 49520, 9531, 49520 04030099 ! 407: 49520 IF (RVCOMP + .00005) 29520,19520,49521 04040099 ! 408: 49521 IF (RVCOMP - .00005) 19520,19520,29520 04050099 ! 409: 19520 IVPASS = IVPASS + 1 04060099 ! 410: WRITE (I02,80001) IVTNUM 04070099 ! 411: GO TO 9531 04080099 ! 412: 29520 IVFAIL = IVFAIL + 1 04090099 ! 413: RVCORR = 0.00000 04100099 ! 414: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110099 ! 415: 9531 CONTINUE 04120099 ! 416: IVTNUM = 953 04130099 ! 417: C 04140099 ! 418: C **** TEST 953 **** 04150099 ! 419: C 04160099 ! 420: IF (ICZERO) 39530, 9530, 39530 04170099 ! 421: 9530 CONTINUE 04180099 ! 422: RVON01 = 0.5 04190099 ! 423: RVCOMP = SIN (RVON01) 04200099 ! 424: GO TO 49530 04210099 ! 425: 39530 IVDELE = IVDELE + 1 04220099 ! 426: WRITE (I02,80003) IVTNUM 04230099 ! 427: IF (ICZERO) 49530, 9541, 49530 04240099 ! 428: 49530 IF (RVCOMP - .474) 29530,19530,49531 04250099 ! 429: 49531 IF (RVCOMP - .484) 19530,19530,29530 04260099 ! 430: 19530 IVPASS = IVPASS + 1 04270099 ! 431: WRITE (I02,80001) IVTNUM 04280099 ! 432: GO TO 9541 04290099 ! 433: 29530 IVFAIL = IVFAIL + 1 04300099 ! 434: RVCORR = .479 04310099 ! 435: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04320099 ! 436: 9541 CONTINUE 04330099 ! 437: IVTNUM = 954 04340099 ! 438: C 04350099 ! 439: C **** TEST 954 **** 04360099 ! 440: C 04370099 ! 441: IF (ICZERO) 39540, 9540, 39540 04380099 ! 442: 9540 CONTINUE 04390099 ! 443: RVON01 = 4E0 04400099 ! 444: RVCOMP = SIN (RVON01) 04410099 ! 445: GO TO 49540 04420099 ! 446: 39540 IVDELE = IVDELE + 1 04430099 ! 447: WRITE (I02,80003) IVTNUM 04440099 ! 448: IF (ICZERO) 49540, 9551, 49540 04450099 ! 449: 49540 IF (RVCOMP + .762) 29540,19540,49541 04460099 ! 450: 49541 IF (RVCOMP + .752) 19540,19540,29540 04470099 ! 451: 19540 IVPASS = IVPASS + 1 04480099 ! 452: WRITE (I02,80001) IVTNUM 04490099 ! 453: GO TO 9551 04500099 ! 454: 29540 IVFAIL = IVFAIL + 1 04510099 ! 455: RVCORR = -.757 04520099 ! 456: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04530099 ! 457: 9551 CONTINUE 04540099 ! 458: C 04550099 ! 459: C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC04560099 ! 460: C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 04570099 ! 461: C 04580099 ! 462: IVTNUM = 955 04590099 ! 463: C 04600099 ! 464: C **** TEST 955 **** 04610099 ! 465: C 04620099 ! 466: IF (ICZERO) 39550, 9550, 39550 04630099 ! 467: 9550 CONTINUE 04640099 ! 468: RVON01 = 0.00000 04650099 ! 469: RVCOMP = COS (RVON01) 04660099 ! 470: GO TO 49550 04670099 ! 471: 39550 IVDELE = IVDELE + 1 04680099 ! 472: WRITE (I02,80003) IVTNUM 04690099 ! 473: IF (ICZERO) 49550, 9561, 49550 04700099 ! 474: 49550 IF (RVCOMP - .995) 29550,19550,49551 04710099 ! 475: 49551 IF (RVCOMP - 1.005) 19550,19550,29550 04720099 ! 476: 19550 IVPASS = IVPASS + 1 04730099 ! 477: WRITE (I02,80001) IVTNUM 04740099 ! 478: GO TO 9561 04750099 ! 479: 29550 IVFAIL = IVFAIL + 1 04760099 ! 480: RVCORR = 1.000 04770099 ! 481: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04780099 ! 482: 9561 CONTINUE 04790099 ! 483: IVTNUM = 956 04800099 ! 484: C 04810099 ! 485: C **** TEST 956 **** 04820099 ! 486: C 04830099 ! 487: IF (ICZERO) 39560, 9560, 39560 04840099 ! 488: 9560 CONTINUE 04850099 ! 489: RVON01 = 1.0E0 04860099 ! 490: RVCOMP = COS (RVON01) 04870099 ! 491: GO TO 49560 04880099 ! 492: 39560 IVDELE = IVDELE + 1 04890099 ! 493: WRITE (I02,80003) IVTNUM 04900099 ! 494: IF (ICZERO) 49560, 9571, 49560 04910099 ! 495: 49560 IF (RVCOMP - .535) 29560,19560,49561 04920099 ! 496: 49561 IF (RVCOMP - .545) 19560,19560,29560 04930099 ! 497: 19560 IVPASS = IVPASS + 1 04940099 ! 498: WRITE (I02,80001) IVTNUM 04950099 ! 499: GO TO 9571 04960099 ! 500: 29560 IVFAIL = IVFAIL + 1 04970099 ! 501: RVCORR = 0.540 04980099 ! 502: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04990099 ! 503: 9571 CONTINUE 05000099 ! 504: IVTNUM = 957 05010099 ! 505: C 05020099 ! 506: C **** TEST 957 **** 05030099 ! 507: C 05040099 ! 508: IF (ICZERO) 39570, 9570, 39570 05050099 ! 509: 9570 CONTINUE 05060099 ! 510: RVCOMP = COS (4.0) 05070099 ! 511: GO TO 49570 05080099 ! 512: 39570 IVDELE = IVDELE + 1 05090099 ! 513: WRITE (I02,80003) IVTNUM 05100099 ! 514: IF (ICZERO) 49570, 9581, 49570 05110099 ! 515: 49570 IF (RVCOMP + .659) 29570,19570,49571 05120099 ! 516: 49571 IF (RVCOMP + .649) 19570,19570,29570 05130099 ! 517: 19570 IVPASS = IVPASS + 1 05140099 ! 518: WRITE (I02,80001) IVTNUM 05150099 ! 519: GO TO 9581 05160099 ! 520: 29570 IVFAIL = IVFAIL + 1 05170099 ! 521: RVCORR = -0.654 05180099 ! 522: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05190099 ! 523: 9581 CONTINUE 05200099 ! 524: C 05210099 ! 525: C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC 05220099 ! 526: C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 05230099 ! 527: C 05240099 ! 528: IVTNUM = 958 05250099 ! 529: C 05260099 ! 530: C **** TEST 958 **** 05270099 ! 531: C 05280099 ! 532: IF (ICZERO) 39580, 9580, 39580 05290099 ! 533: 9580 CONTINUE 05300099 ! 534: RVCOMP = TANH (0.0) 05310099 ! 535: GO TO 49580 05320099 ! 536: 39580 IVDELE = IVDELE + 1 05330099 ! 537: WRITE (I02,80003) IVTNUM 05340099 ! 538: IF (ICZERO) 49580, 9591, 49580 05350099 ! 539: 49580 IF (RVCOMP + .00005) 29580,19580,49581 05360099 ! 540: 49581 IF (RVCOMP - .00005) 19580,19580,29580 05370099 ! 541: 19580 IVPASS = IVPASS + 1 05380099 ! 542: WRITE (I02,80001) IVTNUM 05390099 ! 543: GO TO 9591 05400099 ! 544: 29580 IVFAIL = IVFAIL + 1 05410099 ! 545: RVCORR = 0.00000 05420099 ! 546: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05430099 ! 547: 9591 CONTINUE 05440099 ! 548: IVTNUM = 959 05450099 ! 549: C 05460099 ! 550: C **** TEST 959 **** 05470099 ! 551: C 05480099 ! 552: IF (ICZERO) 39590, 9590, 39590 05490099 ! 553: 9590 CONTINUE 05500099 ! 554: RVON01 = .5E0 05510099 ! 555: RVCOMP = TANH (RVON01) 05520099 ! 556: GO TO 49590 05530099 ! 557: 39590 IVDELE = IVDELE + 1 05540099 ! 558: WRITE (I02,80003) IVTNUM 05550099 ! 559: IF (ICZERO) 49590, 9601, 49590 05560099 ! 560: 49590 IF (RVCOMP - .457) 29590,19590,49591 05570099 ! 561: 49591 IF (RVCOMP - .467) 19590,19590,29590 05580099 ! 562: 19590 IVPASS = IVPASS + 1 05590099 ! 563: WRITE (I02,80001) IVTNUM 05600099 ! 564: GO TO 9601 05610099 ! 565: 29590 IVFAIL = IVFAIL + 1 05620099 ! 566: RVCORR = 0.462 05630099 ! 567: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05640099 ! 568: 9601 CONTINUE 05650099 ! 569: IVTNUM = 960 05660099 ! 570: C 05670099 ! 571: C **** TEST 960 **** 05680099 ! 572: C 05690099 ! 573: IF (ICZERO) 39600, 9600, 39600 05700099 ! 574: 9600 CONTINUE 05710099 ! 575: RVON01 = .25 05720099 ! 576: RVCOMP = TANH (RVON01) 05730099 ! 577: GO TO 49600 05740099 ! 578: 39600 IVDELE = IVDELE + 1 05750099 ! 579: WRITE (I02,80003) IVTNUM 05760099 ! 580: IF (ICZERO) 49600, 9611, 49600 05770099 ! 581: 49600 IF (RVCOMP - .240) 29600,19600,49601 05780099 ! 582: 49601 IF (RVCOMP - .250) 19600,19600,29600 05790099 ! 583: 19600 IVPASS = IVPASS + 1 05800099 ! 584: WRITE (I02,80001) IVTNUM 05810099 ! 585: GO TO 9611 05820099 ! 586: 29600 IVFAIL = IVFAIL + 1 05830099 ! 587: RVCORR = 0.245 05840099 ! 588: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05850099 ! 589: 9611 CONTINUE 05860099 ! 590: C 05870099 ! 591: C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 05880099 ! 592: C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL 05890099 ! 593: C 05900099 ! 594: IVTNUM = 961 05910099 ! 595: C 05920099 ! 596: C **** TEST 961 **** 05930099 ! 597: C 05940099 ! 598: IF (ICZERO) 39610, 9610, 39610 05950099 ! 599: 9610 CONTINUE 05960099 ! 600: RVCOMP = ATAN (0.0) 05970099 ! 601: GO TO 49610 05980099 ! 602: 39610 IVDELE = IVDELE + 1 05990099 ! 603: WRITE (I02,80003) IVTNUM 06000099 ! 604: IF (ICZERO) 49610, 9621, 49610 06010099 ! 605: 49610 IF (RVCOMP + .00005) 29610,19610,49611 06020099 ! 606: 49611 IF (RVCOMP - .00005) 19610,19610,29610 06030099 ! 607: 19610 IVPASS = IVPASS + 1 06040099 ! 608: WRITE (I02,80001) IVTNUM 06050099 ! 609: GO TO 9621 06060099 ! 610: 29610 IVFAIL = IVFAIL + 1 06070099 ! 611: RVCORR = 0.00000 06080099 ! 612: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06090099 ! 613: 9621 CONTINUE 06100099 ! 614: IVTNUM = 962 06110099 ! 615: C 06120099 ! 616: C **** TEST 962 **** 06130099 ! 617: C 06140099 ! 618: IF (ICZERO) 39620, 9620, 39620 06150099 ! 619: 9620 CONTINUE 06160099 ! 620: RVON01 = 5E-1 06170099 ! 621: RVCOMP = ATAN (RVON01) 06180099 ! 622: GO TO 49620 06190099 ! 623: 39620 IVDELE = IVDELE + 1 06200099 ! 624: WRITE (I02,80003) IVTNUM 06210099 ! 625: IF (ICZERO) 49620, 9631, 49620 06220099 ! 626: 49620 IF (RVCOMP - .459) 29620,19620,49621 06230099 ! 627: 49621 IF (RVCOMP - .469) 19620,19620,29620 06240099 ! 628: 19620 IVPASS = IVPASS + 1 06250099 ! 629: WRITE (I02,80001) IVTNUM 06260099 ! 630: GO TO 9631 06270099 ! 631: 29620 IVFAIL = IVFAIL + 1 06280099 ! 632: RVCORR = 0.464 06290099 ! 633: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06300099 ! 634: 9631 CONTINUE 06310099 ! 635: C 06320099 ! 636: C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 06330099 ! 637: C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL 06340099 ! 638: C 06350099 ! 639: IVTNUM = 963 06360099 ! 640: C 06370099 ! 641: C **** TEST 963 **** 06380099 ! 642: C 06390099 ! 643: IF (ICZERO) 39630, 9630, 39630 06400099 ! 644: 9630 CONTINUE 06410099 ! 645: RVON01 = 0.0 06420099 ! 646: RVON02 = 1E0 06430099 ! 647: RVCOMP = ATAN2 (RVON01,RVON02) 06440099 ! 648: GO TO 49630 06450099 ! 649: 39630 IVDELE = IVDELE + 1 06460099 ! 650: WRITE (I02,80003) IVTNUM 06470099 ! 651: IF (ICZERO) 49630, 9641, 49630 06480099 ! 652: 49630 IF (RVCOMP + .00005) 29630,19630,49631 06490099 ! 653: 49631 IF (RVCOMP - .00005) 19630,19630,29630 06500099 ! 654: 19630 IVPASS = IVPASS + 1 06510099 ! 655: WRITE (I02,80001) IVTNUM 06520099 ! 656: GO TO 9641 06530099 ! 657: 29630 IVFAIL = IVFAIL + 1 06540099 ! 658: RVCORR = 0.00000 06550099 ! 659: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06560099 ! 660: 9641 CONTINUE 06570099 ! 661: IVTNUM = 964 06580099 ! 662: C 06590099 ! 663: C **** TEST 964 **** 06600099 ! 664: C 06610099 ! 665: IF (ICZERO) 39640, 9640, 39640 06620099 ! 666: 9640 CONTINUE 06630099 ! 667: RVON01 = 2E1 06640099 ! 668: RVCOMP = ATAN2 (-1.0,RVON01) 06650099 ! 669: GO TO 49640 06660099 ! 670: 39640 IVDELE = IVDELE + 1 06670099 ! 671: WRITE (I02,80003) IVTNUM 06680099 ! 672: IF (ICZERO) 49640, 9651, 49640 06690099 ! 673: 49640 IF (RVCOMP + .05001) 29640,19640,49641 06700099 ! 674: 49641 IF (RVCOMP + .04991) 19640,19640,29640 06710099 ! 675: 19640 IVPASS = IVPASS + 1 06720099 ! 676: WRITE (I02,80001) IVTNUM 06730099 ! 677: GO TO 9651 06740099 ! 678: 29640 IVFAIL = IVFAIL + 1 06750099 ! 679: RVCORR = -.04996 06760099 ! 680: WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06770099 ! 681: 9651 CONTINUE 06780099 ! 682: C 06790099 ! 683: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06800099 ! 684: 99999 CONTINUE 06810099 ! 685: WRITE (I02,90002) 06820099 ! 686: WRITE (I02,90006) 06830099 ! 687: WRITE (I02,90002) 06840099 ! 688: WRITE (I02,90002) 06850099 ! 689: WRITE (I02,90007) 06860099 ! 690: WRITE (I02,90002) 06870099 ! 691: WRITE (I02,90008) IVFAIL 06880099 ! 692: WRITE (I02,90009) IVPASS 06890099 ! 693: WRITE (I02,90010) IVDELE 06900099 ! 694: C 06910099 ! 695: C 06920099 ! 696: C TERMINATE ROUTINE EXECUTION 06930099 ! 697: STOP 06940099 ! 698: C 06950099 ! 699: C FORMAT STATEMENTS FOR PAGE HEADERS 06960099 ! 700: 90000 FORMAT (1H1) 06970099 ! 701: 90002 FORMAT (1H ) 06980099 ! 702: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06990099 ! 703: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 07000099 ! 704: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07010099 ! 705: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 07020099 ! 706: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 07030099 ! 707: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07040099 ! 708: C 07050099 ! 709: C FORMAT STATEMENTS FOR RUN SUMMARIES 07060099 ! 710: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 07070099 ! 711: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 07080099 ! 712: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 07090099 ! 713: C 07100099 ! 714: C FORMAT STATEMENTS FOR TEST RESULTS 07110099 ! 715: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 07120099 ! 716: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 07130099 ! 717: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 07140099 ! 718: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07150099 ! 719: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07160099 ! 720: C 07170099 ! 721: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM099) 07180099 ! 722: END 07190099
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.