![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM307.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 FM307.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 FM307 00010307 ! 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 00020307 ! 6: C 00030307 ! 7: C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION 00040307 ! 8: C TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE 00050307 ! 9: C FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE. 00060307 ! 10: C THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND 00070307 ! 11: C UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES. EACH 00080307 ! 12: C INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT 00090307 ! 13: C COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE 00100307 ! 14: C VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF 00110307 ! 15: C ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE. THE 00120307 ! 16: C INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE. 00130307 ! 17: C 00140307 ! 18: C SPECIFIC TYPE OF 00150307 ! 19: C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00160307 ! 20: C ------------------ ------ -------- --------00170307 ! 21: C CONVERSION TO REAL REAL INTEGER REAL 00180307 ! 22: C NEAREST WHOLE NUMBER ANINT REAL REAL 00190307 ! 23: C NEAREST INTEGER NINT REAL INTEGER 00200307 ! 24: C TANGENT TAN REAL REAL 00210307 ! 25: C ARCSINE ASIN REAL REAL 00220307 ! 26: C ARCCOSINE ACOS REAL REAL 00230307 ! 27: C HYPERBOLIC SINE SINH REAL REAL 00240307 ! 28: C HYPERBOLIC COSINE COSH REAL REAL 00250307 ! 29: C 00260307 ! 30: C SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO 00270307 ! 31: C TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS. 00280307 ! 32: C 00290307 ! 33: C REFERENCES. 00300307 ! 34: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00310307 ! 35: C X3.9-1978 00320307 ! 36: C 00330307 ! 37: C SECTION 15.3, INTRINSIC FUNCTIONS 00340307 ! 38: C SECTION 15.9.2, ACTUAL ARGUMENTS 00350307 ! 39: C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00360307 ! 40: C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00370307 ! 41: C SECTION 15.10.1, RESTRICTION ON RANGE OF ARGUMENTS AND RESULTS00380307 ! 42: C 00390307 ! 43: C 00400307 ! 44: C ******************************************************************00410307 ! 45: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00420307 ! 46: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00430307 ! 47: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00440307 ! 48: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00450307 ! 49: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00460307 ! 50: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00470307 ! 51: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00480307 ! 52: C THE RESULT OF EXECUTING THESE TESTS. 00490307 ! 53: C 00500307 ! 54: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00510307 ! 55: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00520307 ! 56: C 00530307 ! 57: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00540307 ! 58: C DEPARTMENT OF THE NAVY 00550307 ! 59: C FEDERAL COBOL COMPILER TESTING SERVICE 00560307 ! 60: C WASHINGTON, D.C. 20376 00570307 ! 61: C 00580307 ! 62: C ******************************************************************00590307 ! 63: C 00600307 ! 64: C 00610307 ! 65: IMPLICIT LOGICAL (L) 00620307 ! 66: IMPLICIT CHARACTER*14 (C) 00630307 ! 67: C 00640307 ! 68: DIMENSION IAON11(4) 00650307 ! 69: DIMENSION RAON11(4) 00660307 ! 70: DATA PI/3.141592654/ 00670307 ! 71: C 00680307 ! 72: C 00690307 ! 73: C 00700307 ! 74: C INITIALIZATION SECTION. 00710307 ! 75: C 00720307 ! 76: C INITIALIZE CONSTANTS 00730307 ! 77: C ******************** 00740307 ! 78: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00750307 ! 79: I01 = 5 00760307 ! 80: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00770307 ! 81: I02 = 6 00780307 ! 82: C SYSTEM ENVIRONMENT SECTION 00790307 ! 83: C 00800307 ! 84: I01 = 5 00810307 ! 85: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820307 ! 86: C (UNIT NUMBER FOR CARD READER). 00830307 ! 87: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00840307 ! 88: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850307 ! 89: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860307 ! 90: C 00870307 ! 91: I02 = 6 00880307 ! 92: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890307 ! 93: C (UNIT NUMBER FOR PRINTER). 00900307 ! 94: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00910307 ! 95: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920307 ! 96: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930307 ! 97: C 00940307 ! 98: IVPASS = 0 00950307 ! 99: IVFAIL = 0 00960307 ! 100: IVDELE = 0 00970307 ! 101: ICZERO = 0 00980307 ! 102: C 00990307 ! 103: C WRITE OUT PAGE HEADERS 01000307 ! 104: C 01010307 ! 105: WRITE (I02,90002) 01020307 ! 106: WRITE (I02,90006) 01030307 ! 107: WRITE (I02,90008) 01040307 ! 108: WRITE (I02,90004) 01050307 ! 109: WRITE (I02,90010) 01060307 ! 110: WRITE (I02,90004) 01070307 ! 111: WRITE (I02,90016) 01080307 ! 112: WRITE (I02,90001) 01090307 ! 113: WRITE (I02,90004) 01100307 ! 114: WRITE (I02,90012) 01110307 ! 115: WRITE (I02,90014) 01120307 ! 116: WRITE (I02,90004) 01130307 ! 117: C 01140307 ! 118: C 01150307 ! 119: C TEST 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR 01160307 ! 120: C TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE 01170307 ! 121: C ARGUMENT IS INTEGER. 01180307 ! 122: C 01190307 ! 123: C 01200307 ! 124: C **** FCVS PROGRAM 307 - TEST 001 **** 01210307 ! 125: C 01220307 ! 126: C CONSTANT ARGUMENT 01230307 ! 127: C 01240307 ! 128: IVTNUM = 1 01250307 ! 129: IF (ICZERO) 30010, 0010, 30010 01260307 ! 130: 0010 CONTINUE 01270307 ! 131: RVCOMP = 10.0 01280307 ! 132: RVCOMP = REAL (6) 01290307 ! 133: RVCORR = 6.0 01300307 ! 134: 40010 IF (RVCOMP - 5.9995) 20010,10010,40011 01310307 ! 135: 40011 IF (RVCOMP - 6.0005) 10010,10010,20010 01320307 ! 136: 30010 IVDELE = IVDELE + 1 01330307 ! 137: WRITE (I02,80000) IVTNUM 01340307 ! 138: IF (ICZERO) 10010, 0021, 20010 01350307 ! 139: 10010 IVPASS = IVPASS + 1 01360307 ! 140: WRITE (I02,80002) IVTNUM 01370307 ! 141: GO TO 0021 01380307 ! 142: 20010 IVFAIL = IVFAIL + 1 01390307 ! 143: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01400307 ! 144: 0021 CONTINUE 01410307 ! 145: C 01420307 ! 146: C **** FCVS PROGRAM 307 - TEST 002 **** 01430307 ! 147: C 01440307 ! 148: C VARIABLE ARGUMENT 01450307 ! 149: C 01460307 ! 150: IVTNUM = 2 01470307 ! 151: IF (ICZERO) 30020, 0020, 30020 01480307 ! 152: 0020 CONTINUE 01490307 ! 153: RVCOMP = 10.0 01500307 ! 154: IVON01 = 6 01510307 ! 155: RVCOMP = REAL (IVON01) 01520307 ! 156: RVCORR = 6.0 01530307 ! 157: 40020 IF (RVCOMP - 5.9995) 20020,10020,40021 01540307 ! 158: 40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020 01550307 ! 159: 30020 IVDELE = IVDELE + 1 01560307 ! 160: WRITE (I02,80000) IVTNUM 01570307 ! 161: IF (ICZERO) 10020, 0031, 20020 01580307 ! 162: 10020 IVPASS = IVPASS + 1 01590307 ! 163: WRITE (I02,80002) IVTNUM 01600307 ! 164: GO TO 0031 01610307 ! 165: 20020 IVFAIL = IVFAIL + 1 01620307 ! 166: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01630307 ! 167: 0031 CONTINUE 01640307 ! 168: C 01650307 ! 169: C **** FCVS PROGRAM 307 - TEST 003 **** 01660307 ! 170: C 01670307 ! 171: C ARRAY ELEMENT NAME ARGUMENT 01680307 ! 172: C 01690307 ! 173: IVTNUM = 3 01700307 ! 174: IF (ICZERO) 30030, 0030, 30030 01710307 ! 175: 0030 CONTINUE 01720307 ! 176: RVCOMP = 10.0 01730307 ! 177: IAON11(3) = 6 01740307 ! 178: RVCOMP = REAL (IAON11(3)) 01750307 ! 179: RVCORR = 6.0 01760307 ! 180: 40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031 01770307 ! 181: 40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030 01780307 ! 182: 30030 IVDELE = IVDELE + 1 01790307 ! 183: WRITE (I02,80000) IVTNUM 01800307 ! 184: IF (ICZERO) 10030, 0041, 20030 01810307 ! 185: 10030 IVPASS = IVPASS + 1 01820307 ! 186: WRITE (I02,80002) IVTNUM 01830307 ! 187: GO TO 0041 01840307 ! 188: 20030 IVFAIL = IVFAIL + 1 01850307 ! 189: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01860307 ! 190: 0041 CONTINUE 01870307 ! 191: C 01880307 ! 192: C **** FCVS PROGRAM 307 - TEST 004 **** 01890307 ! 193: C 01900307 ! 194: C EXPRESSION AS ARGUMENT 01910307 ! 195: C 01920307 ! 196: IVTNUM = 4 01930307 ! 197: IF (ICZERO) 30040, 0040, 30040 01940307 ! 198: 0040 CONTINUE 01950307 ! 199: RVCOMP = 10.0 01960307 ! 200: IVON01 = 6 01970307 ! 201: RVCOMP = REAL (IVON01 - 6) 01980307 ! 202: RVCORR = 0.0 01990307 ! 203: 40040 IF(RVCOMP + .00005) 20040, 10040, 40041 02000307 ! 204: 40041 IF(RVCOMP - .00005) 10040, 10040, 20040 02010307 ! 205: 30040 IVDELE = IVDELE + 1 02020307 ! 206: WRITE (I02,80000) IVTNUM 02030307 ! 207: IF (ICZERO) 10040, 0051, 20040 02040307 ! 208: 10040 IVPASS = IVPASS + 1 02050307 ! 209: WRITE (I02,80002) IVTNUM 02060307 ! 210: GO TO 0051 02070307 ! 211: 20040 IVFAIL = IVFAIL + 1 02080307 ! 212: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090307 ! 213: 0051 CONTINUE 02100307 ! 214: C 02110307 ! 215: C TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR 02120307 ! 216: C FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND 02130307 ! 217: C ARGUMENT TYPES ARE BOTH REAL. 02140307 ! 218: C 02150307 ! 219: C 02160307 ! 220: C **** FCVS PROGRAM 307 - TEST 005 **** 02170307 ! 221: C 02180307 ! 222: C CONSTANT ARGUMENT 02190307 ! 223: C 02200307 ! 224: IVTNUM = 5 02210307 ! 225: IF (ICZERO) 30050, 0050, 30050 02220307 ! 226: 0050 CONTINUE 02230307 ! 227: RVCOMP = 10.0 02240307 ! 228: RVCOMP = ANINT (3.4994) 02250307 ! 229: RVCORR = 3.0 02260307 ! 230: 40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051 02270307 ! 231: 40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050 02280307 ! 232: 30050 IVDELE = IVDELE + 1 02290307 ! 233: WRITE (I02,80000) IVTNUM 02300307 ! 234: IF (ICZERO) 10050, 0061, 20050 02310307 ! 235: 10050 IVPASS = IVPASS + 1 02320307 ! 236: WRITE (I02,80002) IVTNUM 02330307 ! 237: GO TO 0061 02340307 ! 238: 20050 IVFAIL = IVFAIL + 1 02350307 ! 239: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02360307 ! 240: 0061 CONTINUE 02370307 ! 241: C 02380307 ! 242: C **** FCVS PROGRAM 307 - TEST 006 **** 02390307 ! 243: C 02400307 ! 244: C VARIABLE ARGUMENT 02410307 ! 245: C 02420307 ! 246: IVTNUM = 6 02430307 ! 247: IF (ICZERO) 30060, 0060, 30060 02440307 ! 248: 0060 CONTINUE 02450307 ! 249: RVCOMP = 10.0 02460307 ! 250: RVON01 = -3.4994 02470307 ! 251: RVCOMP = ANINT (RVON01) 02480307 ! 252: RVCORR = -3.0 02490307 ! 253: 40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061 02500307 ! 254: 40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060 02510307 ! 255: 30060 IVDELE = IVDELE + 1 02520307 ! 256: WRITE (I02,80000) IVTNUM 02530307 ! 257: IF (ICZERO) 10060, 0071, 20060 02540307 ! 258: 10060 IVPASS = IVPASS + 1 02550307 ! 259: WRITE (I02,80002) IVTNUM 02560307 ! 260: GO TO 0071 02570307 ! 261: 20060 IVFAIL = IVFAIL + 1 02580307 ! 262: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02590307 ! 263: 0071 CONTINUE 02600307 ! 264: C 02610307 ! 265: C **** FCVS PROGRAM 307 - TEST 007 **** 02620307 ! 266: C 02630307 ! 267: C ARRAY ELEMENT NAME ARGUMENT 02640307 ! 268: C 02650307 ! 269: IVTNUM = 7 02660307 ! 270: IF (ICZERO) 30070, 0070, 30070 02670307 ! 271: 0070 CONTINUE 02680307 ! 272: RVCOMP = 10.0 02690307 ! 273: RAON11(3) = 3.0000 02700307 ! 274: RVCOMP = ANINT (RAON11(3)) 02710307 ! 275: RVCORR = 3.0 02720307 ! 276: 40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071 02730307 ! 277: 40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070 02740307 ! 278: 30070 IVDELE = IVDELE + 1 02750307 ! 279: WRITE (I02,80000) IVTNUM 02760307 ! 280: IF (ICZERO) 10070, 0081, 20070 02770307 ! 281: 10070 IVPASS = IVPASS + 1 02780307 ! 282: WRITE (I02,80002) IVTNUM 02790307 ! 283: GO TO 0081 02800307 ! 284: 20070 IVFAIL = IVFAIL + 1 02810307 ! 285: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02820307 ! 286: 0081 CONTINUE 02830307 ! 287: C 02840307 ! 288: C **** FCVS PROGRAM 307 - TEST 008 **** 02850307 ! 289: C 02860307 ! 290: C ZERO ARGUMENT 02870307 ! 291: C 02880307 ! 292: IVTNUM = 8 02890307 ! 293: IF (ICZERO) 30080, 0080, 30080 02900307 ! 294: 0080 CONTINUE 02910307 ! 295: RVCOMP = 10.0 02920307 ! 296: RVCOMP = ANINT (0.0) 02930307 ! 297: RVCORR = 0.0 02940307 ! 298: 40080 IF (RVCOMP) 20080, 10080, 20080 02950307 ! 299: 30080 IVDELE = IVDELE + 1 02960307 ! 300: WRITE (I02,80000) IVTNUM 02970307 ! 301: IF (ICZERO) 10080, 0091, 20080 02980307 ! 302: 10080 IVPASS = IVPASS + 1 02990307 ! 303: WRITE (I02,80002) IVTNUM 03000307 ! 304: GO TO 0091 03010307 ! 305: 20080 IVFAIL = IVFAIL + 1 03020307 ! 306: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03030307 ! 307: 0091 CONTINUE 03040307 ! 308: C 03050307 ! 309: C TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR 03060307 ! 310: C FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL 03070307 ! 311: C AND THE FUNCTION TYPE IS INTEGER. 03080307 ! 312: C 03090307 ! 313: C 03100307 ! 314: C **** FCVS PROGRAM 307 - TEST 009 **** 03110307 ! 315: C 03120307 ! 316: C CONSTANT ARGUMENT 03130307 ! 317: C 03140307 ! 318: IVTNUM = 9 03150307 ! 319: IF (ICZERO) 30090, 0090, 30090 03160307 ! 320: 0090 CONTINUE 03170307 ! 321: IVCOMP = 10 03180307 ! 322: IVCOMP = NINT (3.4994) 03190307 ! 323: IVCORR = 3 03200307 ! 324: 40090 IF (IVCOMP - 3) 20090, 10090, 20090 03210307 ! 325: 30090 IVDELE = IVDELE + 1 03220307 ! 326: WRITE (I02,80000) IVTNUM 03230307 ! 327: IF (ICZERO) 10090, 0101, 20090 03240307 ! 328: 10090 IVPASS = IVPASS + 1 03250307 ! 329: WRITE (I02,80002) IVTNUM 03260307 ! 330: GO TO 0101 03270307 ! 331: 20090 IVFAIL = IVFAIL + 1 03280307 ! 332: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03290307 ! 333: 0101 CONTINUE 03300307 ! 334: C 03310307 ! 335: C **** FCVS PROGRAM 307 - TEST 010 **** 03320307 ! 336: C 03330307 ! 337: C VARIABLE ARGUMENT 03340307 ! 338: C 03350307 ! 339: IVTNUM = 10 03360307 ! 340: IF (ICZERO) 30100, 0100, 30100 03370307 ! 341: 0100 CONTINUE 03380307 ! 342: IVCOMP = 10 03390307 ! 343: RVON01 = -3.4994 03400307 ! 344: IVCOMP = NINT (RVON01) 03410307 ! 345: IVCORR = -3 03420307 ! 346: 40100 IF (IVCOMP +3) 20100, 10100, 20100 03430307 ! 347: 30100 IVDELE = IVDELE + 1 03440307 ! 348: WRITE (I02,80000) IVTNUM 03450307 ! 349: IF (ICZERO) 10100, 0111, 20100 03460307 ! 350: 10100 IVPASS = IVPASS + 1 03470307 ! 351: WRITE (I02,80002) IVTNUM 03480307 ! 352: GO TO 0111 03490307 ! 353: 20100 IVFAIL = IVFAIL + 1 03500307 ! 354: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03510307 ! 355: 0111 CONTINUE 03520307 ! 356: C 03530307 ! 357: C **** FCVS PROGRAM 307 - TEST 011 **** 03540307 ! 358: C 03550307 ! 359: C ARRAY ELEMENT NAME ARGUMENT 03560307 ! 360: C 03570307 ! 361: IVTNUM = 11 03580307 ! 362: IF (ICZERO) 30110, 0110, 30110 03590307 ! 363: 0110 CONTINUE 03600307 ! 364: IVCOMP = 10 03610307 ! 365: RAON11(1) = 3.0000 03620307 ! 366: IVCOMP = NINT (RAON11(1)) 03630307 ! 367: IVCORR = 3 03640307 ! 368: 40110 IF (IVCOMP -3) 20110, 10110, 20110 03650307 ! 369: 30110 IVDELE = IVDELE + 1 03660307 ! 370: WRITE (I02,80000) IVTNUM 03670307 ! 371: IF (ICZERO) 10110, 0121, 20110 03680307 ! 372: 10110 IVPASS = IVPASS + 1 03690307 ! 373: WRITE (I02,80002) IVTNUM 03700307 ! 374: GO TO 0121 03710307 ! 375: 20110 IVFAIL = IVFAIL + 1 03720307 ! 376: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03730307 ! 377: 0121 CONTINUE 03740307 ! 378: C 03750307 ! 379: C **** FCVS PROGRAM 307 - TEST 012 **** 03760307 ! 380: C 03770307 ! 381: C ZERO ARGUMENT 03780307 ! 382: C 03790307 ! 383: IVTNUM = 12 03800307 ! 384: IF (ICZERO) 30120, 0120, 30120 03810307 ! 385: 0120 CONTINUE 03820307 ! 386: IVCOMP = 10 03830307 ! 387: IVCOMP = NINT (0.0) 03840307 ! 388: IVCORR = 0 03850307 ! 389: 40120 IF (IVCOMP) 20120, 10120, 20120 03860307 ! 390: 30120 IVDELE = IVDELE + 1 03870307 ! 391: WRITE (I02,80000) IVTNUM 03880307 ! 392: IF (ICZERO) 10120, 0131, 20120 03890307 ! 393: 10120 IVPASS = IVPASS + 1 03900307 ! 394: WRITE (I02,80002) IVTNUM 03910307 ! 395: GO TO 0131 03920307 ! 396: 20120 IVFAIL = IVFAIL + 1 03930307 ! 397: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03940307 ! 398: 0131 CONTINUE 03950307 ! 399: C 03960307 ! 400: C TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR 03970307 ! 401: C FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND 03980307 ! 402: C ARGUMENT TYPES ARE BOTH REAL. ALL ARGUMENTS ARE GIVEN IN RADIANS 03990307 ! 403: C WHERE ONE RADIAN EQUALS 57.296 DEGREES. 04000307 ! 404: C 04010307 ! 405: C 04020307 ! 406: C **** FCVS PROGRAM 307 - TEST 013 **** 04030307 ! 407: C 04040307 ! 408: C FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS) 04050307 ! 409: C 04060307 ! 410: IVTNUM = 13 04070307 ! 411: IF (ICZERO) 30130, 0130, 30130 04080307 ! 412: 0130 CONTINUE 04090307 ! 413: RVCOMP = 10.0 04100307 ! 414: RVCOMP = TAN (0.0) 04110307 ! 415: RVCORR = 0.0 04120307 ! 416: 40130 IF (RVCOMP) 20130, 10130, 20130 04130307 ! 417: 30130 IVDELE = IVDELE + 1 04140307 ! 418: WRITE (I02,80000) IVTNUM 04150307 ! 419: IF (ICZERO) 10130, 0141, 20130 04160307 ! 420: 10130 IVPASS = IVPASS + 1 04170307 ! 421: WRITE (I02,80002) IVTNUM 04180307 ! 422: GO TO 0141 04190307 ! 423: 20130 IVFAIL = IVFAIL + 1 04200307 ! 424: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04210307 ! 425: 0141 CONTINUE 04220307 ! 426: C 04230307 ! 427: C **** FCVS PROGRAM 307 - TEST 014 **** 04240307 ! 428: C 04250307 ! 429: C FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS) 04260307 ! 430: C 04270307 ! 431: IVTNUM = 14 04280307 ! 432: IF (ICZERO) 30140, 0140, 30140 04290307 ! 433: 0140 CONTINUE 04300307 ! 434: RVCOMP = 10.0 04310307 ! 435: RVON01 = 3 * PI / 4 04320307 ! 436: RVCOMP = TAN (RVON01) 04330307 ! 437: RVCORR = -1.0 04340307 ! 438: 40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141 04350307 ! 439: 40141 IF (RVCOMP + .9995) 10140, 10140, 20140 04360307 ! 440: 30140 IVDELE = IVDELE + 1 04370307 ! 441: WRITE (I02,80000) IVTNUM 04380307 ! 442: IF (ICZERO) 10140, 0151, 20140 04390307 ! 443: 10140 IVPASS = IVPASS + 1 04400307 ! 444: WRITE (I02,80002) IVTNUM 04410307 ! 445: GO TO 0151 04420307 ! 446: 20140 IVFAIL = IVFAIL + 1 04430307 ! 447: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04440307 ! 448: 0151 CONTINUE 04450307 ! 449: C 04460307 ! 450: C **** FCVS PROGRAM 307 - TEST 015 **** 04470307 ! 451: C 04480307 ! 452: C FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS) 04490307 ! 453: C 04500307 ! 454: IVTNUM = 15 04510307 ! 455: IF (ICZERO) 30150, 0150, 30150 04520307 ! 456: 0150 CONTINUE 04530307 ! 457: RVCOMP = 10.0 04540307 ! 458: RAON11(2) = 3 * PI 04550307 ! 459: RVCOMP = TAN (RAON11(2)) 04560307 ! 460: RVCORR = 0.0 04570307 ! 461: 40150 IF (RVCOMP + .00005) 20150, 10150, 40151 04580307 ! 462: 40151 IF (RVCOMP - .00005) 10150, 10150, 20150 04590307 ! 463: 30150 IVDELE = IVDELE + 1 04600307 ! 464: WRITE (I02,80000) IVTNUM 04610307 ! 465: IF (ICZERO) 10150, 0161, 20150 04620307 ! 466: 10150 IVPASS = IVPASS + 1 04630307 ! 467: WRITE (I02,80002) IVTNUM 04640307 ! 468: GO TO 0161 04650307 ! 469: 20150 IVFAIL = IVFAIL + 1 04660307 ! 470: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04670307 ! 471: 0161 CONTINUE 04680307 ! 472: C 04690307 ! 473: C **** FCVS PROGRAM 307 - TEST 016 **** 04700307 ! 474: C 04710307 ! 475: C FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS) 04720307 ! 476: C 04730307 ! 477: IVTNUM = 16 04740307 ! 478: IF (ICZERO) 30160, 0160, 30160 04750307 ! 479: 0160 CONTINUE 04760307 ! 480: RVCOMP = 10.0 04770307 ! 481: RVON01 = PI/6 04780307 ! 482: RVCOMP = TAN (RVON01) 04790307 ! 483: RVCORR = .57735 04800307 ! 484: 40160 IF (RVCOMP - .57730) 20160, 10160, 40161 04810307 ! 485: 40161 IF (RVCOMP - .57740) 10160, 10160, 20160 04820307 ! 486: 30160 IVDELE = IVDELE + 1 04830307 ! 487: WRITE (I02,80000) IVTNUM 04840307 ! 488: IF (ICZERO) 10160, 0171, 20160 04850307 ! 489: 10160 IVPASS = IVPASS + 1 04860307 ! 490: WRITE (I02,80002) IVTNUM 04870307 ! 491: GO TO 0171 04880307 ! 492: 20160 IVFAIL = IVFAIL + 1 04890307 ! 493: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04900307 ! 494: 0171 CONTINUE 04910307 ! 495: C 04920307 ! 496: C **** FCVS PROGRAM 307 - TEST 017 **** 04930307 ! 497: C 04940307 ! 498: C FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES 04950307 ! 499: C BY THE COSINE OF 30 DEGREES. 04960307 ! 500: C 04970307 ! 501: IVTNUM = 17 04980307 ! 502: IF (ICZERO) 30170, 0170, 30170 04990307 ! 503: 0170 CONTINUE 05000307 ! 504: RVCOMP = 10.0 05010307 ! 505: RVON01 = PI/6 05020307 ! 506: RVCOMP = SIN(RVON01)/COS(RVON01) 05030307 ! 507: RVCORR = .57735 05040307 ! 508: 40170 IF (RVCOMP - .57730) 20170, 10170, 40171 05050307 ! 509: 40171 IF (RVCOMP - .57740) 10170, 10170, 20170 05060307 ! 510: 30170 IVDELE = IVDELE + 1 05070307 ! 511: WRITE (I02,80000) IVTNUM 05080307 ! 512: IF (ICZERO) 10170, 0181, 20170 05090307 ! 513: 10170 IVPASS = IVPASS + 1 05100307 ! 514: WRITE (I02,80002) IVTNUM 05110307 ! 515: GO TO 0181 05120307 ! 516: 20170 IVFAIL = IVFAIL + 1 05130307 ! 517: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140307 ! 518: 0181 CONTINUE 05150307 ! 519: C 05160307 ! 520: C TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR 05170307 ! 521: C FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND 05180307 ! 522: C ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES OF ALL 05190307 ! 523: C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 05200307 ! 524: C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 05210307 ! 525: C 05220307 ! 526: C 05230307 ! 527: C **** FCVS PROGRAM 307 - TEST 018 **** 05240307 ! 528: C 05250307 ! 529: C THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS) 05260307 ! 530: C 05270307 ! 531: IVTNUM = 18 05280307 ! 532: IF (ICZERO) 30180, 0180, 30180 05290307 ! 533: 0180 CONTINUE 05300307 ! 534: RVCOMP = 10.0 05310307 ! 535: RVCOMP = ASIN (+1.0) 05320307 ! 536: RVCORR = 1.5708 05330307 ! 537: 40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181 05340307 ! 538: 40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180 05350307 ! 539: 30180 IVDELE = IVDELE + 1 05360307 ! 540: WRITE (I02,80000) IVTNUM 05370307 ! 541: IF (ICZERO) 10180, 0191, 20180 05380307 ! 542: 10180 IVPASS = IVPASS + 1 05390307 ! 543: WRITE (I02,80002) IVTNUM 05400307 ! 544: GO TO 0191 05410307 ! 545: 20180 IVFAIL = IVFAIL + 1 05420307 ! 546: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05430307 ! 547: 0191 CONTINUE 05440307 ! 548: C 05450307 ! 549: C **** FCVS PROGRAM 307 - TEST 019 **** 05460307 ! 550: C 05470307 ! 551: C THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS) 05480307 ! 552: C 05490307 ! 553: IVTNUM = 19 05500307 ! 554: IF (ICZERO) 30190, 0190, 30190 05510307 ! 555: 0190 CONTINUE 05520307 ! 556: RVCOMP = 10.0 05530307 ! 557: RVON01 = -1.0 05540307 ! 558: RVCOMP = ASIN(RVON01) 05550307 ! 559: RVCORR = -1.5708 05560307 ! 560: 40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191 05570307 ! 561: 40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190 05580307 ! 562: 30190 IVDELE = IVDELE + 1 05590307 ! 563: WRITE (I02,80000) IVTNUM 05600307 ! 564: IF (ICZERO) 10190, 0201, 20190 05610307 ! 565: 10190 IVPASS = IVPASS + 1 05620307 ! 566: WRITE (I02,80002) IVTNUM 05630307 ! 567: GO TO 0201 05640307 ! 568: 20190 IVFAIL = IVFAIL + 1 05650307 ! 569: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05660307 ! 570: 0201 CONTINUE 05670307 ! 571: C 05680307 ! 572: C **** FCVS PROGRAM 307 - TEST 020 **** 05690307 ! 573: C 05700307 ! 574: C THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS) 05710307 ! 575: C 05720307 ! 576: IVTNUM = 20 05730307 ! 577: IF (ICZERO) 30200, 0200, 30200 05740307 ! 578: 0200 CONTINUE 05750307 ! 579: RVCOMP = 10.0 05760307 ! 580: RAON11(1) = -.5 05770307 ! 581: RVCOMP = ASIN (RAON11(1)) 05780307 ! 582: RVCORR = -.52360 05790307 ! 583: 40200 IF (RVCOMP + .52365) 20200, 10200, 40201 05800307 ! 584: 40201 IF (RVCOMP + .52355) 10200, 10200, 20200 05810307 ! 585: 30200 IVDELE = IVDELE + 1 05820307 ! 586: WRITE (I02,80000) IVTNUM 05830307 ! 587: IF (ICZERO) 10200, 0211, 20200 05840307 ! 588: 10200 IVPASS = IVPASS + 1 05850307 ! 589: WRITE (I02,80002) IVTNUM 05860307 ! 590: GO TO 0211 05870307 ! 591: 20200 IVFAIL = IVFAIL + 1 05880307 ! 592: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05890307 ! 593: 0211 CONTINUE 05900307 ! 594: C 05910307 ! 595: C **** FCVS PROGRAM 307 - TEST 021 **** 05920307 ! 596: C 05930307 ! 597: C THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS) 05940307 ! 598: C 05950307 ! 599: IVTNUM = 21 05960307 ! 600: IF (ICZERO) 30210, 0210, 30210 05970307 ! 601: 0210 CONTINUE 05980307 ! 602: RVCOMP = 10.0 05990307 ! 603: RVON01 = 0.0 06000307 ! 604: RVCOMP = ASIN (RVON01) 06010307 ! 605: RVCORR = 0.0 06020307 ! 606: 40210 IF (RVCOMP) 20210, 10210, 20210 06030307 ! 607: 30210 IVDELE = IVDELE + 1 06040307 ! 608: WRITE (I02,80000) IVTNUM 06050307 ! 609: IF (ICZERO) 10210, 0221, 20210 06060307 ! 610: 10210 IVPASS = IVPASS + 1 06070307 ! 611: WRITE (I02,80002) IVTNUM 06080307 ! 612: GO TO 0221 06090307 ! 613: 20210 IVFAIL = IVFAIL + 1 06100307 ! 614: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06110307 ! 615: 0221 CONTINUE 06120307 ! 616: C 06130307 ! 617: C TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR 06140307 ! 618: C FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION 06150307 ! 619: C AND ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES ALL 06160307 ! 620: C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 06170307 ! 621: C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 06180307 ! 622: C 06190307 ! 623: C 06200307 ! 624: C **** FCVS PROGRAM 307 - TEST 022 **** 06210307 ! 625: C 06220307 ! 626: C THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS) 06230307 ! 627: C 06240307 ! 628: IVTNUM = 22 06250307 ! 629: IF (ICZERO) 30220, 0220, 30220 06260307 ! 630: 0220 CONTINUE 06270307 ! 631: RVCOMP = 10.0 06280307 ! 632: RVCOMP = ACOS(+1.) 06290307 ! 633: RVCORR = 0.0 06300307 ! 634: 40220 IF (RVCOMP + .00005) 20220, 10220, 40221 06310307 ! 635: 40221 IF (RVCOMP - .00005) 10220, 10220, 20220 06320307 ! 636: 30220 IVDELE = IVDELE + 1 06330307 ! 637: WRITE (I02,80000) IVTNUM 06340307 ! 638: IF (ICZERO) 10220, 0231, 20220 06350307 ! 639: 10220 IVPASS = IVPASS + 1 06360307 ! 640: WRITE (I02,80002) IVTNUM 06370307 ! 641: GO TO 0231 06380307 ! 642: 20220 IVFAIL = IVFAIL + 1 06390307 ! 643: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06400307 ! 644: 0231 CONTINUE 06410307 ! 645: C 06420307 ! 646: C **** FCVS PROGRAM 307 - TEST 023 **** 06430307 ! 647: C 06440307 ! 648: C THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS) 06450307 ! 649: C 06460307 ! 650: IVTNUM = 23 06470307 ! 651: IF (ICZERO) 30230, 0230, 30230 06480307 ! 652: 0230 CONTINUE 06490307 ! 653: RVCOMP = 10.0 06500307 ! 654: RVON01 = -1.0 06510307 ! 655: RVCOMP = ACOS (RVON01) 06520307 ! 656: RVCORR = 3.1416 06530307 ! 657: 40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231 06540307 ! 658: 40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230 06550307 ! 659: 30230 IVDELE = IVDELE + 1 06560307 ! 660: WRITE (I02,80000) IVTNUM 06570307 ! 661: IF (ICZERO) 10230, 0241, 20230 06580307 ! 662: 10230 IVPASS = IVPASS + 1 06590307 ! 663: WRITE (I02,80002) IVTNUM 06600307 ! 664: GO TO 0241 06610307 ! 665: 20230 IVFAIL = IVFAIL + 1 06620307 ! 666: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06630307 ! 667: 0241 CONTINUE 06640307 ! 668: C 06650307 ! 669: C **** FCVS PROGRAM 307 - TEST 024 **** 06660307 ! 670: C 06670307 ! 671: C THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS) 06680307 ! 672: C 06690307 ! 673: IVTNUM = 24 06700307 ! 674: IF (ICZERO) 30240, 0240, 30240 06710307 ! 675: 0240 CONTINUE 06720307 ! 676: RVCOMP = 10.0 06730307 ! 677: RAON11(1) = -.5 06740307 ! 678: RVCOMP = ACOS (RAON11(1)) 06750307 ! 679: RVCORR = 2.0944 06760307 ! 680: 40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241 06770307 ! 681: 40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240 06780307 ! 682: 30240 IVDELE = IVDELE + 1 06790307 ! 683: WRITE (I02,80000) IVTNUM 06800307 ! 684: IF (ICZERO) 10240, 0251, 20240 06810307 ! 685: 10240 IVPASS = IVPASS + 1 06820307 ! 686: WRITE (I02,80002) IVTNUM 06830307 ! 687: GO TO 0251 06840307 ! 688: 20240 IVFAIL = IVFAIL + 1 06850307 ! 689: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06860307 ! 690: 0251 CONTINUE 06870307 ! 691: C 06880307 ! 692: C **** FCVS PROGRAM 307 - TEST 025 **** 06890307 ! 693: C 06900307 ! 694: C THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS) 06910307 ! 695: C 06920307 ! 696: IVTNUM = 25 06930307 ! 697: IF (ICZERO) 30250, 0250, 30250 06940307 ! 698: 0250 CONTINUE 06950307 ! 699: RVCOMP = 10.0 06960307 ! 700: RVCOMP = ACOS (0.) 06970307 ! 701: RVCORR = 1.5708 06980307 ! 702: 40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251 06990307 ! 703: 40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250 07000307 ! 704: 30250 IVDELE = IVDELE + 1 07010307 ! 705: WRITE (I02,80000) IVTNUM 07020307 ! 706: IF (ICZERO) 10250, 0261, 20250 07030307 ! 707: 10250 IVPASS = IVPASS + 1 07040307 ! 708: WRITE (I02,80002) IVTNUM 07050307 ! 709: GO TO 0261 07060307 ! 710: 20250 IVFAIL = IVFAIL + 1 07070307 ! 711: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07080307 ! 712: 0261 CONTINUE 07090307 ! 713: C 07100307 ! 714: C TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR 07110307 ! 715: C FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND 07120307 ! 716: C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE 07130307 ! 717: C TESTED. 07140307 ! 718: C 07150307 ! 719: C 07160307 ! 720: C **** FCVS PROGRAM 307 - TEST 026 **** 07170307 ! 721: C 07180307 ! 722: C CONSTANT ARGUMENT 07190307 ! 723: C 07200307 ! 724: IVTNUM = 26 07210307 ! 725: IF (ICZERO) 30260, 0260, 30260 07220307 ! 726: 0260 CONTINUE 07230307 ! 727: RVCOMP = 10.0 07240307 ! 728: RVCOMP = SINH (0.0) 07250307 ! 729: RVCORR = 0.0 07260307 ! 730: 40260 IF (RVCOMP + .00005) 20260, 10260, 40261 07270307 ! 731: 40261 IF (RVCOMP - .00005) 10260, 10260, 20260 07280307 ! 732: 30260 IVDELE = IVDELE + 1 07290307 ! 733: WRITE (I02,80000) IVTNUM 07300307 ! 734: IF (ICZERO) 10260, 0271, 20260 07310307 ! 735: 10260 IVPASS = IVPASS + 1 07320307 ! 736: WRITE (I02,80002) IVTNUM 07330307 ! 737: GO TO 0271 07340307 ! 738: 20260 IVFAIL = IVFAIL + 1 07350307 ! 739: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07360307 ! 740: 0271 CONTINUE 07370307 ! 741: C 07380307 ! 742: C **** FCVS PROGRAM 307 - TEST 027 **** 07390307 ! 743: C 07400307 ! 744: C VARIABLE ARGUMENT 07410307 ! 745: C 07420307 ! 746: IVTNUM = 27 07430307 ! 747: IF (ICZERO) 30270, 0270, 30270 07440307 ! 748: 0270 CONTINUE 07450307 ! 749: RVCOMP =10.0 07460307 ! 750: RVON01 = 2.0 07470307 ! 751: RVCOMP = SINH (RVON01) 07480307 ! 752: RVCORR = 3.6269 07490307 ! 753: 40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271 07500307 ! 754: 40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270 07510307 ! 755: 30270 IVDELE = IVDELE + 1 07520307 ! 756: WRITE (I02,80000) IVTNUM 07530307 ! 757: IF (ICZERO) 10270, 0281, 20270 07540307 ! 758: 10270 IVPASS = IVPASS + 1 07550307 ! 759: WRITE (I02,80002) IVTNUM 07560307 ! 760: GO TO 0281 07570307 ! 761: 20270 IVFAIL = IVFAIL + 1 07580307 ! 762: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07590307 ! 763: 0281 CONTINUE 07600307 ! 764: C 07610307 ! 765: C **** FCVS PROGRAM 307 - TEST 028 **** 07620307 ! 766: C 07630307 ! 767: C ARRAY ELEMENT NAME ARGUMENT 07640307 ! 768: C 07650307 ! 769: IVTNUM = 28 07660307 ! 770: IF (ICZERO) 30280, 0280, 30280 07670307 ! 771: 0280 CONTINUE 07680307 ! 772: RVCOMP = 10.0 07690307 ! 773: RAON11(1) = 6.0 07700307 ! 774: RVCOMP = SINH (RAON11(1)) 07710307 ! 775: RVCORR = 201.71 07720307 ! 776: 40280 IF (RVCOMP - 201.66) 20280, 10280, 40281 07730307 ! 777: 40281 IF (RVCOMP - 201.76) 10280, 10280, 20280 07740307 ! 778: 30280 IVDELE = IVDELE + 1 07750307 ! 779: WRITE (I02,80000) IVTNUM 07760307 ! 780: IF (ICZERO) 10280, 0291, 20280 07770307 ! 781: 10280 IVPASS = IVPASS + 1 07780307 ! 782: WRITE (I02,80002) IVTNUM 07790307 ! 783: GO TO 0291 07800307 ! 784: 20280 IVFAIL = IVFAIL + 1 07810307 ! 785: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07820307 ! 786: 0291 CONTINUE 07830307 ! 787: C 07840307 ! 788: C TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR 07850307 ! 789: C FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND 07860307 ! 790: C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE TESTED.07870307 ! 791: C 07880307 ! 792: C 07890307 ! 793: C **** FCVS PROGRAM 307 - TEST 029 **** 07900307 ! 794: C 07910307 ! 795: C CONSTANT ARGUMENT 07920307 ! 796: C 07930307 ! 797: IVTNUM = 29 07940307 ! 798: IF (ICZERO) 30290, 0290, 30290 07950307 ! 799: 0290 CONTINUE 07960307 ! 800: RVCOMP = 10.0 07970307 ! 801: RVCOMP = COSH (0.0) 07980307 ! 802: RVCORR = 1.0 07990307 ! 803: 40290 IF (RVCOMP - .9995) 20290, 10290, 40291 08000307 ! 804: 40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290 08010307 ! 805: 30290 IVDELE = IVDELE + 1 08020307 ! 806: WRITE (I02,80000) IVTNUM 08030307 ! 807: IF (ICZERO) 10290, 0301, 20290 08040307 ! 808: 10290 IVPASS = IVPASS + 1 08050307 ! 809: WRITE (I02,80002) IVTNUM 08060307 ! 810: GO TO 0301 08070307 ! 811: 20290 IVFAIL = IVFAIL + 1 08080307 ! 812: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08090307 ! 813: 0301 CONTINUE 08100307 ! 814: C 08110307 ! 815: C **** FCVS PROGRAM 307 - TEST 030 **** 08120307 ! 816: C 08130307 ! 817: C VARIABLE ARGUMENT 08140307 ! 818: C 08150307 ! 819: IVTNUM = 30 08160307 ! 820: IF (ICZERO) 30300, 0300, 30300 08170307 ! 821: 0300 CONTINUE 08180307 ! 822: RVCOMP = 10.0 08190307 ! 823: RVON01 = 2.0 08200307 ! 824: RVCOMP = COSH (RVON01) 08210307 ! 825: RVCORR = 3.7622 08220307 ! 826: 40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301 08230307 ! 827: 40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300 08240307 ! 828: 30300 IVDELE = IVDELE + 1 08250307 ! 829: WRITE (I02,80000) IVTNUM 08260307 ! 830: IF (ICZERO) 10300, 0311, 20300 08270307 ! 831: 10300 IVPASS = IVPASS + 1 08280307 ! 832: WRITE (I02,80002) IVTNUM 08290307 ! 833: GO TO 0311 08300307 ! 834: 20300 IVFAIL = IVFAIL + 1 08310307 ! 835: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08320307 ! 836: 0311 CONTINUE 08330307 ! 837: C 08340307 ! 838: C **** FCVS PROGRAM 307 - TEST 031 **** 08350307 ! 839: C 08360307 ! 840: C ARRAY ELEMENT NAME ARGUMENT 08370307 ! 841: C 08380307 ! 842: IVTNUM = 31 08390307 ! 843: IF (ICZERO) 30310, 0310, 30310 08400307 ! 844: 0310 CONTINUE 08410307 ! 845: RVCOMP = 10.0 08420307 ! 846: RAON11(2) = 6.0 08430307 ! 847: RVCOMP = COSH (RAON11(2)) 08440307 ! 848: RVCORR = 201.72 08450307 ! 849: 40310 IF (RVCOMP - 201.67) 20310, 10310, 40311 08460307 ! 850: 40311 IF (RVCOMP - 201.77) 10310, 10310, 20310 08470307 ! 851: 30310 IVDELE = IVDELE + 1 08480307 ! 852: WRITE (I02,80000) IVTNUM 08490307 ! 853: IF (ICZERO) 10310, 0321, 20310 08500307 ! 854: 10310 IVPASS = IVPASS + 1 08510307 ! 855: WRITE (I02,80002) IVTNUM 08520307 ! 856: GO TO 0321 08530307 ! 857: 20310 IVFAIL = IVFAIL + 1 08540307 ! 858: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08550307 ! 859: 0321 CONTINUE 08560307 ! 860: C 08570307 ! 861: C 08580307 ! 862: C WRITE OUT TEST SUMMARY 08590307 ! 863: C 08600307 ! 864: WRITE (I02,90004) 08610307 ! 865: WRITE (I02,90014) 08620307 ! 866: WRITE (I02,90004) 08630307 ! 867: WRITE (I02,90000) 08640307 ! 868: WRITE (I02,90004) 08650307 ! 869: WRITE (I02,90020) IVFAIL 08660307 ! 870: WRITE (I02,90022) IVPASS 08670307 ! 871: WRITE (I02,90024) IVDELE 08680307 ! 872: STOP 08690307 ! 873: 90001 FORMAT (1H ,24X,5HFM307) 08700307 ! 874: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM307) 08710307 ! 875: C 08720307 ! 876: C FORMATS FOR TEST DETAIL LINES 08730307 ! 877: C 08740307 ! 878: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 08750307 ! 879: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 08760307 ! 880: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 08770307 ! 881: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 08780307 ! 882: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 08790307 ! 883: C 08800307 ! 884: C FORMAT STATEMENTS FOR PAGE HEADERS 08810307 ! 885: C 08820307 ! 886: 90002 FORMAT (1H1) 08830307 ! 887: 90004 FORMAT (1H ) 08840307 ! 888: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08850307 ! 889: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 08860307 ! 890: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 08870307 ! 891: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 08880307 ! 892: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 08890307 ! 893: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 08900307 ! 894: C 08910307 ! 895: C FORMAT STATEMENTS FOR RUN SUMMARY 08920307 ! 896: C 08930307 ! 897: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 08940307 ! 898: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 08950307 ! 899: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 08960307 ! 900: END 08970307
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.