![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM805.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 FM805.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***********************************************************************00010805 ! 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 00020805 ! 6: C***** FM805 YDDIM - (164) 00030805 ! 7: C***** 00040805 ! 8: C***********************************************************************00050805 ! 9: C***** GENERAL PURPOSE ANS REF 00060805 ! 10: C***** TEST INTRINSIC FUNCTION DDIM AND PROD--POSITIVE 15.3 00070805 ! 11: C***** DIFFERENCE AND DOUBLE PRECISION PRODUCT, RESP. (TABLE 5)00080805 ! 12: C***** 00090805 ! 13: CBB** ********************** BBCCOMNT **********************************00100805 ! 14: C**** 00110805 ! 15: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120805 ! 16: C**** VERSION 2.0 00130805 ! 17: C**** 00140805 ! 18: C**** 00150805 ! 19: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160805 ! 20: C**** GENERAL SERVICES ADMINISTRATION 00170805 ! 21: C**** FEDERAL SOFTWARE TESTING CENTER 00180805 ! 22: C**** 5203 LEESBURG PIKE, SUITE 1100 00190805 ! 23: C**** FALLS CHURCH, VA. 22041 00200805 ! 24: C**** 00210805 ! 25: C**** (703) 756-6153 00220805 ! 26: C**** 00230805 ! 27: CBE** ********************** BBCCOMNT **********************************00240805 ! 28: C***** 00250805 ! 29: C***** S P E C I F I C A T I O N S SEGMENT 164 00260805 ! 30: DOUBLE PRECISION DSAVD, DSBVD, DSDVD, DSEVD, DVCORR 00270805 ! 31: C***** 00280805 ! 32: CBB** ********************** BBCINITA **********************************00290805 ! 33: C**** SPECIFICATION STATEMENTS 00300805 ! 34: C**** 00310805 ! 35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320805 ! 36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330805 ! 37: CBE** ********************** BBCINITA **********************************00340805 ! 38: CBB** ********************** BBCINITB **********************************00350805 ! 39: C**** INITIALIZE SECTION 00360805 ! 40: DATA ZVERS, ZVERSD, ZDATE 00370805 ! 41: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00380805 ! 42: DATA ZCOMPL, ZNAME, ZTAPE 00390805 ! 43: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400805 ! 44: DATA ZPROJ, ZTAPED, ZPROG 00410805 ! 45: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420805 ! 46: DATA REMRKS /' '/ 00430805 ! 47: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440805 ! 48: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450805 ! 49: C**** 00460805 ! 50: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470805 ! 51: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480805 ! 52: CZ03 ZPROG = 'PROGRAM NAME' 00490805 ! 53: ZDATE = '07-Nov-85 ' *RP ! 54: ZCOMPL = 'CCI 5.2 ' *RP ! 55: ZPROJ = 'TC-85- -410' *RP ! 56: ZNAME = ' ' *RP ! 57: ZTAPE = ' ' *RP ! 58: ZTAPED = '850703 ' *RP ! 59: C 00560805 ! 60: IVPASS = 0 00570805 ! 61: IVFAIL = 0 00580805 ! 62: IVDELE = 0 00590805 ! 63: IVINSP = 0 00600805 ! 64: IVTOTL = 0 00610805 ! 65: IVTOTN = 0 00620805 ! 66: ICZERO = 0 00630805 ! 67: C 00640805 ! 68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650805 ! 69: I01 = 05 00660805 ! 70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670805 ! 71: I02 = 06 00680805 ! 72: C 00690805 ! 73: I01 = 5 00700805 ! 74: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710805 ! 75: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720805 ! 76: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730805 ! 77: C 00740805 ! 78: I02 = 6 00750805 ! 79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760805 ! 80: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770805 ! 81: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780805 ! 82: C 00790805 ! 83: CBE** ********************** BBCINITB **********************************00800805 ! 84: NUVI = I02 00810805 ! 85: IVTOTL = 18 00820805 ! 86: ZPROG = 'FM805' 00830805 ! 87: CBB** ********************** BBCHED0A **********************************00840805 ! 88: C**** 00850805 ! 89: C**** WRITE REPORT TITLE 00860805 ! 90: C**** 00870805 ! 91: WRITE (I02, 90002) 00880805 ! 92: WRITE (I02, 90006) 00890805 ! 93: WRITE (I02, 90007) 00900805 ! 94: WRITE (I02, 90008) ZVERS, ZVERSD 00910805 ! 95: WRITE (I02, 90009) ZPROG, ZPROG 00920805 ! 96: WRITE (I02, 90010) ZDATE, ZCOMPL 00930805 ! 97: CBE** ********************** BBCHED0A **********************************00940805 ! 98: C***** 00950805 ! 99: C***** HEADER FOR SEGMENT 164 00960805 ! 100: WRITE (NUVI,16401) 00970805 ! 101: 16401 FORMAT (1H ,// 1X,36HYDDIM - (164) INTRINSIC FUNCTIONS-- //16X, 00980805 ! 102: 1 26HDDIM (POSITIVE DIFFERENCE)/,16X, 00990805 ! 103: 2 20HDPROD (D.P. PRODUCT)// 01000805 ! 104: 3 2X,15HANS REF. - 15.3) 01010805 ! 105: CBB** ********************** BBCHED0B **********************************01020805 ! 106: C**** WRITE DETAIL REPORT HEADERS 01030805 ! 107: C**** 01040805 ! 108: WRITE (I02,90004) 01050805 ! 109: WRITE (I02,90004) 01060805 ! 110: WRITE (I02,90013) 01070805 ! 111: WRITE (I02,90014) 01080805 ! 112: WRITE (I02,90015) IVTOTL 01090805 ! 113: CBE** ********************** BBCHED0B **********************************01100805 ! 114: C***** 01110805 ! 115: C***** TEST OF DDIM 01120805 ! 116: C***** 01130805 ! 117: WRITE(NUVI, 16402) 01140805 ! 118: 16402 FORMAT(/ 8X, 12HTEST OF DDIM) 01150805 ! 119: CT001* TEST 1 BOTH VALUES EQUAL 01160805 ! 120: IVTNUM = 1 01170805 ! 121: DSBVD = 0.25D0 01180805 ! 122: DSDVD = 0.25D0 01190805 ! 123: DSAVD = DDIM(DSBVD, DSDVD) 01200805 ! 124: IF (DSAVD + 5.0D-10) 20010, 10010, 40010 01210805 ! 125: 40010 IF (DSAVD - 5.0D-10) 10010, 10010, 20010 01220805 ! 126: 10010 IVPASS = IVPASS + 1 01230805 ! 127: WRITE (NUVI, 80002) IVTNUM 01240805 ! 128: GO TO 0011 01250805 ! 129: 20010 IVFAIL = IVFAIL + 1 01260805 ! 130: DVCORR = 0.0D0 01270805 ! 131: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01280805 ! 132: 0011 CONTINUE 01290805 ! 133: CT002* TEST 2 BOTH VALUES EQUAL, INTEGRAL VALUES 01300805 ! 134: IVTNUM = 2 01310805 ! 135: DSBVD = 2.0D0 01320805 ! 136: DSDVD = 2.0D0 01330805 ! 137: DSAVD = DDIM(DSBVD, DSDVD) 01340805 ! 138: IF (DSAVD + 5.0D-10) 20020, 10020, 40020 01350805 ! 139: 40020 IF (DSAVD - 5.0D-10) 10020, 10020, 20020 01360805 ! 140: 10020 IVPASS = IVPASS + 1 01370805 ! 141: WRITE (NUVI, 80002) IVTNUM 01380805 ! 142: GO TO 0021 01390805 ! 143: 20020 IVFAIL = IVFAIL + 1 01400805 ! 144: DVCORR = 0.0D0 01410805 ! 145: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01420805 ! 146: 0021 CONTINUE 01430805 ! 147: CT003* TEST 3 FIRST VALUE LESS THAN SECOND 01440805 ! 148: IVTNUM = 3 01450805 ! 149: DSBVD = 0.25D1 01460805 ! 150: DSDVD = 0.55D1 01470805 ! 151: DSAVD = DDIM(DSBVD, DSDVD) 01480805 ! 152: IF (DSAVD + 5.0D-10) 20030, 10030, 40030 01490805 ! 153: 40030 IF (DSAVD - 5.0D-10) 10030, 10030, 20030 01500805 ! 154: 10030 IVPASS = IVPASS + 1 01510805 ! 155: WRITE (NUVI, 80002) IVTNUM 01520805 ! 156: GO TO 0031 01530805 ! 157: 20030 IVFAIL = IVFAIL + 1 01540805 ! 158: DVCORR = 0.0D0 01550805 ! 159: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01560805 ! 160: 0031 CONTINUE 01570805 ! 161: CT004* TEST 4 FIRST VALUE GREATER THAN SECOND 01580805 ! 162: IVTNUM = 4 01590805 ! 163: DSBVD = 0.55D1 01600805 ! 164: DSDVD = 0.25D1 01610805 ! 165: DSAVD = DDIM(DSBVD, DSDVD) 01620805 ! 166: IF (DSAVD - 2.999999998D0) 20040, 10040, 40040 01630805 ! 167: 40040 IF (DSAVD - 3.000000002D0) 10040, 10040, 20040 01640805 ! 168: 10040 IVPASS = IVPASS + 1 01650805 ! 169: WRITE (NUVI, 80002) IVTNUM 01660805 ! 170: GO TO 0041 01670805 ! 171: 20040 IVFAIL = IVFAIL + 1 01680805 ! 172: DVCORR = 3.0D0 01690805 ! 173: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01700805 ! 174: 0041 CONTINUE 01710805 ! 175: CT005* TEST 5 BOTH VALUES EQUAL, BOTH NEGATIVE 01720805 ! 176: IVTNUM = 5 01730805 ! 177: DSBVD = -0.25D1 01740805 ! 178: DSDVD = -0.25D1 01750805 ! 179: DSAVD = DDIM(DSBVD, DSDVD) 01760805 ! 180: IF (DSAVD + 5.0D-10) 20050, 10050, 40050 01770805 ! 181: 40050 IF (DSAVD - 5.0D-10) 10050, 10050, 20050 01780805 ! 182: 10050 IVPASS = IVPASS + 1 01790805 ! 183: WRITE (NUVI, 80002) IVTNUM 01800805 ! 184: GO TO 0051 01810805 ! 185: 20050 IVFAIL = IVFAIL + 1 01820805 ! 186: DVCORR = 0.0D0 01830805 ! 187: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01840805 ! 188: 0051 CONTINUE 01850805 ! 189: CT006* TEST 6 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01860805 ! 190: IVTNUM = 6 01870805 ! 191: DSBVD = -0.25D1 01880805 ! 192: DSDVD = -0.55D1 01890805 ! 193: DSAVD = DDIM(DSBVD, DSDVD) 01900805 ! 194: IF (DSAVD - 2.999999998D0) 20060, 10060, 40060 01910805 ! 195: 40060 IF (DSAVD - 3.000000002D0) 10060, 10060, 20060 01920805 ! 196: 10060 IVPASS = IVPASS + 1 01930805 ! 197: WRITE (NUVI, 80002) IVTNUM 01940805 ! 198: GO TO 0061 01950805 ! 199: 20060 IVFAIL = IVFAIL + 1 01960805 ! 200: DVCORR = 3.0D0 01970805 ! 201: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01980805 ! 202: 0061 CONTINUE 01990805 ! 203: CT007* TEST 7 FIRST VALUE POSITIVE, SECOND NEGATIVE 02000805 ! 204: IVTNUM = 7 02010805 ! 205: DSBVD = 0.55D1 02020805 ! 206: DSDVD = -0.25D1 02030805 ! 207: DSAVD = DDIM(DSBVD, DSDVD) 02040805 ! 208: IF (DSAVD - 7.999999996D0) 20070, 10070, 40070 02050805 ! 209: 40070 IF (DSAVD - 8.000000004D0) 10070, 10070, 20070 02060805 ! 210: 10070 IVPASS = IVPASS + 1 02070805 ! 211: WRITE (NUVI, 80002) IVTNUM 02080805 ! 212: GO TO 0071 02090805 ! 213: 20070 IVFAIL = IVFAIL + 1 02100805 ! 214: DVCORR = 8.0D0 02110805 ! 215: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02120805 ! 216: 0071 CONTINUE 02130805 ! 217: CT008* TEST 8 ARITHMETIC EXPRESSION PRESENTED TO DDIM 02140805 ! 218: IVTNUM = 8 02150805 ! 219: DSDVD = 0.25D1 02160805 ! 220: DSEVD = 0.125D1 02170805 ! 221: DSAVD = DDIM(DSDVD / DSEVD, DSDVD * DSEVD) 02180805 ! 222: IF (DSAVD + 5.0D-10) 20080, 10080, 40080 02190805 ! 223: 40080 IF (DSAVD - 5.0D-10) 10080, 10080, 20080 02200805 ! 224: 10080 IVPASS = IVPASS + 1 02210805 ! 225: WRITE (NUVI, 80002) IVTNUM 02220805 ! 226: GO TO 0081 02230805 ! 227: 20080 IVFAIL = IVFAIL + 1 02240805 ! 228: DVCORR = 0.0D0 02250805 ! 229: WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02260805 ! 230: 0081 CONTINUE 02270805 ! 231: C***** 02280805 ! 232: C***** TEST OF DPROD 02290805 ! 233: C***** 02300805 ! 234: WRITE(NUVI, 16404) 02310805 ! 235: REMRKS = '+ OR - 0.00005' 02320805 ! 236: 16404 FORMAT(// 8X, 13HTEST OF DPROD) 02330805 ! 237: CT009* TEST 9 PAIR OF VALUES, ONE OF WHICH IS ZERO 02340805 ! 238: IVTNUM = 9 02350805 ! 239: RSAVS = 0.0 02360805 ! 240: RSBVS = 2.0 02370805 ! 241: DSAVD = DPROD(RSAVS, RSBVS) 02380805 ! 242: IF (DSAVD + 5.0D-5) 20090, 10090, 40090 02390805 ! 243: 40090 IF (DSAVD - 5.0D-5) 10090, 10090, 20090 02400805 ! 244: 10090 IVPASS = IVPASS + 1 02410805 ! 245: WRITE (NUVI, 80002) IVTNUM 02420805 ! 246: GO TO 0091 02430805 ! 247: 20090 IVFAIL = IVFAIL + 1 02440805 ! 248: DVCORR = 0.0D0 02450805 ! 249: WRITE (NUVI, 80008) IVTNUM 02460805 ! 250: WRITE (NUVI, 80033) DSAVD 02470805 ! 251: WRITE (NUVI, 80035) DVCORR, REMRKS 02480805 ! 252: 0091 CONTINUE 02490805 ! 253: CT010* TEST 10 PAIR OF VALUES, ONE OF WHICH IS ONE 02500805 ! 254: IVTNUM = 10 02510805 ! 255: RSAVS = 1.0 02520805 ! 256: RSBVS = 2.0 02530805 ! 257: DSAVD = DPROD(RSAVS, RSBVS) 02540805 ! 258: IF (DSAVD - 1.9999D0) 20100, 10100, 40100 02550805 ! 259: 40100 IF (DSAVD - 2.0001D0) 10100, 10100, 20100 02560805 ! 260: 10100 IVPASS = IVPASS + 1 02570805 ! 261: WRITE (NUVI, 80002) IVTNUM 02580805 ! 262: GO TO 0101 02590805 ! 263: 20100 IVFAIL = IVFAIL + 1 02600805 ! 264: DVCORR = 2.0D0 02610805 ! 265: WRITE (NUVI, 80008) IVTNUM 02620805 ! 266: WRITE (NUVI, 80033) DSAVD 02630805 ! 267: WRITE (NUVI, 80035) DVCORR, REMRKS 02640805 ! 268: 0101 CONTINUE 02650805 ! 269: CT011* TEST 11 PAIR OF NON-ZERO VALUES 02660805 ! 270: IVTNUM = 11 02670805 ! 271: RSAVS = 3.333333 02680805 ! 272: RSBVS = 2.3948094 02690805 ! 273: DSAVD = DPROD(RSAVS, RSBVS) 02700805 ! 274: IF (DSAVD - 7.9823D0) 20110, 10110, 40110 02710805 ! 275: 40110 IF (DSAVD - 7.9831D0) 10110, 10110, 20110 02720805 ! 276: 10110 IVPASS = IVPASS + 1 02730805 ! 277: WRITE (NUVI, 80002) IVTNUM 02740805 ! 278: GO TO 0111 02750805 ! 279: 20110 IVFAIL = IVFAIL + 1 02760805 ! 280: DVCORR = 7.982697202D0 02770805 ! 281: WRITE (NUVI, 80008) IVTNUM 02780805 ! 282: WRITE (NUVI, 80033) DSAVD 02790805 ! 283: WRITE (NUVI, 80035) DVCORR, REMRKS 02800805 ! 284: 0111 CONTINUE 02810805 ! 285: CT012* TEST 12 ONE POSITIVE, ONE NEGATIVE 02820805 ! 286: IVTNUM = 12 02830805 ! 287: RSAVS = 0.123456 02840805 ! 288: RSBVS = -2.98765 02850805 ! 289: DSAVD = DPROD(RSAVS, RSBVS) 02860805 ! 290: IF (DSAVD + 3.6887D-1) 20120, 10120, 40120 02870805 ! 291: 40120 IF (DSAVD + 3.6882D-1) 10120, 10120, 20120 02880805 ! 292: 10120 IVPASS = IVPASS + 1 02890805 ! 293: WRITE (NUVI, 80002) IVTNUM 02900805 ! 294: GO TO 0121 02910805 ! 295: 20120 IVFAIL = IVFAIL + 1 02920805 ! 296: DVCORR = -3.688433184D-1 02930805 ! 297: WRITE (NUVI, 80008) IVTNUM 02940805 ! 298: WRITE (NUVI, 80033) DSAVD 02950805 ! 299: WRITE (NUVI, 80035) DVCORR, REMRKS 02960805 ! 300: 0121 CONTINUE 02970805 ! 301: CT013* TEST 13 ONE VALUE ONE(1), ONE NEGATIVE 02980805 ! 302: IVTNUM = 13 02990805 ! 303: RSAVS = 1.0834001 03000805 ! 304: RSBVS = -2.034985 03010805 ! 305: DSAVD = DPROD(RSAVS, RSBVS) 03020805 ! 306: IF (DSAVD + 2.2049D0) 20130, 10130, 40130 03030805 ! 307: 40130 IF (DSAVD + 2.2045D0) 10130, 10130, 20130 03040805 ! 308: 10130 IVPASS = IVPASS + 1 03050805 ! 309: WRITE (NUVI, 80002) IVTNUM 03060805 ! 310: GO TO 0131 03070805 ! 311: 20130 IVFAIL = IVFAIL + 1 03080805 ! 312: DVCORR = -2.204702953D0 03090805 ! 313: WRITE (NUVI, 80008) IVTNUM 03100805 ! 314: WRITE (NUVI, 80033) DSAVD 03110805 ! 315: WRITE (NUVI, 80035) DVCORR, REMRKS 03120805 ! 316: 0131 CONTINUE 03130805 ! 317: CT014* TEST 14 PAIR OF NEGATIVE VALUES 03140805 ! 318: IVTNUM = 14 03150805 ! 319: RSAVS = -3.077734 03160805 ! 320: RSBVS = -2.348343 03170805 ! 321: DSAVD = DPROD(RSAVS, RSBVS) 03180805 ! 322: IF (DSAVD - 7.2272D0) 20140, 10140, 40140 03190805 ! 323: 40140 IF (DSAVD - 7.2280D0) 10140, 10140, 20140 03200805 ! 324: 10140 IVPASS = IVPASS + 1 03210805 ! 325: WRITE (NUVI, 80002) IVTNUM 03220805 ! 326: GO TO 0141 03230805 ! 327: 20140 IVFAIL = IVFAIL + 1 03240805 ! 328: DVCORR = 7.227575095D0 03250805 ! 329: WRITE (NUVI, 80008) IVTNUM 03260805 ! 330: WRITE (NUVI, 80033) DSAVD 03270805 ! 331: WRITE (NUVI, 80035) DVCORR, REMRKS 03280805 ! 332: 0141 CONTINUE 03290805 ! 333: CT015* TEST 15 ONE POSITIVE VALUE, ONE NEGATIVE VALUE 03300805 ! 334: IVTNUM = 15 03310805 ! 335: RSAVS = 3.3333324 03320805 ! 336: RSBVS = -2.343953 03330805 ! 337: DSAVD = DPROD(RSAVS, RSBVS) 03340805 ! 338: IF (DSAVD + 7.8136D0) 20150, 10150, 40150 03350805 ! 339: 40150 IF (DSAVD + 7.8127D0) 10150, 10150, 20150 03360805 ! 340: 10150 IVPASS = IVPASS + 1 03370805 ! 341: WRITE (NUVI, 80002) IVTNUM 03380805 ! 342: GO TO 0151 03390805 ! 343: 20150 IVFAIL = IVFAIL + 1 03400805 ! 344: DVCORR = -7.813174479D0 03410805 ! 345: WRITE (NUVI, 80008) IVTNUM 03420805 ! 346: WRITE (NUVI, 80033) DSAVD 03430805 ! 347: WRITE (NUVI, 80035) DVCORR, REMRKS 03440805 ! 348: 0151 CONTINUE 03450805 ! 349: CT016* TEST 16 ARITHMETIC EXPRESSION PRESENTED TO DPROD 03460805 ! 350: IVTNUM = 16 03470805 ! 351: RSAVS = 1.555674 03480805 ! 352: RSBVS = 2.00012 03490805 ! 353: DSAVD = DPROD(RSAVS - RSBVS, RSAVS + RSBVS) 03500805 ! 354: IF (DSAVD + 1.5805D0) 20160, 10160, 40160 03510805 ! 355: 40160 IF (DSAVD + 1.5802D0) 10160, 10160, 20160 03520805 ! 356: 10160 IVPASS = IVPASS + 1 03530805 ! 357: WRITE (NUVI, 80002) IVTNUM 03540805 ! 358: GO TO 0161 03550805 ! 359: 20160 IVFAIL = IVFAIL + 1 03560805 ! 360: DVCORR = -1.580358420D0 03570805 ! 361: WRITE (NUVI, 80008) IVTNUM 03580805 ! 362: WRITE (NUVI, 80033) DSAVD 03590805 ! 363: WRITE (NUVI, 80035) DVCORR, REMRKS 03600805 ! 364: 0161 CONTINUE 03610805 ! 365: CT017* TEST 17 DPROD FORMS THE ARGUMENTS TO DDIM 03620805 ! 366: IVTNUM = 17 03630805 ! 367: DSAVD = DDIM(DPROD(0.4, 2.0), DPROD(3.0, 0.1)) 03640805 ! 368: IF (DSAVD - 0.49997D0) 20170, 10170, 40170 03650805 ! 369: 40170 IF (DSAVD - 0.50003D0) 10170, 10170, 20170 03660805 ! 370: 10170 IVPASS = IVPASS + 1 03670805 ! 371: WRITE (NUVI, 80002) IVTNUM 03680805 ! 372: GO TO 0171 03690805 ! 373: 20170 IVFAIL = IVFAIL + 1 03700805 ! 374: DVCORR = 0.5D0 03710805 ! 375: WRITE (NUVI, 80008) IVTNUM 03720805 ! 376: WRITE (NUVI, 80033) DSAVD 03730805 ! 377: WRITE (NUVI, 80035) DVCORR, REMRKS 03740805 ! 378: 0171 CONTINUE 03750805 ! 379: CT018* TEST 18 ARGUMENTS WITH HIGH AND LOW MAGNITUDES 03760805 ! 380: IVTNUM = 18 03770805 ! 381: RSAVS = 1.23456E-33 03780805 ! 382: RSBVS = 1.23456E+34 03790805 ! 383: DSAVD = DPROD(RSAVS, RSBVS) 03800805 ! 384: IF (DSAVD - 1.5240D1) 20180, 10180, 40180 03810805 ! 385: 40180 IF (DSAVD - 1.5242D1) 10180, 10180, 20180 03820805 ! 386: 10180 IVPASS = IVPASS + 1 03830805 ! 387: WRITE (NUVI, 80002) IVTNUM 03840805 ! 388: GO TO 0181 03850805 ! 389: 20180 IVFAIL = IVFAIL + 1 03860805 ! 390: DVCORR = 1.524138394D1 03870805 ! 391: WRITE (NUVI, 80008) IVTNUM 03880805 ! 392: WRITE (NUVI, 80033) DSAVD 03890805 ! 393: WRITE (NUVI, 80035) DVCORR, REMRKS 03900805 ! 394: 0181 CONTINUE 03910805 ! 395: C***** 03920805 ! 396: CBB** ********************** BBCSUM0 **********************************03930805 ! 397: C**** WRITE OUT TEST SUMMARY 03940805 ! 398: C**** 03950805 ! 399: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03960805 ! 400: WRITE (I02, 90004) 03970805 ! 401: WRITE (I02, 90014) 03980805 ! 402: WRITE (I02, 90004) 03990805 ! 403: WRITE (I02, 90020) IVPASS 04000805 ! 404: WRITE (I02, 90022) IVFAIL 04010805 ! 405: WRITE (I02, 90024) IVDELE 04020805 ! 406: WRITE (I02, 90026) IVINSP 04030805 ! 407: WRITE (I02, 90028) IVTOTN, IVTOTL 04040805 ! 408: CBE** ********************** BBCSUM0 **********************************04050805 ! 409: CBB** ********************** BBCFOOT0 **********************************04060805 ! 410: C**** WRITE OUT REPORT FOOTINGS 04070805 ! 411: C**** 04080805 ! 412: WRITE (I02,90016) ZPROG, ZPROG 04090805 ! 413: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04100805 ! 414: WRITE (I02,90019) 04110805 ! 415: CBE** ********************** BBCFOOT0 **********************************04120805 ! 416: CBB** ********************** BBCFMT0A **********************************04130805 ! 417: C**** FORMATS FOR TEST DETAIL LINES 04140805 ! 418: C**** 04150805 ! 419: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04160805 ! 420: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04170805 ! 421: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04180805 ! 422: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04190805 ! 423: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04200805 ! 424: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04210805 ! 425: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04220805 ! 426: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04230805 ! 427: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04240805 ! 428: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04250805 ! 429: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04260805 ! 430: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04270805 ! 431: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04280805 ! 432: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04290805 ! 433: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04300805 ! 434: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04310805 ! 435: 80050 FORMAT (1H ,48X,A31) 04320805 ! 436: CBE** ********************** BBCFMT0A **********************************04330805 ! 437: CBB** ********************** BBCFMAT1 **********************************04340805 ! 438: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04350805 ! 439: C**** 04360805 ! 440: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04370805 ! 441: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04380805 ! 442: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04390805 ! 443: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04400805 ! 444: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04410805 ! 445: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04420805 ! 446: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04430805 ! 447: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04440805 ! 448: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04450805 ! 449: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04460805 ! 450: 21H(,F12.5,2H, ,F12.5,1H)) 04470805 ! 451: CBE** ********************** BBCFMAT1 **********************************04480805 ! 452: CBB** ********************** BBCFMT0B **********************************04490805 ! 453: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04500805 ! 454: C**** 04510805 ! 455: 90002 FORMAT (1H1) 04520805 ! 456: 90004 FORMAT (1H ) 04530805 ! 457: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04540805 ! 458: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04550805 ! 459: 90008 FORMAT (1H ,21X,A13,A17) 04560805 ! 460: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04570805 ! 461: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04580805 ! 462: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04590805 ! 463: 1 7X,7HREMARKS,24X) 04600805 ! 464: 90014 FORMAT (1H ,46H----------------------------------------------, 04610805 ! 465: 1 33H---------------------------------) 04620805 ! 466: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04630805 ! 467: C**** 04640805 ! 468: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04650805 ! 469: C**** 04660805 ! 470: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04670805 ! 471: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04680805 ! 472: 1 A13) 04690805 ! 473: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04700805 ! 474: C**** 04710805 ! 475: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04720805 ! 476: C**** 04730805 ! 477: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04740805 ! 478: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04750805 ! 479: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04760805 ! 480: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04770805 ! 481: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04780805 ! 482: CBE** ********************** BBCFMT0B **********************************04790805 ! 483: C***** 04800805 ! 484: C***** END OF TEST SEGMENT 164 04810805 ! 485: STOP 04820805 ! 486: END 04830805 ! 487: 04840805
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.