![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM308.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 FM308.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 FM308 00010308 ! 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 00020308 ! 6: C 00030308 ! 7: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE ACTUAL 00040308 ! 8: C ARGUMENTS CONSIST OF INTRINSIC FUNCTION REFERENCES, EXTERNAL 00050308 ! 9: C FUNCTION REFERENCES, STATEMENT FUNCTION REFERENCES, AND 00060308 ! 10: C EXPRESSIONS INVOLVING OPERATORS. THE ARGUMENT AND FUNCTION 00070308 ! 11: C TYPES OF ALL INTRINSIC FUNCTIONS TESTED ARE EITHER INTEGER OR 00080308 ! 12: C REAL. THE INTRINSIC AND EXTERNAL SPECIFICATION STATEMENTS ARE 00090308 ! 13: C SPECIFIED IN ORDER TO ALLOW INTRINSIC AND EXTERNAL FUNCTIONS TO 00100308 ! 14: C BE USED AS ACTUAL ARGUMENTS. THE IMPLICIT STATEMENT AND THE 00110308 ! 15: C TYPE-STATEMENT ARE TESTED TO ENSURE THAT THEY DO NOT CHANGE THE 00120308 ! 16: C TYPE OF AN INTRINSIC FUNCTION. THE COMMON STATEMENT IS USED TO 00130308 ! 17: C PASS DATA ENTITIES TO AN EXTERNAL FUNCTION. THE DATA STATEMENT 00140308 ! 18: C IS USED TO ENSURE THAT INITIALLY DEFINED ENTITIES CAN BE USED AS 00150308 ! 19: C ACTUAL ARGUMENTS. THE EQUIVALENCE STATEMENT IS USED TO EQUATE A 00160308 ! 20: C VARIABLE USED AS AN ACTUAL ARGUMENT. THE INTRINSIC FUNCTIONS 00170308 ! 21: C TESTED IN THIS ROUTINE INCLUDE. 00180308 ! 22: C 00190308 ! 23: C SPECIFIC TYPE OF 00200308 ! 24: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00210308 ! 25: C ------------------ -------- -------- --------00220308 ! 26: C TYPE CONVERSION INT REAL INTEGER 00230308 ! 27: C TYPE CONVERSION IFIX REAL INTEGER 00240308 ! 28: C TYPE CONVERSION FLOAT INTEGER REAL 00250308 ! 29: C TYPE CONVERSION REAL INTEGER REAL 00260308 ! 30: C TRUNCATION AINT REAL REAL 00270308 ! 31: C NEAREST WHOLE NUMBER ANINT REAL REAL 00280308 ! 32: C NEAREST INTEGER NINT REAL INTEGER 00290308 ! 33: C ABSOLUTE VALUE IABS INTEGER INTEGER 00300308 ! 34: C ABSOLUTE VALUE ABS REAL REAL 00310308 ! 35: C REMAINDERING MOD INTEGER INTEGER 00320308 ! 36: C REMAINDERING AMOD REAL REAL 00330308 ! 37: C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00340308 ! 38: C TRANSFER OF SIGN SIGN REAL REAL 00350308 ! 39: C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00360308 ! 40: C POSITIVE DIFFERENCE DIM REAL REAL 00370308 ! 41: C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00380308 ! 42: C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00390308 ! 43: C CHOOSING LARGEST VALUE MAX1 REAL INTEGER 00400308 ! 44: C CHOOSING SMALLEST VALUE AMIN1 REAL REAL 00410308 ! 45: C CHOOSING SMALLEST VALUE MIN1 REAL INTEGER 00420308 ! 46: C SQUARE ROOT SQRT REAL REAL 00430308 ! 47: C EXPONENTIAL EXP REAL REAL 00440308 ! 48: C NATURAL LOGARITHM ALOG REAL REAL 00450308 ! 49: C SINE SIN REAL REAL 00460308 ! 50: C COSINE COS REAL REAL 00470308 ! 51: C TANGENT TAN REAL REAL 00480308 ! 52: C ARCSINE ASIN REAL REAL 00490308 ! 53: C ARCCOSINE ACOS REAL REAL 00500308 ! 54: C ARCTANGENT ATAN REAL REAL 00510308 ! 55: C HYPERBOLIC SINE SINH REAL REAL 00520308 ! 56: C HYPERBOLIC COSINE COSH REAL REAL 00530308 ! 57: C HYPERBOLIC TANGENT TANH REAL REAL 00540308 ! 58: C 00550308 ! 59: C SUBSET LEVEL ROUTINES FM097, FM098, FM099 AND FM307 TEST THE 00560308 ! 60: C USE OF INTEGER AND REAL INTRINSIC FUNCTIONS USING INTEGER AND REAL00570308 ! 61: C CONSTANTS, VARIABLES AND ARRAY ELEMENT ENTITIES AS ACTUAL 00580308 ! 62: C ARGUMENTS. 00590308 ! 63: C 00600308 ! 64: C REFERENCES. 00610308 ! 65: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00620308 ! 66: C X3.9-1978 00630308 ! 67: C 00640308 ! 68: C SECTION 8.2, EQUIVALENCE STATEMENT 00650308 ! 69: C SECTION 8.3, COMMON STATEMENT 00660308 ! 70: C SECTION 8.4, TYPE-STATEMENTS 00670308 ! 71: C SECTION 8.5, IMPLICIT STATEMENT 00680308 ! 72: C SECTION 8.7, EXTERNAL STATEMENT 00690308 ! 73: C SECTION 8.8, INTRINSIC STATEMENT 00700308 ! 74: C SECTION 9, DATA STATEMENT 00710308 ! 75: C SECTION 15.3, INTRINSIC FUNCTION 00720308 ! 76: C SECTION 15.4, STATEMENT FUNCTION 00730308 ! 77: C SECTION 15.5, EXTERNAL FUNCTION 00740308 ! 78: C SECTION 15.5.2, .REFERENCING AN EXTERNAL FUNCTION 00750308 ! 79: C SECTION 15.9.2, ACTUAL ARGUMENTS 00760308 ! 80: C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00770308 ! 81: C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00780308 ! 82: C SECTION 15.10.1, RESTRICTIONS ON RANGE OF ARGUMENTS AND RESULTS00790308 ! 83: C 00800308 ! 84: C 00810308 ! 85: C ******************************************************************00820308 ! 86: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00830308 ! 87: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00840308 ! 88: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00850308 ! 89: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00860308 ! 90: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00870308 ! 91: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00880308 ! 92: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00890308 ! 93: C THE RESULT OF EXECUTING THESE TESTS. 00900308 ! 94: C 00910308 ! 95: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00920308 ! 96: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00930308 ! 97: C 00940308 ! 98: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00950308 ! 99: C DEPARTMENT OF THE NAVY 00960308 ! 100: C FEDERAL COBOL COMPILER TESTING SERVICE 00970308 ! 101: C WASHINGTON, D.C. 20376 00980308 ! 102: C 00990308 ! 103: C ******************************************************************01000308 ! 104: C 01010308 ! 105: C 01020308 ! 106: IMPLICIT LOGICAL (L) 01030308 ! 107: IMPLICIT CHARACTER*14 (C) 01040308 ! 108: C 01050308 ! 109: IMPLICIT INTEGER (E) 01060308 ! 110: IMPLICIT REAL (N) 01070308 ! 111: INTEGER MAX1 01080308 ! 112: REAL SINH 01090308 ! 113: DIMENSION RADN11(5) 01100308 ! 114: DIMENSION IADN11(5) 01110308 ! 115: COMMON RVCN01 01120308 ! 116: EQUIVALENCE (IVOE01,IVOE02) 01130308 ! 117: EXTERNAL FF309,FF310 01140308 ! 118: INTRINSIC ABS, AINT, IABS, ISIGN, SQRT 01150308 ! 119: DATA RVON04/2.23/ 01160308 ! 120: RFOS01(RDON01) = RDON01 + 1.0 01170308 ! 121: C 01180308 ! 122: C 01190308 ! 123: C 01200308 ! 124: C INITIALIZATION SECTION. 01210308 ! 125: C 01220308 ! 126: C INITIALIZE CONSTANTS 01230308 ! 127: C ******************** 01240308 ! 128: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01250308 ! 129: I01 = 5 01260308 ! 130: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01270308 ! 131: I02 = 6 01280308 ! 132: C SYSTEM ENVIRONMENT SECTION 01290308 ! 133: C 01300308 ! 134: I01 = 5 01310308 ! 135: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01320308 ! 136: C (UNIT NUMBER FOR CARD READER). 01330308 ! 137: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01340308 ! 138: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350308 ! 139: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01360308 ! 140: C 01370308 ! 141: I02 = 6 01380308 ! 142: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01390308 ! 143: C (UNIT NUMBER FOR PRINTER). 01400308 ! 144: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01410308 ! 145: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01420308 ! 146: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01430308 ! 147: C 01440308 ! 148: IVPASS = 0 01450308 ! 149: IVFAIL = 0 01460308 ! 150: IVDELE = 0 01470308 ! 151: ICZERO = 0 01480308 ! 152: C 01490308 ! 153: C WRITE OUT PAGE HEADERS 01500308 ! 154: C 01510308 ! 155: WRITE (I02,90002) 01520308 ! 156: WRITE (I02,90006) 01530308 ! 157: WRITE (I02,90008) 01540308 ! 158: WRITE (I02,90004) 01550308 ! 159: WRITE (I02,90010) 01560308 ! 160: WRITE (I02,90004) 01570308 ! 161: WRITE (I02,90016) 01580308 ! 162: WRITE (I02,90001) 01590308 ! 163: WRITE (I02,90004) 01600308 ! 164: WRITE (I02,90012) 01610308 ! 165: WRITE (I02,90014) 01620308 ! 166: WRITE (I02,90004) 01630308 ! 167: C 01640308 ! 168: C 01650308 ! 169: C TEST 032 THROUGH TEST 040 TEST INTRINSIC FUNCTIONS USING 01660308 ! 170: C INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 01670308 ! 171: C 01680308 ! 172: C 01690308 ! 173: C **** FCVS PROGRAM 308 - TEST 032 **** 01700308 ! 174: C 01710308 ! 175: C 01720308 ! 176: IVTNUM = 32 01730308 ! 177: IF (ICZERO) 30320, 0320, 30320 01740308 ! 178: 0320 CONTINUE 01750308 ! 179: RVCOMP = 10.0 01760308 ! 180: RVCOMP = ANINT (ABS (-2.78) ) 01770308 ! 181: RVCORR = 3.0 01780308 ! 182: 40320 IF (RVCOMP - 2.9995) 20320, 10320, 40321 01790308 ! 183: 40321 IF (RVCOMP - 3.0005) 10320, 10320, 20320 01800308 ! 184: 30320 IVDELE = IVDELE + 1 01810308 ! 185: WRITE (I02,80000) IVTNUM 01820308 ! 186: IF (ICZERO) 10320, 0331, 20320 01830308 ! 187: 10320 IVPASS = IVPASS + 1 01840308 ! 188: WRITE (I02,80002) IVTNUM 01850308 ! 189: GO TO 0331 01860308 ! 190: 20320 IVFAIL = IVFAIL + 1 01870308 ! 191: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01880308 ! 192: 0331 CONTINUE 01890308 ! 193: C 01900308 ! 194: C **** FCVS PROGRAM 308 - TEST 033 **** 01910308 ! 195: C 01920308 ! 196: C 01930308 ! 197: IVTNUM = 33 01940308 ! 198: IF (ICZERO) 30330, 0330, 30330 01950308 ! 199: 0330 CONTINUE 01960308 ! 200: RVCOMP = 10.0 01970308 ! 201: RVCOMP = ATAN (AINT (1.2) ) 01980308 ! 202: RVCORR = .78540 01990308 ! 203: 40330 IF (RVCOMP - .78535) 20330, 10330, 40331 02000308 ! 204: 40331 IF (RVCOMP - .78545) 10330, 10330, 20330 02010308 ! 205: 30330 IVDELE = IVDELE + 1 02020308 ! 206: WRITE (I02,80000) IVTNUM 02030308 ! 207: IF (ICZERO) 10330, 0341, 20330 02040308 ! 208: 10330 IVPASS = IVPASS + 1 02050308 ! 209: WRITE (I02,80002) IVTNUM 02060308 ! 210: GO TO 0341 02070308 ! 211: 20330 IVFAIL = IVFAIL + 1 02080308 ! 212: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090308 ! 213: 0341 CONTINUE 02100308 ! 214: C 02110308 ! 215: C **** FCVS PROGRAM 308 - TEST 034 **** 02120308 ! 216: C 02130308 ! 217: C 02140308 ! 218: IVTNUM = 34 02150308 ! 219: IF (ICZERO) 30340, 0340, 30340 02160308 ! 220: 0340 CONTINUE 02170308 ! 221: RVCOMP = 10.0 02180308 ! 222: RVCOMP = COS (ABS (-.78540) ) 02190308 ! 223: RVCORR = .70711 02200308 ! 224: 40340 IF (RVCOMP - .70706) 20340, 10340, 40341 02210308 ! 225: 40341 IF (RVCOMP - .70716) 10340, 10340, 20340 02220308 ! 226: 30340 IVDELE = IVDELE + 1 02230308 ! 227: WRITE (I02,80000) IVTNUM 02240308 ! 228: IF (ICZERO) 10340, 0351, 20340 02250308 ! 229: 10340 IVPASS = IVPASS + 1 02260308 ! 230: WRITE (I02,80002) IVTNUM 02270308 ! 231: GO TO 0351 02280308 ! 232: 20340 IVFAIL = IVFAIL + 1 02290308 ! 233: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02300308 ! 234: 0351 CONTINUE 02310308 ! 235: C 02320308 ! 236: C **** FCVS PROGRAM 308 - TEST 035 **** 02330308 ! 237: C 02340308 ! 238: C 02350308 ! 239: IVTNUM = 35 02360308 ! 240: IF (ICZERO) 30350, 0350, 30350 02370308 ! 241: 0350 CONTINUE 02380308 ! 242: RVCOMP = 10.0 02390308 ! 243: IVON01 = 6 02400308 ! 244: RVCOMP = AMAX0 (1, IVON01, IABS(-7) ) 02410308 ! 245: RVCORR = 7.0 02420308 ! 246: 40350 IF (RVCOMP - 6.9995) 20350, 10350, 40351 02430308 ! 247: 40351 IF (RVCOMP - 7.0005) 10350, 10350, 20350 02440308 ! 248: 30350 IVDELE = IVDELE + 1 02450308 ! 249: WRITE (I02,80000) IVTNUM 02460308 ! 250: IF (ICZERO) 10350, 0361, 20350 02470308 ! 251: 10350 IVPASS = IVPASS + 1 02480308 ! 252: WRITE (I02,80002) IVTNUM 02490308 ! 253: GO TO 0361 02500308 ! 254: 20350 IVFAIL = IVFAIL + 1 02510308 ! 255: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02520308 ! 256: 0361 CONTINUE 02530308 ! 257: C 02540308 ! 258: C **** FCVS PROGRAM 308 - TEST 036 **** 02550308 ! 259: C 02560308 ! 260: C 02570308 ! 261: IVTNUM = 36 02580308 ! 262: IF (ICZERO) 30360, 0360, 30360 02590308 ! 263: 0360 CONTINUE 02600308 ! 264: IVCOMP = 10 02610308 ! 265: IVCOMP = IABS (ISIGN (7, -2)) 02620308 ! 266: IVCORR = 7 02630308 ! 267: 40360 IF (IVCOMP - 7) 20360, 10360, 20360 02640308 ! 268: 30360 IVDELE = IVDELE + 1 02650308 ! 269: WRITE (I02,80000) IVTNUM 02660308 ! 270: IF (ICZERO) 10360, 0371, 20360 02670308 ! 271: 10360 IVPASS = IVPASS + 1 02680308 ! 272: WRITE (I02,80002) IVTNUM 02690308 ! 273: GO TO 0371 02700308 ! 274: 20360 IVFAIL = IVFAIL + 1 02710308 ! 275: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02720308 ! 276: 0371 CONTINUE 02730308 ! 277: C 02740308 ! 278: C **** FCVS PROGRAM 308 - TEST 037 **** 02750308 ! 279: C 02760308 ! 280: C 02770308 ! 281: IVTNUM = 37 02780308 ! 282: IF (ICZERO) 30370, 0370, 30370 02790308 ! 283: 0370 CONTINUE 02800308 ! 284: IVCOMP = 10 02810308 ! 285: IVCOMP = MOD (5, IABS (-3) ) 02820308 ! 286: IVCORR = 2 02830308 ! 287: 40370 IF (IVCOMP - 2) 20370, 10370, 20370 02840308 ! 288: 30370 IVDELE = IVDELE + 1 02850308 ! 289: WRITE (I02,80000) IVTNUM 02860308 ! 290: IF (ICZERO) 10370, 0381, 20370 02870308 ! 291: 10370 IVPASS = IVPASS + 1 02880308 ! 292: WRITE (I02,80002) IVTNUM 02890308 ! 293: GO TO 0381 02900308 ! 294: 20370 IVFAIL = IVFAIL + 1 02910308 ! 295: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02920308 ! 296: 0381 CONTINUE 02930308 ! 297: C 02940308 ! 298: C **** FCVS PROGRAM 308 - TEST 038 **** 02950308 ! 299: C 02960308 ! 300: C 02970308 ! 301: IVTNUM = 38 02980308 ! 302: IF (ICZERO) 30380, 0380, 30380 02990308 ! 303: 0380 CONTINUE 03000308 ! 304: IVCOMP = 10 03010308 ! 305: IVCOMP = ISIGN (-3, IABS (-5) ) 03020308 ! 306: IVCORR = 3 03030308 ! 307: 40380 IF (IVCOMP - 3) 20380, 10380, 20380 03040308 ! 308: 30380 IVDELE = IVDELE + 1 03050308 ! 309: WRITE (I02,80000) IVTNUM 03060308 ! 310: IF (ICZERO) 10380, 0391, 20380 03070308 ! 311: 10380 IVPASS = IVPASS + 1 03080308 ! 312: WRITE (I02,80002) IVTNUM 03090308 ! 313: GO TO 0391 03100308 ! 314: 20380 IVFAIL = IVFAIL + 1 03110308 ! 315: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120308 ! 316: 0391 CONTINUE 03130308 ! 317: C 03140308 ! 318: C **** FCVS PROGRAM 308 - TEST 039 **** 03150308 ! 319: C 03160308 ! 320: C REPEAT FUNCTION REFERENCE TWICE IN ONE INTRINSIC FUNCTION 03170308 ! 321: C REFERENCE. 03180308 ! 322: C 03190308 ! 323: IVTNUM = 39 03200308 ! 324: IF (ICZERO) 30390, 0390, 30390 03210308 ! 325: 0390 CONTINUE 03220308 ! 326: IVCOMP = 10 03230308 ! 327: IVCOMP = MAX0 (IABS (-5), IABS (-6) ) 03240308 ! 328: IVCORR = 6 03250308 ! 329: 40390 IF (IVCOMP -6) 20390, 10390, 20390 03260308 ! 330: 30390 IVDELE = IVDELE + 1 03270308 ! 331: WRITE (I02,80000) IVTNUM 03280308 ! 332: IF (ICZERO) 10390, 0401, 20390 03290308 ! 333: 10390 IVPASS = IVPASS + 1 03300308 ! 334: WRITE (I02,80002) IVTNUM 03310308 ! 335: GO TO 0401 03320308 ! 336: 20390 IVFAIL = IVFAIL + 1 03330308 ! 337: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03340308 ! 338: 0401 CONTINUE 03350308 ! 339: C 03360308 ! 340: C **** FCVS PROGRAM 308 - TEST 040 **** 03370308 ! 341: C 03380308 ! 342: C USE INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT TO ITSELF. 03390308 ! 343: C 03400308 ! 344: IVTNUM = 40 03410308 ! 345: IF (ICZERO) 30400, 0400, 30400 03420308 ! 346: 0400 CONTINUE 03430308 ! 347: RVCOMP = 10.0 03440308 ! 348: RVCOMP = SQRT (SQRT (25.) ) 03450308 ! 349: RVCORR = 2.2361 03460308 ! 350: 40400 IF (RVCOMP - 2.2356) 20400, 10400, 40401 03470308 ! 351: 40401 IF (RVCOMP - 2.2366) 10400, 10400, 20400 03480308 ! 352: 30400 IVDELE = IVDELE + 1 03490308 ! 353: WRITE (I02,80000) IVTNUM 03500308 ! 354: IF (ICZERO) 10400, 0411, 20400 03510308 ! 355: 10400 IVPASS = IVPASS + 1 03520308 ! 356: WRITE (I02,80002) IVTNUM 03530308 ! 357: GO TO 0411 03540308 ! 358: 20400 IVFAIL = IVFAIL + 1 03550308 ! 359: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03560308 ! 360: 0411 CONTINUE 03570308 ! 361: C 03580308 ! 362: C TEST 041 THROUGH TEST 045 TEST INTRINSIC FUNCTIONS USING EXTERNAL 03590308 ! 363: C FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 03600308 ! 364: C 03610308 ! 365: C 03620308 ! 366: C **** FCVS PROGRAM 308 - TEST 041 **** 03630308 ! 367: C 03640308 ! 368: C 03650308 ! 369: IVTNUM = 41 03660308 ! 370: IF (ICZERO) 30410, 0410, 30410 03670308 ! 371: 0410 CONTINUE 03680308 ! 372: RVCOMP = 10.0 03690308 ! 373: RVCOMP = ALOG (FF309 (29.0) ) 03700308 ! 374: RVCORR = 3.4012 03710308 ! 375: 40410 IF (RVCOMP - 3.4007) 20410, 10410, 40411 03720308 ! 376: 40411 IF (RVCOMP - 3.4017) 10410, 10410, 20410 03730308 ! 377: 30410 IVDELE = IVDELE + 1 03740308 ! 378: WRITE (I02,80000) IVTNUM 03750308 ! 379: IF (ICZERO) 10410, 0421, 20410 03760308 ! 380: 10410 IVPASS = IVPASS + 1 03770308 ! 381: WRITE (I02,80002) IVTNUM 03780308 ! 382: GO TO 0421 03790308 ! 383: 20410 IVFAIL = IVFAIL + 1 03800308 ! 384: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03810308 ! 385: 0421 CONTINUE 03820308 ! 386: C 03830308 ! 387: C **** FCVS PROGRAM 308 - TEST 042 **** 03840308 ! 388: C 03850308 ! 389: C 03860308 ! 390: IVTNUM = 42 03870308 ! 391: IF (ICZERO) 30420, 0420, 30420 03880308 ! 392: 0420 CONTINUE 03890308 ! 393: RVCOMP = 10.0 03900308 ! 394: RVCOMP = ASIN (FF309 (0.) ) 03910308 ! 395: RVCORR = 1.5708 03920308 ! 396: 40420 IF (RVCOMP - 1.5703) 20420, 10420, 40421 03930308 ! 397: 40421 IF (RVCOMP - 1.5713) 10420, 10420, 20420 03940308 ! 398: 30420 IVDELE = IVDELE + 1 03950308 ! 399: WRITE (I02,80000) IVTNUM 03960308 ! 400: IF (ICZERO) 10420, 0431, 20420 03970308 ! 401: 10420 IVPASS = IVPASS + 1 03980308 ! 402: WRITE (I02,80002) IVTNUM 03990308 ! 403: GO TO 0431 04000308 ! 404: 20420 IVFAIL = IVFAIL + 1 04010308 ! 405: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04020308 ! 406: 0431 CONTINUE 04030308 ! 407: C 04040308 ! 408: C **** FCVS PROGRAM 308 - TEST 043 **** 04050308 ! 409: C 04060308 ! 410: C 04070308 ! 411: IVTNUM = 43 04080308 ! 412: IF (ICZERO) 30430, 0430, 30430 04090308 ! 413: 0430 CONTINUE 04100308 ! 414: RVCOMP = 10.0 04110308 ! 415: RVON01 = 1.5 04120308 ! 416: RVCOMP = COSH (FF309 (RVON01) ) 04130308 ! 417: RVCORR = 6.1323 04140308 ! 418: 40430 IF (RVCOMP - 6.1318) 20430, 10430, 40431 04150308 ! 419: 40431 IF (RVCOMP - 6.1328) 10430, 10430, 20430 04160308 ! 420: 30430 IVDELE = IVDELE + 1 04170308 ! 421: WRITE (I02,80000) IVTNUM 04180308 ! 422: IF (ICZERO) 10430, 0441, 20430 04190308 ! 423: 10430 IVPASS = IVPASS + 1 04200308 ! 424: WRITE (I02,80002) IVTNUM 04210308 ! 425: GO TO 0441 04220308 ! 426: 20430 IVFAIL = IVFAIL + 1 04230308 ! 427: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04240308 ! 428: 0441 CONTINUE 04250308 ! 429: C 04260308 ! 430: C **** FCVS PROGRAM 308 - TEST 044 **** 04270308 ! 431: C 04280308 ! 432: C 04290308 ! 433: IVTNUM = 44 04300308 ! 434: IF (ICZERO) 30440, 0440, 30440 04310308 ! 435: 0440 CONTINUE 04320308 ! 436: IVCOMP = 10 04330308 ! 437: IVCOMP = IFIX (FF309 (33.3) ) 04340308 ! 438: IVCORR = 34 04350308 ! 439: 40440 IF (IVCOMP - 34) 20440, 10440, 20440 04360308 ! 440: 30440 IVDELE = IVDELE + 1 04370308 ! 441: WRITE (I02,80000) IVTNUM 04380308 ! 442: IF (ICZERO) 10440, 0451, 20440 04390308 ! 443: 10440 IVPASS = IVPASS + 1 04400308 ! 444: WRITE (I02,80002) IVTNUM 04410308 ! 445: GO TO 0451 04420308 ! 446: 20440 IVFAIL = IVFAIL + 1 04430308 ! 447: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04440308 ! 448: 0451 CONTINUE 04450308 ! 449: C 04460308 ! 450: C **** FCVS PROGRAM 308 - TEST 045 **** 04470308 ! 451: C 04480308 ! 452: C 04490308 ! 453: IVTNUM = 45 04500308 ! 454: IF (ICZERO) 30450, 0450, 30450 04510308 ! 455: 0450 CONTINUE 04520308 ! 456: RVCOMP = 10.0 04530308 ! 457: RADN11(2) = 2.1416 04540308 ! 458: RVCOMP = TAN (FF309 (RADN11(2))) 04550308 ! 459: RVCORR = 0.0 04560308 ! 460: 40450 IF (RVCOMP + .00005) 20450, 10450, 40451 04570308 ! 461: 40451 IF (RVCOMP - .00005) 10450, 10450, 20450 04580308 ! 462: 30450 IVDELE = IVDELE + 1 04590308 ! 463: WRITE (I02,80000) IVTNUM 04600308 ! 464: IF (ICZERO) 10450, 0461, 20450 04610308 ! 465: 10450 IVPASS = IVPASS + 1 04620308 ! 466: WRITE (I02,80002) IVTNUM 04630308 ! 467: GO TO 0461 04640308 ! 468: 20450 IVFAIL = IVFAIL + 1 04650308 ! 469: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04660308 ! 470: 0461 CONTINUE 04670308 ! 471: C 04680308 ! 472: C TEST 046 THROUGH TEST 052 TEST INTRINSIC FUNCTIONS USING 04690308 ! 473: C EXPRESSIONS INVOLVING OPERATORS AS ACTUAL ARGUMENTS. 04700308 ! 474: C 04710308 ! 475: C 04720308 ! 476: C **** FCVS PROGRAM 308 - TEST 046 **** 04730308 ! 477: C 04740308 ! 478: C 04750308 ! 479: IVTNUM = 46 04760308 ! 480: IF (ICZERO) 30460, 0460, 30460 04770308 ! 481: 0460 CONTINUE 04780308 ! 482: RVCOMP = 10.0 04790308 ! 483: RVCOMP = ABS (3.4 - 8.2) 04800308 ! 484: RVCORR = 4.8 04810308 ! 485: 40460 IF (RVCOMP - 4.7995) 20460, 10460, 40461 04820308 ! 486: 40461 IF (RVCOMP - 4.8005) 10460, 10460, 20460 04830308 ! 487: 30460 IVDELE = IVDELE + 1 04840308 ! 488: WRITE (I02,80000) IVTNUM 04850308 ! 489: IF (ICZERO) 10460, 0471, 20460 04860308 ! 490: 10460 IVPASS = IVPASS + 1 04870308 ! 491: WRITE (I02,80002) IVTNUM 04880308 ! 492: GO TO 0471 04890308 ! 493: 20460 IVFAIL = IVFAIL + 1 04900308 ! 494: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04910308 ! 495: 0471 CONTINUE 04920308 ! 496: C 04930308 ! 497: C **** FCVS PROGRAM 308 - TEST 047 **** 04940308 ! 498: C 04950308 ! 499: C 04960308 ! 500: IVTNUM = 47 04970308 ! 501: IF (ICZERO) 30470, 0470, 30470 04980308 ! 502: 0470 CONTINUE 04990308 ! 503: RVCOMP = 10.0 05000308 ! 504: IVON01 = 2 05010308 ! 505: RVON01 = 3.0 05020308 ! 506: RVCOMP = ACOS (IVON01 - RVON01 * .5) 05030308 ! 507: RVCORR = 1.0472 05040308 ! 508: 40470 IF (RVCOMP - 1.0467) 20470, 10470, 40471 05050308 ! 509: 40471 IF (RVCOMP - 1.0477) 10470, 10470, 20470 05060308 ! 510: 30470 IVDELE = IVDELE + 1 05070308 ! 511: WRITE (I02,80000) IVTNUM 05080308 ! 512: IF (ICZERO) 10470, 0481, 20470 05090308 ! 513: 10470 IVPASS = IVPASS + 1 05100308 ! 514: WRITE (I02,80002) IVTNUM 05110308 ! 515: GO TO 0481 05120308 ! 516: 20470 IVFAIL = IVFAIL + 1 05130308 ! 517: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140308 ! 518: 0481 CONTINUE 05150308 ! 519: C 05160308 ! 520: C **** FCVS PROGRAM 308 - TEST 048 **** 05170308 ! 521: C 05180308 ! 522: C 05190308 ! 523: IVTNUM = 48 05200308 ! 524: IF (ICZERO) 30480, 0480, 30480 05210308 ! 525: 0480 CONTINUE 05220308 ! 526: RVCOMP = 10.0 05230308 ! 527: IVON01 = 2 05240308 ! 528: RVON01 = -4.8 05250308 ! 529: RVON02 = 4.5 05260308 ! 530: RVCOMP = AMIN1 (RVON01, (IVON01 - 3.2) * RVON02) 05270308 ! 531: RVCORR = -5.4 05280308 ! 532: 40480 IF (RVCOMP + 5.4005 ) 20480, 10480, 40481 05290308 ! 533: 40481 IF (RVCOMP + 5.3995 ) 10480, 10480, 20480 05300308 ! 534: 30480 IVDELE = IVDELE + 1 05310308 ! 535: WRITE (I02,80000) IVTNUM 05320308 ! 536: IF (ICZERO) 10480, 0491, 20480 05330308 ! 537: 10480 IVPASS = IVPASS + 1 05340308 ! 538: WRITE (I02,80002) IVTNUM 05350308 ! 539: GO TO 0491 05360308 ! 540: 20480 IVFAIL = IVFAIL + 1 05370308 ! 541: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05380308 ! 542: 0491 CONTINUE 05390308 ! 543: C 05400308 ! 544: C **** FCVS PROGRAM 308 - TEST 049 **** 05410308 ! 545: C 05420308 ! 546: C 05430308 ! 547: IVTNUM = 49 05440308 ! 548: IF (ICZERO) 30490, 0490, 30490 05450308 ! 549: 0490 CONTINUE 05460308 ! 550: RVCOMP = 10.0 05470308 ! 551: RVON01 = 12.0 05480308 ! 552: IADN11(1) = 3 05490308 ! 553: RADN11(2) = 2.5 05500308 ! 554: RVCOMP = AMOD (RVON01 / IADN11(1), 12 / RADN11(2)) 05510308 ! 555: RVCORR = 4.0 05520308 ! 556: 40490 IF (RVCOMP - 3.9995) 20490, 10490, 40491 05530308 ! 557: 40491 IF (RVCOMP - 4.0005) 10490, 10490, 20490 05540308 ! 558: 30490 IVDELE = IVDELE + 1 05550308 ! 559: WRITE (I02,80000) IVTNUM 05560308 ! 560: IF (ICZERO) 10490, 0501, 20490 05570308 ! 561: 10490 IVPASS = IVPASS + 1 05580308 ! 562: WRITE (I02,80002) IVTNUM 05590308 ! 563: GO TO 0501 05600308 ! 564: 20490 IVFAIL = IVFAIL + 1 05610308 ! 565: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05620308 ! 566: 0501 CONTINUE 05630308 ! 567: C 05640308 ! 568: C **** FCVS PROGRAM 308 - TEST 050 **** 05650308 ! 569: C 05660308 ! 570: C 05670308 ! 571: IVTNUM = 50 05680308 ! 572: IF (ICZERO) 30500, 0500, 30500 05690308 ! 573: 0500 CONTINUE 05700308 ! 574: IVCOMP = 10 05710308 ! 575: IVON01 = 2 05720308 ! 576: IVON02 = 9 05730308 ! 577: IVCOMP = IDIM (IVON01 ** 3, IVON02) 05740308 ! 578: IVCORR = 0 05750308 ! 579: 40500 IF (IVCOMP) 20500, 10500, 20500 05760308 ! 580: 30500 IVDELE = IVDELE + 1 05770308 ! 581: WRITE (I02,80000) IVTNUM 05780308 ! 582: IF (ICZERO) 10500, 0511, 20500 05790308 ! 583: 10500 IVPASS = IVPASS + 1 05800308 ! 584: WRITE (I02,80002) IVTNUM 05810308 ! 585: GO TO 0511 05820308 ! 586: 20500 IVFAIL = IVFAIL + 1 05830308 ! 587: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05840308 ! 588: 0511 CONTINUE 05850308 ! 589: C 05860308 ! 590: C **** FCVS PROGRAM 308 - TEST 051 **** 05870308 ! 591: C 05880308 ! 592: C 05890308 ! 593: IVTNUM = 51 05900308 ! 594: IF (ICZERO) 30510, 0510, 30510 05910308 ! 595: 0510 CONTINUE 05920308 ! 596: RVCOMP = 10.0 05930308 ! 597: IVON01 = 6 05940308 ! 598: RVCOMP = REAL (IABS (-3) + IVON01) 05950308 ! 599: RVCORR = 9.0 05960308 ! 600: 40510 IF (RVCOMP - 8.9995) 20510, 10510, 40511 05970308 ! 601: 40511 IF (RVCOMP - 9.0005) 10510, 10510, 20510 05980308 ! 602: 30510 IVDELE = IVDELE + 1 05990308 ! 603: WRITE (I02,80000) IVTNUM 06000308 ! 604: IF (ICZERO) 10510, 0521, 20510 06010308 ! 605: 10510 IVPASS = IVPASS + 1 06020308 ! 606: WRITE (I02,80002) IVTNUM 06030308 ! 607: GO TO 0521 06040308 ! 608: 20510 IVFAIL = IVFAIL + 1 06050308 ! 609: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06060308 ! 610: 0521 CONTINUE 06070308 ! 611: C 06080308 ! 612: C **** FCVS PROGRAM 308 - TEST 052 **** 06090308 ! 613: C 06100308 ! 614: C 06110308 ! 615: IVTNUM = 52 06120308 ! 616: IF (ICZERO) 30520, 0520, 30520 06130308 ! 617: 0520 CONTINUE 06140308 ! 618: RVCOMP = 10.0 06150308 ! 619: RVON01 = 2.3 06160308 ! 620: IVON01 = 150 06170308 ! 621: IADN11(1) = 3 06180308 ! 622: RVCOMP = SIGN(13+RVON01*IABS(-4)-IVON01/FF309(1.)**IADN11(1),-1.) 06190308 ! 623: RVCORR = -3.45 06200308 ! 624: 40520 IF (RVCOMP + 3.4505) 20520, 10520, 40521 06210308 ! 625: 40521 IF (RVCOMP + 3.4495) 10520, 10520, 20520 06220308 ! 626: 30520 IVDELE = IVDELE + 1 06230308 ! 627: WRITE (I02,80000) IVTNUM 06240308 ! 628: IF (ICZERO) 10520, 0531, 20520 06250308 ! 629: 10520 IVPASS = IVPASS + 1 06260308 ! 630: WRITE (I02,80002) IVTNUM 06270308 ! 631: GO TO 0531 06280308 ! 632: 20520 IVFAIL = IVFAIL + 1 06290308 ! 633: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06300308 ! 634: 0531 CONTINUE 06310308 ! 635: C 06320308 ! 636: C TEST 053 THROUGH TEST 056 TEST INTRINSIC FUNCTIONS USING 06330308 ! 637: C STATEMENT FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 06340308 ! 638: C 06350308 ! 639: C 06360308 ! 640: C **** FCVS PROGRAM 308 - TEST 053 **** 06370308 ! 641: C 06380308 ! 642: C 06390308 ! 643: IVTNUM = 53 06400308 ! 644: IF (ICZERO) 30530, 0530, 30530 06410308 ! 645: 0530 CONTINUE 06420308 ! 646: RVCOMP = 10.0 06430308 ! 647: RVCOMP = DIM (RFOS01(5.4), 6.0) 06440308 ! 648: RVCORR = .4 06450308 ! 649: 40530 IF (RVCOMP - .39995) 20530, 10530, 40531 06460308 ! 650: 40531 IF (RVCOMP - .40005) 10530, 10530, 20530 06470308 ! 651: 30530 IVDELE = IVDELE + 1 06480308 ! 652: WRITE (I02,80000) IVTNUM 06490308 ! 653: IF (ICZERO) 10530, 0541, 20530 06500308 ! 654: 10530 IVPASS = IVPASS + 1 06510308 ! 655: WRITE (I02,80002) IVTNUM 06520308 ! 656: GO TO 0541 06530308 ! 657: 20530 IVFAIL = IVFAIL + 1 06540308 ! 658: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06550308 ! 659: 0541 CONTINUE 06560308 ! 660: C 06570308 ! 661: C **** FCVS PROGRAM 308 - TEST 054 **** 06580308 ! 662: C 06590308 ! 663: C 06600308 ! 664: IVTNUM = 54 06610308 ! 665: IF (ICZERO) 30540, 0540, 30540 06620308 ! 666: 0540 CONTINUE 06630308 ! 667: IVCOMP = 10 06640308 ! 668: IVCOMP = INT(RFOS01(2.01)) 06650308 ! 669: IVCORR = 3 06660308 ! 670: 40540 IF (IVCOMP - 3) 20540, 10540, 20540 06670308 ! 671: 30540 IVDELE = IVDELE + 1 06680308 ! 672: WRITE (I02,80000) IVTNUM 06690308 ! 673: IF (ICZERO) 10540, 0551, 20540 06700308 ! 674: 10540 IVPASS = IVPASS + 1 06710308 ! 675: WRITE (I02,80002) IVTNUM 06720308 ! 676: GO TO 0551 06730308 ! 677: 20540 IVFAIL = IVFAIL + 1 06740308 ! 678: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06750308 ! 679: 0551 CONTINUE 06760308 ! 680: C 06770308 ! 681: C **** FCVS PROGRAM 308 - TEST 055 **** 06780308 ! 682: C 06790308 ! 683: C 06800308 ! 684: IVTNUM = 55 06810308 ! 685: IF (ICZERO) 30550, 0550, 30550 06820308 ! 686: 0550 CONTINUE 06830308 ! 687: RVCOMP = 10.0 06840308 ! 688: RVON01 = 0.5708 06850308 ! 689: RVCOMP = SIN (RFOS01 (RVON01) / 2) 06860308 ! 690: RVCORR = .70711 06870308 ! 691: 40550 IF (RVCOMP - .70706) 20550, 10550, 40551 06880308 ! 692: 40551 IF (RVCOMP - .70716) 10550, 10550, 20550 06890308 ! 693: 30550 IVDELE = IVDELE + 1 06900308 ! 694: WRITE (I02,80000) IVTNUM 06910308 ! 695: IF (ICZERO) 10550, 0561, 20550 06920308 ! 696: 10550 IVPASS = IVPASS + 1 06930308 ! 697: WRITE (I02,80002) IVTNUM 06940308 ! 698: GO TO 0561 06950308 ! 699: 20550 IVFAIL = IVFAIL + 1 06960308 ! 700: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06970308 ! 701: 0561 CONTINUE 06980308 ! 702: C 06990308 ! 703: C **** FCVS PROGRAM 308 - TEST 056 **** 07000308 ! 704: C 07010308 ! 705: C 07020308 ! 706: IVTNUM = 56 07030308 ! 707: IF (ICZERO) 30560, 0560, 30560 07040308 ! 708: 0560 CONTINUE 07050308 ! 709: RVCOMP = 10.0 07060308 ! 710: RADN11(2) = 1.5 07070308 ! 711: RVCOMP = TANH(RFOS01(RADN11(2))) 07080308 ! 712: RVCORR = .98661 07090308 ! 713: 40560 IF (RVCOMP - .98656) 20560, 10560, 40561 07100308 ! 714: 40561 IF (RVCOMP - .98666) 10560, 10560, 20560 07110308 ! 715: 30560 IVDELE = IVDELE + 1 07120308 ! 716: WRITE (I02,80000) IVTNUM 07130308 ! 717: IF (ICZERO) 10560, 0571, 20560 07140308 ! 718: 10560 IVPASS = IVPASS + 1 07150308 ! 719: WRITE (I02,80002) IVTNUM 07160308 ! 720: GO TO 0571 07170308 ! 721: 20560 IVFAIL = IVFAIL + 1 07180308 ! 722: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07190308 ! 723: 0571 CONTINUE 07200308 ! 724: C 07210308 ! 725: C **** FCVS PROGRAM 308 - TEST 057 **** 07220308 ! 726: C 07230308 ! 727: C TEST 057 TESTS THE INTRINSIC FUNCTION AINT USING AN EXTERNAL 07240308 ! 728: C FUNCTION REFERENCE AS AN ACTUAL ARGUMENT AND THE COMMON 07250308 ! 729: C STATEMENT AS A MEANS OF PASSING DATA TO THE EXTERNAL FUNCTION. 07260308 ! 730: C 07270308 ! 731: IVTNUM = 57 07280308 ! 732: IF (ICZERO) 30570, 0570, 30570 07290308 ! 733: 0570 CONTINUE 07300308 ! 734: RVCOMP = 10.0 07310308 ! 735: RVCN01 = 25.3 07320308 ! 736: RVCOMP = AINT(FF310( )) 07330308 ! 737: RVCORR = 26.0 07340308 ! 738: 40570 IF (RVCOMP - 25.995) 20570, 10570, 40571 07350308 ! 739: 40571 IF (RVCOMP - 26.005) 10570, 10570, 20570 07360308 ! 740: 30570 IVDELE = IVDELE + 1 07370308 ! 741: WRITE (I02,80000) IVTNUM 07380308 ! 742: IF (ICZERO) 10570, 0581, 20570 07390308 ! 743: 10570 IVPASS = IVPASS + 1 07400308 ! 744: WRITE (I02,80002) IVTNUM 07410308 ! 745: GO TO 0581 07420308 ! 746: 20570 IVFAIL = IVFAIL + 1 07430308 ! 747: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07440308 ! 748: 0581 CONTINUE 07450308 ! 749: C 07460308 ! 750: C **** FCVS PROGRAM 308 - TEST 058 **** 07470308 ! 751: C 07480308 ! 752: C TEST 058 TESTS THE INTRINSIC FUNCTION FLOAT BY USING A VARIABLE 07490308 ! 753: C EQUATED BY EQUIVALENCE ASSOCIATION AS AN ACTUAL ARGUMENT. 07500308 ! 754: C 07510308 ! 755: IVTNUM = 58 07520308 ! 756: IF (ICZERO) 30580, 0580, 30580 07530308 ! 757: 0580 CONTINUE 07540308 ! 758: RVCOMP = 10.0 07550308 ! 759: IVOE01 = 5 07560308 ! 760: RVCOMP = FLOAT(IVOE01) 07570308 ! 761: RVCORR = 5.0 07580308 ! 762: 40580 IF (RVCOMP - 4.9995) 20580, 10580, 40581 07590308 ! 763: 40581 IF (RVCOMP - 5.0005) 10580, 10580, 20580 07600308 ! 764: 30580 IVDELE = IVDELE + 1 07610308 ! 765: WRITE (I02,80000) IVTNUM 07620308 ! 766: IF (ICZERO) 10580, 0591, 20580 07630308 ! 767: 10580 IVPASS = IVPASS + 1 07640308 ! 768: WRITE (I02,80002) IVTNUM 07650308 ! 769: GO TO 0591 07660308 ! 770: 20580 IVFAIL = IVFAIL + 1 07670308 ! 771: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07680308 ! 772: 0591 CONTINUE 07690308 ! 773: C 07700308 ! 774: C **** FCVS PROGRAM 308 - TEST 059 **** 07710308 ! 775: C 07720308 ! 776: C TEST 059 TESTS THE INTRINSIC FUNCTION MIN1 BY USING A VARIABLE 07730308 ! 777: C INITIALIZED BY THE DATA STATEMENT AS AN ACTUAL ARGUMENT. 07740308 ! 778: C 07750308 ! 779: IVTNUM = 59 07760308 ! 780: IF (ICZERO) 30590, 0590, 30590 07770308 ! 781: 0590 CONTINUE 07780308 ! 782: IVCOMP = 10 07790308 ! 783: IVCOMP = MIN1(6., RVON04, 7.3) 07800308 ! 784: IVCORR = 2 07810308 ! 785: 40590 IF (IVCOMP - 2) 20590, 10590, 20590 07820308 ! 786: 30590 IVDELE = IVDELE + 1 07830308 ! 787: WRITE (I02,80000) IVTNUM 07840308 ! 788: IF (ICZERO) 10590, 0601, 20590 07850308 ! 789: 10590 IVPASS = IVPASS + 1 07860308 ! 790: WRITE (I02,80002) IVTNUM 07870308 ! 791: GO TO 0601 07880308 ! 792: 20590 IVFAIL = IVFAIL + 1 07890308 ! 793: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07900308 ! 794: 0601 CONTINUE 07910308 ! 795: C 07920308 ! 796: C **** FCVS PROGRAM 308 - TEST 060 **** 07930308 ! 797: C 07940308 ! 798: C TEST 060 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 07950308 ! 799: C INTRINSIC FUNCTION EXP WITH IMPLICIT INTEGER TYPING. 07960308 ! 800: C 07970308 ! 801: IVTNUM = 60 07980308 ! 802: IF (ICZERO) 30600, 0600, 30600 07990308 ! 803: 0600 CONTINUE 08000308 ! 804: RVCOMP = 10.0 08010308 ! 805: RVON01 = 2.05 08020308 ! 806: RVCOMP = EXP(RVON01) 08030308 ! 807: RVCORR = 7.7679 08040308 ! 808: 40600 IF (RVCOMP - 7.7674) 20600, 10600, 40601 08050308 ! 809: 40601 IF (RVCOMP - 7.7684) 10600, 10600, 20600 08060308 ! 810: 30600 IVDELE = IVDELE + 1 08070308 ! 811: WRITE (I02,80000) IVTNUM 08080308 ! 812: IF (ICZERO) 10600, 0611, 20600 08090308 ! 813: 10600 IVPASS = IVPASS + 1 08100308 ! 814: WRITE (I02,80002) IVTNUM 08110308 ! 815: GO TO 0611 08120308 ! 816: 20600 IVFAIL = IVFAIL + 1 08130308 ! 817: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08140308 ! 818: 0611 CONTINUE 08150308 ! 819: C 08160308 ! 820: C **** FCVS PROGRAM 308 - TEST 061 **** 08170308 ! 821: C 08180308 ! 822: C TEST 061 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08190308 ! 823: C INTRINSIC FUNCTION NINT WITH IMPLICIT REAL TYPING. 08200308 ! 824: C 08210308 ! 825: IVTNUM = 61 08220308 ! 826: IF (ICZERO) 30610, 0610, 30610 08230308 ! 827: 0610 CONTINUE 08240308 ! 828: RVCOMP = 10.0 08250308 ! 829: RVON01 = 3.78 08260308 ! 830: RVCOMP = NINT(RVON01) / 5 08270308 ! 831: RVCORR = 0.0 08280308 ! 832: 40610 IF (RVCOMP + .00005) 20610, 10610, 40611 08290308 ! 833: 40611 IF (RVCOMP - .00005) 10610, 10610, 20610 08300308 ! 834: 30610 IVDELE = IVDELE + 1 08310308 ! 835: WRITE (I02,80000) IVTNUM 08320308 ! 836: IF (ICZERO) 10610, 0621, 20610 08330308 ! 837: 10610 IVPASS = IVPASS + 1 08340308 ! 838: WRITE (I02,80002) IVTNUM 08350308 ! 839: GO TO 0621 08360308 ! 840: 20610 IVFAIL = IVFAIL + 1 08370308 ! 841: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08380308 ! 842: 0621 CONTINUE 08390308 ! 843: C 08400308 ! 844: C **** FCVS PROGRAM 308 - TEST 062 **** 08410308 ! 845: C 08420308 ! 846: C TEST 062 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 08430308 ! 847: C INTRINSIC FUNCTION SINH WITH TYPE-STATEMENT TYPING OF INTEGER. 08440308 ! 848: C 08450308 ! 849: IVTNUM = 62 08460308 ! 850: IF (ICZERO) 30620, 0620, 30620 08470308 ! 851: 0620 CONTINUE 08480308 ! 852: RVCOMP = 10.0 08490308 ! 853: RVCOMP = SINH(2.0) 08500308 ! 854: RVCORR = 3.6269 08510308 ! 855: 40620 IF (RVCOMP - 3.6264) 20620, 10620, 40621 08520308 ! 856: 40621 IF (RVCOMP - 3.6274) 10620, 10620, 20620 08530308 ! 857: 30620 IVDELE = IVDELE + 1 08540308 ! 858: WRITE (I02,80000) IVTNUM 08550308 ! 859: IF (ICZERO) 10620, 0631, 20620 08560308 ! 860: 10620 IVPASS = IVPASS + 1 08570308 ! 861: WRITE (I02,80002) IVTNUM 08580308 ! 862: GO TO 0631 08590308 ! 863: 20620 IVFAIL = IVFAIL + 1 08600308 ! 864: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08610308 ! 865: 0631 CONTINUE 08620308 ! 866: C 08630308 ! 867: C **** FCVS PROGRAM 308 - TEST 063 **** 08640308 ! 868: C 08650308 ! 869: C TEST 063 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08660308 ! 870: C INTRINSIC FUNCTION MAX1 WITH TYPE-STATEMENT TYPING OF REAL. 08670308 ! 871: C 08680308 ! 872: IVTNUM = 63 08690308 ! 873: IF (ICZERO) 30630, 0630, 30630 08700308 ! 874: 0630 CONTINUE 08710308 ! 875: RVCOMP = 10.0 08720308 ! 876: RVCOMP = MAX1(2.3, 3.1, 4.4) / 5 08730308 ! 877: RVCORR = 0.0 08740308 ! 878: 40630 IF (RVCOMP + .00005) 20630, 10630, 40631 08750308 ! 879: 40631 IF (RVCOMP - .00005) 10630, 10630, 20630 08760308 ! 880: 30630 IVDELE = IVDELE + 1 08770308 ! 881: WRITE (I02,80000) IVTNUM 08780308 ! 882: IF (ICZERO) 10630, 0641, 20630 08790308 ! 883: 10630 IVPASS = IVPASS + 1 08800308 ! 884: WRITE (I02,80002) IVTNUM 08810308 ! 885: GO TO 0641 08820308 ! 886: 20630 IVFAIL = IVFAIL + 1 08830308 ! 887: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08840308 ! 888: 0641 CONTINUE 08850308 ! 889: C 08860308 ! 890: C 08870308 ! 891: C WRITE OUT TEST SUMMARY 08880308 ! 892: C 08890308 ! 893: WRITE (I02,90004) 08900308 ! 894: WRITE (I02,90014) 08910308 ! 895: WRITE (I02,90004) 08920308 ! 896: WRITE (I02,90000) 08930308 ! 897: WRITE (I02,90004) 08940308 ! 898: WRITE (I02,90020) IVFAIL 08950308 ! 899: WRITE (I02,90022) IVPASS 08960308 ! 900: WRITE (I02,90024) IVDELE 08970308 ! 901: STOP 08980308 ! 902: 90001 FORMAT (1H ,24X,5HFM308) 08990308 ! 903: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM308) 09000308 ! 904: C 09010308 ! 905: C FORMATS FOR TEST DETAIL LINES 09020308 ! 906: C 09030308 ! 907: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 09040308 ! 908: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 09050308 ! 909: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 09060308 ! 910: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 09070308 ! 911: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 09080308 ! 912: C 09090308 ! 913: C FORMAT STATEMENTS FOR PAGE HEADERS 09100308 ! 914: C 09110308 ! 915: 90002 FORMAT (1H1) 09120308 ! 916: 90004 FORMAT (1H ) 09130308 ! 917: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 09140308 ! 918: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 09150308 ! 919: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 09160308 ! 920: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 09170308 ! 921: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 09180308 ! 922: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 09190308 ! 923: C 09200308 ! 924: C FORMAT STATEMENTS FOR RUN SUMMARY 09210308 ! 925: C 09220308 ! 926: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 09230308 ! 927: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 09240308 ! 928: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 09250308 ! 929: END 09260308 ! 930: REAL FUNCTION FF309(RDON01) 00010309 ! 931: C DATE***82/08/02*18.33.46 ! 932: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 933: C AUDIT FCVS78 V2.0 ! 934: C THIS FUNCTION IS USED TO INCREMENT THE ARGUMENT VALUE BY 00020309 ! 935: C ONE AND RETURN THE RESULT AS THE FUNCTION VALUE. 00030309 ! 936: FF309 = RDON01 + 1.0 00040309 ! 937: RETURN 00050309 ! 938: END 00060309 ! 939: REAL FUNCTION FF310 ( ) 00010310 ! 940: C DATE***82/08/02*18.33.46 ! 941: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 942: C AUDIT FCVS78 V2.0 ! 943: C THIS FUNCTION IS USED TO INCREMENT BY ONE A VALUE PASSED 00020310 ! 944: C TO THE FUNCTION THROUGH COMMON. 00030310 ! 945: COMMON RVCN01 00040310 ! 946: FF310 = RVCN01 + 1.0 00050310 ! 947: RETURN 00060310 ! 948: END 00070310
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.