|
|
1.1 ! root 1: C***********************************************************************00010378 ! 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***** FORTRAN 77 00020378 ! 6: C***** FM378 00030378 ! 7: C***** XTANH - (199) 00040378 ! 8: C***** 00050378 ! 9: C***********************************************************************00060378 ! 10: C***** GENERAL PURPOSE SUBSET REF 00070378 ! 11: C***** TEST INTRINSIC FUNCTION TANH 15.3 00080378 ! 12: C***** TABLE 5 00090378 ! 13: C***** 00100378 ! 14: CBB** ********************** BBCCOMNT **********************************00110378 ! 15: C**** 00120378 ! 16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130378 ! 17: C**** VERSION 2.0 00140378 ! 18: C**** 00150378 ! 19: C**** 00160378 ! 20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170378 ! 21: C**** GENERAL SERVICES ADMINISTRATION 00180378 ! 22: C**** FEDERAL SOFTWARE TESTING CENTER 00190378 ! 23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200378 ! 24: C**** FALLS CHURCH, VA. 22041 00210378 ! 25: C**** 00220378 ! 26: C**** (703) 756-6153 00230378 ! 27: C**** 00240378 ! 28: CBE** ********************** BBCCOMNT **********************************00250378 ! 29: CBB** ********************** BBCINITA **********************************00260378 ! 30: C**** SPECIFICATION STATEMENTS 00270378 ! 31: C**** 00280378 ! 32: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290378 ! 33: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300378 ! 34: CBE** ********************** BBCINITA **********************************00310378 ! 35: CBB** ********************** BBCINITB **********************************00320378 ! 36: C**** INITIALIZE SECTION 00330378 ! 37: DATA ZVERS, ZVERSD, ZDATE 00340378 ! 38: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00350378 ! 39: DATA ZCOMPL, ZNAME, ZTAPE 00360378 ! 40: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370378 ! 41: DATA ZPROJ, ZTAPED, ZPROG 00380378 ! 42: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390378 ! 43: DATA REMRKS /' '/ 00400378 ! 44: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410378 ! 45: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420378 ! 46: C**** 00430378 ! 47: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440378 ! 48: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450378 ! 49: CZ03 ZPROG = 'PROGRAM NAME' 00460378 ! 50: ZDATE = '07-Nov-85 ' *RP ! 51: ZCOMPL = 'CCI 5.2 ' *RP ! 52: ZPROJ = 'TC-85- -410' *RP ! 53: ZNAME = ' ' *RP ! 54: ZTAPE = ' ' *RP ! 55: ZTAPED = '850703 ' *RP ! 56: C 00530378 ! 57: IVPASS = 0 00540378 ! 58: IVFAIL = 0 00550378 ! 59: IVDELE = 0 00560378 ! 60: IVINSP = 0 00570378 ! 61: IVTOTL = 0 00580378 ! 62: IVTOTN = 0 00590378 ! 63: ICZERO = 0 00600378 ! 64: C 00610378 ! 65: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620378 ! 66: I01 = 05 00630378 ! 67: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640378 ! 68: I02 = 06 00650378 ! 69: C 00660378 ! 70: I01 = 5 00670378 ! 71: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680378 ! 72: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690378 ! 73: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700378 ! 74: C 00710378 ! 75: I02 = 6 00720378 ! 76: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730378 ! 77: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740378 ! 78: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750378 ! 79: C 00760378 ! 80: CBE** ********************** BBCINITB **********************************00770378 ! 81: NUVI = I02 00780378 ! 82: IVTOTL = 9 00790378 ! 83: ZPROG = 'FM378' 00800378 ! 84: CBB** ********************** BBCHED0A **********************************00810378 ! 85: C**** 00820378 ! 86: C**** WRITE REPORT TITLE 00830378 ! 87: C**** 00840378 ! 88: WRITE (I02, 90002) 00850378 ! 89: WRITE (I02, 90006) 00860378 ! 90: WRITE (I02, 90007) 00870378 ! 91: WRITE (I02, 90008) ZVERS, ZVERSD 00880378 ! 92: WRITE (I02, 90009) ZPROG, ZPROG 00890378 ! 93: WRITE (I02, 90010) ZDATE, ZCOMPL 00900378 ! 94: CBE** ********************** BBCHED0A **********************************00910378 ! 95: C***** 00920378 ! 96: C***** HEADER FOR SEGMENT 199 00930378 ! 97: WRITE(NUVI,19900) 00940378 ! 98: 19900 FORMAT(1H , / 35H XTANH - (199) INTRINSIC FUNCTIONS// 00950378 ! 99: 1 28H TANH (HYPERBOLIC TANGENT)// 00960378 ! 100: 2 20H SUBSET REF. - 15.3) 00970378 ! 101: CBB** ********************** BBCHED0B **********************************00980378 ! 102: C**** WRITE DETAIL REPORT HEADERS 00990378 ! 103: C**** 01000378 ! 104: WRITE (I02,90004) 01010378 ! 105: WRITE (I02,90004) 01020378 ! 106: WRITE (I02,90013) 01030378 ! 107: WRITE (I02,90014) 01040378 ! 108: WRITE (I02,90015) IVTOTL 01050378 ! 109: CBE** ********************** BBCHED0B **********************************01060378 ! 110: C***** 01070378 ! 111: CT001* TEST 1 TEST AT ZERO (0.0) 01080378 ! 112: IVTNUM = 1 01090378 ! 113: BVS = 0.0 01100378 ! 114: AVS = TANH(BVS) 01110378 ! 115: IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120378 ! 116: 40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130378 ! 117: 10010 IVPASS = IVPASS + 1 01140378 ! 118: WRITE (NUVI, 80002) IVTNUM 01150378 ! 119: GO TO 0011 01160378 ! 120: 20010 IVFAIL = IVFAIL + 1 01170378 ! 121: RVCORR = 0.00000000000000 01180378 ! 122: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190378 ! 123: 0011 CONTINUE 01200378 ! 124: CT002* TEST 2 A NEGATIVE ARGUMENT 01210378 ! 125: IVTNUM = 2 01220378 ! 126: AVS = TANH(-2.5) 01230378 ! 127: IF (AVS + 0.98667E+00) 20020, 10020, 40020 01240378 ! 128: 40020 IF (AVS + 0.98656E+00) 10020, 10020, 20020 01250378 ! 129: 10020 IVPASS = IVPASS + 1 01260378 ! 130: WRITE (NUVI, 80002) IVTNUM 01270378 ! 131: GO TO 0021 01280378 ! 132: 20020 IVFAIL = IVFAIL + 1 01290378 ! 133: RVCORR = -0.98661429815143 01300378 ! 134: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310378 ! 135: 0021 CONTINUE 01320378 ! 136: CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT 01330378 ! 137: IVTNUM = 3 01340378 ! 138: BVS = 4.75 01350378 ! 139: AVS = TANH(BVS) 01360378 ! 140: IF (AVS - 0.99980E+00) 20030, 10030, 40030 01370378 ! 141: 40030 IF (AVS - 0.99990E+00) 10030, 10030, 20030 01380378 ! 142: 10030 IVPASS = IVPASS + 1 01390378 ! 143: WRITE (NUVI, 80002) IVTNUM 01400378 ! 144: GO TO 0031 01410378 ! 145: 20030 IVFAIL = IVFAIL + 1 01420378 ! 146: RVCORR = 0.99985030754498 01430378 ! 147: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01440378 ! 148: 0031 CONTINUE 01450378 ! 149: CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01460378 ! 150: IVTNUM = 4 01470378 ! 151: AVS = TANH(15.125) 01480378 ! 152: IF (AVS - 0.99995E+00) 20040, 10040, 40040 01490378 ! 153: 40040 IF (AVS - 0.10001E+01) 10040, 10040, 20040 01500378 ! 154: 10040 IVPASS = IVPASS + 1 01510378 ! 155: WRITE (NUVI, 80002) IVTNUM 01520378 ! 156: GO TO 0041 01530378 ! 157: 20040 IVFAIL = IVFAIL + 1 01540378 ! 158: RVCORR = 0.99999999999985 01550378 ! 159: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01560378 ! 160: 0041 CONTINUE 01570378 ! 161: CT005* TEST 5 TEST WITH LARGE VALUES 01580378 ! 162: IVTNUM = 5 01590378 ! 163: BVS = 10.0 ** 2 01600378 ! 164: AVS = TANH(BVS) 01610378 ! 165: IF (AVS - 0.99995E+00) 20050, 10050, 40050 01620378 ! 166: 40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050 01630378 ! 167: 10050 IVPASS = IVPASS + 1 01640378 ! 168: WRITE (NUVI, 80002) IVTNUM 01650378 ! 169: GO TO 0051 01660378 ! 170: 20050 IVFAIL = IVFAIL + 1 01670378 ! 171: RVCORR = 1.00000000000000 01680378 ! 172: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01690378 ! 173: 0051 CONTINUE 01700378 ! 174: CT006* TEST 6 TEST WITH LARGE VALUES 01710378 ! 175: IVTNUM = 6 01720378 ! 176: BVS = -100.0 * 10.0 01730378 ! 177: AVS = TANH(BVS) 01740378 ! 178: IF (AVS + 0.10001E+01) 20060, 10060, 40060 01750378 ! 179: 40060 IF (AVS + 0.99995E+00) 10060, 10060, 20060 01760378 ! 180: 10060 IVPASS = IVPASS + 1 01770378 ! 181: WRITE (NUVI, 80002) IVTNUM 01780378 ! 182: GO TO 0061 01790378 ! 183: 20060 IVFAIL = IVFAIL + 1 01800378 ! 184: RVCORR = -1.00000000000000 01810378 ! 185: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01820378 ! 186: 0061 CONTINUE 01830378 ! 187: CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE 01840378 ! 188: IVTNUM = 7 01850378 ! 189: BVS = 3.0E+36 01860378 ! 190: AVS = TANH(BVS) 01870378 ! 191: IF (AVS - 0.99995E+00) 20070, 10070, 40070 01880378 ! 192: 40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070 01890378 ! 193: 10070 IVPASS = IVPASS + 1 01900378 ! 194: WRITE (NUVI, 80002) IVTNUM 01910378 ! 195: GO TO 0071 01920378 ! 196: 20070 IVFAIL = IVFAIL + 1 01930378 ! 197: RVCORR = 1.00000000000000 01940378 ! 198: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01950378 ! 199: 0071 CONTINUE 01960378 ! 200: CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE 01970378 ! 201: IVTNUM = 8 01980378 ! 202: BVS = -1.0E-15 01990378 ! 203: AVS = TANH(BVS) 02000378 ! 204: IF (AVS + 0.10001E-14) 20080, 10080, 40080 02010378 ! 205: 40080 IF (AVS + 0.99995E-15) 10080, 10080, 20080 02020378 ! 206: 10080 IVPASS = IVPASS + 1 02030378 ! 207: WRITE (NUVI, 80002) IVTNUM 02040378 ! 208: GO TO 0081 02050378 ! 209: 20080 IVFAIL = IVFAIL + 1 02060378 ! 210: RVCORR = -1.00000000000000E-15 02070378 ! 211: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02080378 ! 212: 0081 CONTINUE 02090378 ! 213: CT009* TEST 9 THE FUNCTION APPLIED TWICE 02100378 ! 214: IVTNUM = 9 02110378 ! 215: AVS = TANH(0.5) * TANH(0.75) 02120378 ! 216: IF (AVS - 0.29349E+00) 20090, 10090, 40090 02130378 ! 217: 40090 IF (AVS - 0.29353E+00) 10090, 10090, 20090 02140378 ! 218: 10090 IVPASS = IVPASS + 1 02150378 ! 219: WRITE (NUVI, 80002) IVTNUM 02160378 ! 220: GO TO 0091 02170378 ! 221: 20090 IVFAIL = IVFAIL + 1 02180378 ! 222: RVCORR = 0.293513228313886 02190378 ! 223: WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02200378 ! 224: 0091 CONTINUE 02210378 ! 225: C***** 02220378 ! 226: CBB** ********************** BBCSUM0 **********************************02230378 ! 227: C**** WRITE OUT TEST SUMMARY 02240378 ! 228: C**** 02250378 ! 229: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02260378 ! 230: WRITE (I02, 90004) 02270378 ! 231: WRITE (I02, 90014) 02280378 ! 232: WRITE (I02, 90004) 02290378 ! 233: WRITE (I02, 90020) IVPASS 02300378 ! 234: WRITE (I02, 90022) IVFAIL 02310378 ! 235: WRITE (I02, 90024) IVDELE 02320378 ! 236: WRITE (I02, 90026) IVINSP 02330378 ! 237: WRITE (I02, 90028) IVTOTN, IVTOTL 02340378 ! 238: CBE** ********************** BBCSUM0 **********************************02350378 ! 239: CBB** ********************** BBCFOOT0 **********************************02360378 ! 240: C**** WRITE OUT REPORT FOOTINGS 02370378 ! 241: C**** 02380378 ! 242: WRITE (I02,90016) ZPROG, ZPROG 02390378 ! 243: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02400378 ! 244: WRITE (I02,90019) 02410378 ! 245: CBE** ********************** BBCFOOT0 **********************************02420378 ! 246: CBB** ********************** BBCFMT0A **********************************02430378 ! 247: C**** FORMATS FOR TEST DETAIL LINES 02440378 ! 248: C**** 02450378 ! 249: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02460378 ! 250: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02470378 ! 251: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02480378 ! 252: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02490378 ! 253: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02500378 ! 254: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02510378 ! 255: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02520378 ! 256: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02530378 ! 257: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02540378 ! 258: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02550378 ! 259: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 02560378 ! 260: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 02570378 ! 261: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 02580378 ! 262: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 02590378 ! 263: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 02600378 ! 264: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 02610378 ! 265: 80050 FORMAT (1H ,48X,A31) 02620378 ! 266: CBE** ********************** BBCFMT0A **********************************02630378 ! 267: CBB** ********************** BBCFMT0B **********************************02640378 ! 268: C**** FORMAT STATEMENTS FOR PAGE HEADERS 02650378 ! 269: C**** 02660378 ! 270: 90002 FORMAT (1H1) 02670378 ! 271: 90004 FORMAT (1H ) 02680378 ! 272: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 02690378 ! 273: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02700378 ! 274: 90008 FORMAT (1H ,21X,A13,A17) 02710378 ! 275: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 02720378 ! 276: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 02730378 ! 277: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 02740378 ! 278: 1 7X,7HREMARKS,24X) 02750378 ! 279: 90014 FORMAT (1H ,46H----------------------------------------------, 02760378 ! 280: 1 33H---------------------------------) 02770378 ! 281: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 02780378 ! 282: C**** 02790378 ! 283: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02800378 ! 284: C**** 02810378 ! 285: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 02820378 ! 286: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 02830378 ! 287: 1 A13) 02840378 ! 288: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 02850378 ! 289: C**** 02860378 ! 290: C**** FORMAT STATEMENTS FOR RUN SUMMARY 02870378 ! 291: C**** 02880378 ! 292: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 02890378 ! 293: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 02900378 ! 294: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 02910378 ! 295: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 02920378 ! 296: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 02930378 ! 297: CBE** ********************** BBCFMT0B **********************************02940378 ! 298: C***** 02950378 ! 299: C***** END OF TEST SEGMENT 199 02960378 ! 300: STOP 02970378 ! 301: END 02980378 ! 302: 02990378
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.