![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM808.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 FM808.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***********************************************************************00010808 ! 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 00020808 ! 6: C***** FM808 YDBLE - (169) 00030808 ! 7: C***** 00040808 ! 8: C***********************************************************************00050808 ! 9: C***** GENERAL PURPOSE ANS REF 00060808 ! 10: C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 15.3 00070808 ! 11: C***** IN DOUBLE PRECISION FORM ) (TABLE 5)00080808 ! 12: C***** 00090808 ! 13: CBB** ********************** BBCCOMNT **********************************00100808 ! 14: C**** 00110808 ! 15: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120808 ! 16: C**** VERSION 2.0 00130808 ! 17: C**** 00140808 ! 18: C**** 00150808 ! 19: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160808 ! 20: C**** GENERAL SERVICES ADMINISTRATION 00170808 ! 21: C**** FEDERAL SOFTWARE TESTING CENTER 00180808 ! 22: C**** 5203 LEESBURG PIKE, SUITE 1100 00190808 ! 23: C**** FALLS CHURCH, VA. 22041 00200808 ! 24: C**** 00210808 ! 25: C**** (703) 756-6153 00220808 ! 26: C**** 00230808 ! 27: CBE** ********************** BBCCOMNT **********************************00240808 ! 28: C***** 00250808 ! 29: C***** S P E C I F I C A T I O N S SEGMENT 169 00260808 ! 30: DOUBLE PRECISION DVAVD, DVBVD, DVCORR, DVAVD1 00270808 ! 31: C***** 00280808 ! 32: CBB** ********************** BBCINITA **********************************00290808 ! 33: C**** SPECIFICATION STATEMENTS 00300808 ! 34: C**** 00310808 ! 35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320808 ! 36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330808 ! 37: CBE** ********************** BBCINITA **********************************00340808 ! 38: CBB** ********************** BBCINITB **********************************00350808 ! 39: C**** INITIALIZE SECTION 00360808 ! 40: DATA ZVERS, ZVERSD, ZDATE 00370808 ! 41: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00380808 ! 42: DATA ZCOMPL, ZNAME, ZTAPE 00390808 ! 43: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400808 ! 44: DATA ZPROJ, ZTAPED, ZPROG 00410808 ! 45: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420808 ! 46: DATA REMRKS /' '/ 00430808 ! 47: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440808 ! 48: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450808 ! 49: C**** 00460808 ! 50: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470808 ! 51: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480808 ! 52: CZ03 ZPROG = 'PROGRAM NAME' 00490808 ! 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 00560808 ! 60: IVPASS = 0 00570808 ! 61: IVFAIL = 0 00580808 ! 62: IVDELE = 0 00590808 ! 63: IVINSP = 0 00600808 ! 64: IVTOTL = 0 00610808 ! 65: IVTOTN = 0 00620808 ! 66: ICZERO = 0 00630808 ! 67: C 00640808 ! 68: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650808 ! 69: I01 = 05 00660808 ! 70: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670808 ! 71: I02 = 06 00680808 ! 72: C 00690808 ! 73: I01 = 5 00700808 ! 74: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710808 ! 75: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720808 ! 76: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730808 ! 77: C 00740808 ! 78: I02 = 6 00750808 ! 79: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760808 ! 80: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770808 ! 81: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780808 ! 82: C 00790808 ! 83: CBE** ********************** BBCINITB **********************************00800808 ! 84: NUVI = I02 00810808 ! 85: IVTOTL = 8 00820808 ! 86: ZPROG = 'FM808' 00830808 ! 87: CBB** ********************** BBCHED0A **********************************00840808 ! 88: C**** 00850808 ! 89: C**** WRITE REPORT TITLE 00860808 ! 90: C**** 00870808 ! 91: WRITE (I02, 90002) 00880808 ! 92: WRITE (I02, 90006) 00890808 ! 93: WRITE (I02, 90007) 00900808 ! 94: WRITE (I02, 90008) ZVERS, ZVERSD 00910808 ! 95: WRITE (I02, 90009) ZPROG, ZPROG 00920808 ! 96: WRITE (I02, 90010) ZDATE, ZCOMPL 00930808 ! 97: CBE** ********************** BBCHED0A **********************************00940808 ! 98: C***** 00950808 ! 99: WRITE (NUVI,16901) 00960808 ! 100: 16901 FORMAT(1H ,//1X,34HYDBLE - (169) INTRINSIC FUNCTION--// 00970808 ! 101: 1 16X,22HDBLE (TYPE CONVERSION)// 2X, 00980808 ! 102: 2 15HANS REF. - 15.3) 00990808 ! 103: CBB** ********************** BBCHED0B **********************************01000808 ! 104: C**** WRITE DETAIL REPORT HEADERS 01010808 ! 105: C**** 01020808 ! 106: WRITE (I02,90004) 01030808 ! 107: WRITE (I02,90004) 01040808 ! 108: WRITE (I02,90013) 01050808 ! 109: WRITE (I02,90014) 01060808 ! 110: WRITE (I02,90015) IVTOTL 01070808 ! 111: CBE** ********************** BBCHED0B **********************************01080808 ! 112: C***** 01090808 ! 113: CT001* TEST 1 THE VALUE ZERO 01100808 ! 114: IVTNUM = 1 01110808 ! 115: RVAVS = 0.0 01120808 ! 116: DVAVD = DBLE(RVAVS) 01130808 ! 117: IF (DVAVD + 5.0D-5) 20010, 10010, 40010 01140808 ! 118: 40010 IF (DVAVD - 5.0D-5) 10010, 10010, 20010 01150808 ! 119: 10010 IVPASS = IVPASS + 1 01160808 ! 120: WRITE (NUVI, 80002) IVTNUM 01170808 ! 121: GO TO 0011 01180808 ! 122: 20010 IVFAIL = IVFAIL + 1 01190808 ! 123: DVCORR = 0.0D0 01200808 ! 124: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01210808 ! 125: 0011 CONTINUE 01220808 ! 126: CT002* TEST 2 A D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01230808 ! 127: IVTNUM = 2 01240808 ! 128: RVAVS = 0.015625 01250808 ! 129: DVAVD = DBLE(RVAVS) 01260808 ! 130: IF (DVAVD - 1.5624D-2) 20020, 10020, 40020 01270808 ! 131: 40020 IF (DVAVD - 1.5626D-2) 10020, 10020, 20020 01280808 ! 132: 10020 IVPASS = IVPASS + 1 01290808 ! 133: WRITE (NUVI, 80002) IVTNUM 01300808 ! 134: GO TO 0021 01310808 ! 135: 20020 IVFAIL = IVFAIL + 1 01320808 ! 136: DVCORR = 1.5625D-2 01330808 ! 137: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01340808 ! 138: 0021 CONTINUE 01350808 ! 139: CT003* TEST 3 A NEGATIVE INTEGRAL VALUE 01360808 ! 140: IVTNUM = 3 01370808 ! 141: RVAVS = -321.0 01380808 ! 142: DVAVD = DBLE(RVAVS) 01390808 ! 143: IF (DVAVD + 3.2102D2) 20030, 10030, 40030 01400808 ! 144: 40030 IF (DVAVD + 3.2098D2) 10030, 10030, 20030 01410808 ! 145: 10030 IVPASS = IVPASS + 1 01420808 ! 146: WRITE (NUVI, 80002) IVTNUM 01430808 ! 147: GO TO 0031 01440808 ! 148: 20030 IVFAIL = IVFAIL + 1 01450808 ! 149: DVCORR = -3.210D2 01460808 ! 150: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01470808 ! 151: 0031 CONTINUE 01480808 ! 152: CT004* TEST 4 A NEGATIVE D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01490808 ! 153: IVTNUM = 4 01500808 ! 154: RVAVS = -0.015625 01510808 ! 155: DVAVD = DBLE(RVAVS) 01520808 ! 156: IF (DVAVD + 1.5626D-2) 20040, 10040, 40040 01530808 ! 157: 40040 IF (DVAVD + 1.5624D-2) 10040, 10040, 20040 01540808 ! 158: 10040 IVPASS = IVPASS + 1 01550808 ! 159: WRITE (NUVI, 80002) IVTNUM 01560808 ! 160: GO TO 0041 01570808 ! 161: 20040 IVFAIL = IVFAIL + 1 01580808 ! 162: DVCORR = -0.015625D0 01590808 ! 163: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01600808 ! 164: 0041 CONTINUE 01610808 ! 165: CT005* TEST 5 THE VALUE ZERO PRECEDED BY A MINUS SIGN 01620808 ! 166: IVTNUM = 5 01630808 ! 167: RVAVS = 0.0 01640808 ! 168: DVAVD = DBLE(-RVAVS) 01650808 ! 169: IF (DVAVD + 5.0D-5) 20050, 10050, 40050 01660808 ! 170: 40050 IF (DVAVD - 5.0D-5) 10050, 10050, 20050 01670808 ! 171: 10050 IVPASS = IVPASS + 1 01680808 ! 172: WRITE (NUVI, 80002) IVTNUM 01690808 ! 173: GO TO 0051 01700808 ! 174: 20050 IVFAIL = IVFAIL + 1 01710808 ! 175: DVCORR = -0.0D0 01720808 ! 176: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01730808 ! 177: 0051 CONTINUE 01740808 ! 178: CT006* TEST 6 A POSITIVE INTEGRAL VALUE 01750808 ! 179: IVTNUM = 6 01760808 ! 180: RVAVS = 321.0 01770808 ! 181: DVAVD = DBLE(RVAVS) 01780808 ! 182: IF (DVAVD - 3.2098D2) 20060, 10060, 40060 01790808 ! 183: 40060 IF (DVAVD - 3.2102D2) 10060, 10060, 20060 01800808 ! 184: 10060 IVPASS = IVPASS + 1 01810808 ! 185: WRITE (NUVI, 80002) IVTNUM 01820808 ! 186: GO TO 0061 01830808 ! 187: 20060 IVFAIL = IVFAIL + 1 01840808 ! 188: DVCORR = 3.21D2 01850808 ! 189: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01860808 ! 190: 0061 CONTINUE 01870808 ! 191: CT007* TEST 7 AN ARITHMETIC EXPRESSION IS USED AS ARGUMENT 01880808 ! 192: IVTNUM = 7 01890808 ! 193: RVAVS = 6.25 01900808 ! 194: RVBVS = 2.5 01910808 ! 195: DVAVD = DBLE(RVBVS ** 2) 01920808 ! 196: IF (DVAVD - 6.2496D0) 20070, 10070, 40070 01930808 ! 197: 40070 IF (DVAVD - 6.2504D0) 10070, 10070, 20070 01940808 ! 198: 10070 IVPASS = IVPASS + 1 01950808 ! 199: WRITE (NUVI, 80002) IVTNUM 01960808 ! 200: GO TO 0071 01970808 ! 201: 20070 IVFAIL = IVFAIL + 1 01980808 ! 202: DVCORR = 6.25D0 01990808 ! 203: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02000808 ! 204: 0071 CONTINUE 02010808 ! 205: CT008* TEST 8 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02020808 ! 206: IVTNUM = 8 02030808 ! 207: RVBVS = 2.5 02040808 ! 208: DVBVD = RVBVS ** 3 02050808 ! 209: DVAVD = DBLE(RVBVS ** 3) 02060808 ! 210: IF (DVAVD - 1.5624D1) 20080, 10080, 40080 02070808 ! 211: 40080 IF (DVAVD - 1.5626D1) 10080, 10080, 20080 02080808 ! 212: 10080 IVPASS = IVPASS + 1 02090808 ! 213: WRITE (NUVI, 80002) IVTNUM 02100808 ! 214: GO TO 0081 02110808 ! 215: 20080 IVFAIL = IVFAIL + 1 02120808 ! 216: DVCORR = 1.5625D1 02130808 ! 217: WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02140808 ! 218: 0081 CONTINUE 02150808 ! 219: CBB** ********************** BBCSUM0 **********************************02160808 ! 220: C**** WRITE OUT TEST SUMMARY 02170808 ! 221: C**** 02180808 ! 222: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02190808 ! 223: WRITE (I02, 90004) 02200808 ! 224: WRITE (I02, 90014) 02210808 ! 225: WRITE (I02, 90004) 02220808 ! 226: WRITE (I02, 90020) IVPASS 02230808 ! 227: WRITE (I02, 90022) IVFAIL 02240808 ! 228: WRITE (I02, 90024) IVDELE 02250808 ! 229: WRITE (I02, 90026) IVINSP 02260808 ! 230: WRITE (I02, 90028) IVTOTN, IVTOTL 02270808 ! 231: CBE** ********************** BBCSUM0 **********************************02280808 ! 232: CBB** ********************** BBCFOOT0 **********************************02290808 ! 233: C**** WRITE OUT REPORT FOOTINGS 02300808 ! 234: C**** 02310808 ! 235: WRITE (I02,90016) ZPROG, ZPROG 02320808 ! 236: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02330808 ! 237: WRITE (I02,90019) 02340808 ! 238: CBE** ********************** BBCFOOT0 **********************************02350808 ! 239: CBB** ********************** BBCFMT0A **********************************02360808 ! 240: C**** FORMATS FOR TEST DETAIL LINES 02370808 ! 241: C**** 02380808 ! 242: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02390808 ! 243: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02400808 ! 244: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02410808 ! 245: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02420808 ! 246: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02430808 ! 247: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02440808 ! 248: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02450808 ! 249: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 02460808 ! 250: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02470808 ! 251: 1A21,/,1H ,16X,10HCORRECT= ,A21) 02480808 ! 252: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 02490808 ! 253: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 02500808 ! 254: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 02510808 ! 255: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 02520808 ! 256: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 02530808 ! 257: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 02540808 ! 258: 80050 FORMAT (1H ,48X,A31) 02550808 ! 259: CBE** ********************** BBCFMT0A **********************************02560808 ! 260: CBB** ********************** BBCFMAT1 **********************************02570808 ! 261: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02580808 ! 262: C**** 02590808 ! 263: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02600808 ! 264: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 02610808 ! 265: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 02620808 ! 266: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 02630808 ! 267: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02640808 ! 268: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 02650808 ! 269: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02660808 ! 270: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 02670808 ! 271: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 02680808 ! 272: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 02690808 ! 273: 21H(,F12.5,2H, ,F12.5,1H)) 02700808 ! 274: CBE** ********************** BBCFMAT1 **********************************02710808 ! 275: CBB** ********************** BBCFMT0B **********************************02720808 ! 276: C**** FORMAT STATEMENTS FOR PAGE HEADERS 02730808 ! 277: C**** 02740808 ! 278: 90002 FORMAT (1H1) 02750808 ! 279: 90004 FORMAT (1H ) 02760808 ! 280: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 02770808 ! 281: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02780808 ! 282: 90008 FORMAT (1H ,21X,A13,A17) 02790808 ! 283: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 02800808 ! 284: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 02810808 ! 285: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 02820808 ! 286: 1 7X,7HREMARKS,24X) 02830808 ! 287: 90014 FORMAT (1H ,46H----------------------------------------------, 02840808 ! 288: 1 33H---------------------------------) 02850808 ! 289: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 02860808 ! 290: C**** 02870808 ! 291: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02880808 ! 292: C**** 02890808 ! 293: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 02900808 ! 294: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 02910808 ! 295: 1 A13) 02920808 ! 296: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 02930808 ! 297: C**** 02940808 ! 298: C**** FORMAT STATEMENTS FOR RUN SUMMARY 02950808 ! 299: C**** 02960808 ! 300: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 02970808 ! 301: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 02980808 ! 302: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 02990808 ! 303: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03000808 ! 304: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03010808 ! 305: CBE** ********************** BBCFMT0B **********************************03020808 ! 306: C***** 03030808 ! 307: C***** END OF TEST SEGMENT 169 03040808 ! 308: STOP 03050808 ! 309: END 03060808 ! 310: 03070808
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.