![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM809.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 FM809.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***********************************************************************00010809 ! 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 00020809 ! 6: C***** FM809 YCONJG - (170) 00030809 ! 7: C***** 00040809 ! 8: C***********************************************************************00050809 ! 9: C***** GENERAL PURPOSE ANS REF 00060809 ! 10: C***** TEST INTRINSIC FUNCTION CMPLX (CONVERT TO COMPLEX), 15.3 00070809 ! 11: C***** AIMAG (IMAGINARY PART), AND CONJG (CONJUGATE) (TABLE 5)00080809 ! 12: C***** 00090809 ! 13: C***** S P E C I F I C A T I O N S SEGMENT 170 00100809 ! 14: CBB** ********************** BBCCOMNT **********************************00110809 ! 15: C**** 00120809 ! 16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130809 ! 17: C**** VERSION 2.0 00140809 ! 18: C**** 00150809 ! 19: C**** 00160809 ! 20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170809 ! 21: C**** GENERAL SERVICES ADMINISTRATION 00180809 ! 22: C**** FEDERAL SOFTWARE TESTING CENTER 00190809 ! 23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200809 ! 24: C**** FALLS CHURCH, VA. 22041 00210809 ! 25: C**** 00220809 ! 26: C**** (703) 756-6153 00230809 ! 27: C**** 00240809 ! 28: CBE** ********************** BBCCOMNT **********************************00250809 ! 29: C***** 00260809 ! 30: COMPLEX CWAVC, CWBVC, CWDVC, CWEVC, ZVCORR 00270809 ! 31: REAL R2E(2) 00280809 ! 32: EQUIVALENCE (CWAVC,R2E) 00290809 ! 33: C***** 00300809 ! 34: CBB** ********************** BBCINITA **********************************00310809 ! 35: C**** SPECIFICATION STATEMENTS 00320809 ! 36: C**** 00330809 ! 37: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340809 ! 38: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350809 ! 39: CBE** ********************** BBCINITA **********************************00360809 ! 40: CBB** ********************** BBCINITB **********************************00370809 ! 41: C**** INITIALIZE SECTION 00380809 ! 42: DATA ZVERS, ZVERSD, ZDATE 00390809 ! 43: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00400809 ! 44: DATA ZCOMPL, ZNAME, ZTAPE 00410809 ! 45: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00420809 ! 46: DATA ZPROJ, ZTAPED, ZPROG 00430809 ! 47: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00440809 ! 48: DATA REMRKS /' '/ 00450809 ! 49: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00460809 ! 50: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00470809 ! 51: C**** 00480809 ! 52: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00490809 ! 53: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00500809 ! 54: CZ03 ZPROG = 'PROGRAM NAME' 00510809 ! 55: ZDATE = '07-Nov-85 ' *RP ! 56: ZCOMPL = 'CCI 5.2 ' *RP ! 57: ZPROJ = 'TC-85- -410' *RP ! 58: ZNAME = ' ' *RP ! 59: ZTAPE = ' ' *RP ! 60: ZTAPED = '850703 ' *RP ! 61: C 00580809 ! 62: IVPASS = 0 00590809 ! 63: IVFAIL = 0 00600809 ! 64: IVDELE = 0 00610809 ! 65: IVINSP = 0 00620809 ! 66: IVTOTL = 0 00630809 ! 67: IVTOTN = 0 00640809 ! 68: ICZERO = 0 00650809 ! 69: C 00660809 ! 70: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670809 ! 71: I01 = 05 00680809 ! 72: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690809 ! 73: I02 = 06 00700809 ! 74: C 00710809 ! 75: I01 = 5 00720809 ! 76: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730809 ! 77: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00740809 ! 78: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00750809 ! 79: C 00760809 ! 80: I02 = 6 00770809 ! 81: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00780809 ! 82: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00790809 ! 83: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00800809 ! 84: C 00810809 ! 85: CBE** ********************** BBCINITB **********************************00820809 ! 86: NUVI = I02 00830809 ! 87: IVTOTL = 25 00840809 ! 88: ZPROG = 'FM809' 00850809 ! 89: CBB** ********************** BBCHED0A **********************************00860809 ! 90: C**** 00870809 ! 91: C**** WRITE REPORT TITLE 00880809 ! 92: C**** 00890809 ! 93: WRITE (I02, 90002) 00900809 ! 94: WRITE (I02, 90006) 00910809 ! 95: WRITE (I02, 90007) 00920809 ! 96: WRITE (I02, 90008) ZVERS, ZVERSD 00930809 ! 97: WRITE (I02, 90009) ZPROG, ZPROG 00940809 ! 98: WRITE (I02, 90010) ZDATE, ZCOMPL 00950809 ! 99: CBE** ********************** BBCHED0A **********************************00960809 ! 100: C***** 00970809 ! 101: C***** HEADER FOR SEGMENT 170 WRITTEN 00980809 ! 102: WRITE (NUVI,17001) 00990809 ! 103: 17001 FORMAT(1H , //1X,35HYCONJG - (170) INTRINSIC FUNCTION--//17X, 01000809 ! 104: 1 27HCMPLX (CONVERT TO COMPLEX),/17X, 01010809 ! 105: 2 19HAIMAG (IMAG. PART),/17X, 01020809 ! 106: 3 17HCONJG (CONJUGATE)//,2X, 01030809 ! 107: 4 15HANS REF. - 15.3) 01040809 ! 108: CBB** ********************** BBCHED0B **********************************01050809 ! 109: C**** WRITE DETAIL REPORT HEADERS 01060809 ! 110: C**** 01070809 ! 111: WRITE (I02,90004) 01080809 ! 112: WRITE (I02,90004) 01090809 ! 113: WRITE (I02,90013) 01100809 ! 114: WRITE (I02,90014) 01110809 ! 115: WRITE (I02,90015) IVTOTL 01120809 ! 116: CBE** ********************** BBCHED0B **********************************01130809 ! 117: C***** 01140809 ! 118: C***** TEST OF CMPLX 01150809 ! 119: C***** 01160809 ! 120: WRITE(NUVI, 17002) 01170809 ! 121: 17002 FORMAT(/ 8X, 13HTEST OF CMPLX) 01180809 ! 122: CT001* TEST 1 PAIR OF ZEROES 01190809 ! 123: IVTNUM = 1 01200809 ! 124: RWBVS = 0.0 01210809 ! 125: RWDVS = 0.0 01220809 ! 126: CWAVC = CMPLX(RWBVS, RWDVS) 01230809 ! 127: IF (R2E(1) + 0.00005) 20010, 40012, 40011 01240809 ! 128: 40011 IF (R2E(1) - 0.00005) 40012, 40012, 20010 01250809 ! 129: 40012 IF (R2E(2) + 0.00005) 20010, 10010, 40010 01260809 ! 130: 40010 IF (R2E(2) - 0.00005) 10010, 10010, 20010 01270809 ! 131: 10010 IVPASS = IVPASS + 1 01280809 ! 132: WRITE (NUVI, 80002) IVTNUM 01290809 ! 133: GO TO 0011 01300809 ! 134: 20010 IVFAIL = IVFAIL + 1 01310809 ! 135: ZVCORR = (0.0 , 0.0) 01320809 ! 136: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01330809 ! 137: 0011 CONTINUE 01340809 ! 138: CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO 01350809 ! 139: IVTNUM = 2 01360809 ! 140: RWBVS = 3.0 01370809 ! 141: RWDVS = 0.0 01380809 ! 142: CWAVC = CMPLX(RWBVS, RWDVS) 01390809 ! 143: IF (R2E(1) - 2.9998) 20020, 40022, 40021 01400809 ! 144: 40021 IF (R2E(1) - 3.0002) 40022, 40022, 20020 01410809 ! 145: 40022 IF (R2E(2) + 0.00005) 20020, 10020, 40020 01420809 ! 146: 40020 IF (R2E(2) - 0.00005) 10020, 10020, 20020 01430809 ! 147: 10020 IVPASS = IVPASS + 1 01440809 ! 148: WRITE (NUVI, 80002) IVTNUM 01450809 ! 149: GO TO 0021 01460809 ! 150: 20020 IVFAIL = IVFAIL + 1 01470809 ! 151: ZVCORR = (3.0 , 0.0) 01480809 ! 152: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01490809 ! 153: 0021 CONTINUE 01500809 ! 154: CT003* TEST 3 FIRST VALUE ZERO, SECOND NON-ZERO 01510809 ! 155: IVTNUM = 3 01520809 ! 156: RWBVS = 0.0 01530809 ! 157: RWDVS = 4.0 01540809 ! 158: CWAVC = CMPLX(RWBVS, RWDVS) 01550809 ! 159: IF (R2E(1) + 0.00005) 20030, 40032, 40031 01560809 ! 160: 40031 IF (R2E(1) - 0.00005) 40032, 40032, 20030 01570809 ! 161: 40032 IF (R2E(2) - 3.9998) 20030, 10030, 40030 01580809 ! 162: 40030 IF (R2E(2) - 4.0002) 10030, 10030, 20030 01590809 ! 163: 10030 IVPASS = IVPASS + 1 01600809 ! 164: WRITE (NUVI, 80002) IVTNUM 01610809 ! 165: GO TO 0031 01620809 ! 166: 20030 IVFAIL = IVFAIL + 1 01630809 ! 167: ZVCORR = (0.0 , 4.0) 01640809 ! 168: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01650809 ! 169: 0031 CONTINUE 01660809 ! 170: CT004* TEST 4 PAIR OF NON-ZERO VALUES 01670809 ! 171: IVTNUM = 4 01680809 ! 172: RWBVS = 3.0 01690809 ! 173: RWDVS = 4.0 01700809 ! 174: CWAVC = CMPLX(RWBVS, RWDVS) 01710809 ! 175: IF (R2E(1) - 2.9998) 20040, 40042, 40041 01720809 ! 176: 40041 IF (R2E(1) - 3.0002) 40042, 40042, 20040 01730809 ! 177: 40042 IF (R2E(2) - 3.9998) 20040, 10040, 40040 01740809 ! 178: 40040 IF (R2E(2) - 4.0002) 10040, 10040, 20040 01750809 ! 179: 10040 IVPASS = IVPASS + 1 01760809 ! 180: WRITE (NUVI, 80002) IVTNUM 01770809 ! 181: GO TO 0041 01780809 ! 182: 20040 IVFAIL = IVFAIL + 1 01790809 ! 183: ZVCORR = (3.0 , 4.0) 01800809 ! 184: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01810809 ! 185: 0041 CONTINUE 01820809 ! 186: CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO 01830809 ! 187: IVTNUM = 5 01840809 ! 188: RWBVS = -3.0 01850809 ! 189: RWDVS = 0.0 01860809 ! 190: CWAVC = CMPLX(RWBVS, RWDVS) 01870809 ! 191: IF (R2E(1) + 3.0002) 20050, 40052, 40051 01880809 ! 192: 40051 IF (R2E(1) + 2.9998) 40052, 40052, 20050 01890809 ! 193: 40052 IF (R2E(2) + 0.00005) 20050, 10050, 40050 01900809 ! 194: 40050 IF (R2E(2) - 0.00005) 10050, 10050, 20050 01910809 ! 195: 10050 IVPASS = IVPASS + 1 01920809 ! 196: WRITE (NUVI, 80002) IVTNUM 01930809 ! 197: GO TO 0051 01940809 ! 198: 20050 IVFAIL = IVFAIL + 1 01950809 ! 199: ZVCORR = (-3.0, 0.0) 01960809 ! 200: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01970809 ! 201: 0051 CONTINUE 01980809 ! 202: CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE 01990809 ! 203: IVTNUM = 6 02000809 ! 204: RWBVS = 0.0 02010809 ! 205: RWDVS = -4.0 02020809 ! 206: CWAVC = CMPLX(RWBVS, RWDVS) 02030809 ! 207: IF (R2E(1) + 0.00005) 20060, 40062, 40061 02040809 ! 208: 40061 IF (R2E(1) - 0.00005) 40062, 40062, 20060 02050809 ! 209: 40062 IF (R2E(2) + 4.0002) 20060, 10060, 40060 02060809 ! 210: 40060 IF (R2E(2) + 3.9998) 10060, 10060, 20060 02070809 ! 211: 10060 IVPASS = IVPASS + 1 02080809 ! 212: WRITE (NUVI, 80002) IVTNUM 02090809 ! 213: GO TO 0061 02100809 ! 214: 20060 IVFAIL = IVFAIL + 1 02110809 ! 215: ZVCORR = (0.0, -4.0) 02120809 ! 216: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02130809 ! 217: 0061 CONTINUE 02140809 ! 218: CT007* TEST 7 PAIR OF NEGATIVE VALUES 02150809 ! 219: IVTNUM = 7 02160809 ! 220: RWBVS = -3.0 02170809 ! 221: RWDVS = -4.0 02180809 ! 222: CWAVC = CMPLX(RWBVS, RWDVS) 02190809 ! 223: IF (R2E(1) + 3.0002) 20070, 40072, 40071 02200809 ! 224: 40071 IF (R2E(1) + 2.9998) 40072, 40072, 20070 02210809 ! 225: 40072 IF (R2E(2) + 4.0002) 20070, 10070, 40070 02220809 ! 226: 40070 IF (R2E(2) + 3.9998) 10070, 10070, 20070 02230809 ! 227: 10070 IVPASS = IVPASS + 1 02240809 ! 228: WRITE (NUVI, 80002) IVTNUM 02250809 ! 229: GO TO 0071 02260809 ! 230: 20070 IVFAIL = IVFAIL + 1 02270809 ! 231: ZVCORR = (-3.0, -4.0) 02280809 ! 232: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02290809 ! 233: 0071 CONTINUE 02300809 ! 234: CT008* TEST 8 FIRST VALUE PRECEDED BY A MINUS SIGN 02310809 ! 235: IVTNUM = 8 02320809 ! 236: RWAVS = 3.0 02330809 ! 237: RWBVS = 0.0 02340809 ! 238: CWAVC = CMPLX(-RWAVS, RWBVS) 02350809 ! 239: IF (R2E(1) + 3.0002) 20080, 40082, 40081 02360809 ! 240: 40081 IF (R2E(1) + 2.9998) 40082, 40082, 20080 02370809 ! 241: 40082 IF (R2E(2) + 0.00005) 20080, 10080, 40080 02380809 ! 242: 40080 IF (R2E(2) - 0.00005) 10080, 10080, 20080 02390809 ! 243: 10080 IVPASS = IVPASS + 1 02400809 ! 244: WRITE (NUVI, 80002) IVTNUM 02410809 ! 245: GO TO 0081 02420809 ! 246: 20080 IVFAIL = IVFAIL + 1 02430809 ! 247: ZVCORR = (-3.0, 0.0) 02440809 ! 248: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02450809 ! 249: 0081 CONTINUE 02460809 ! 250: CT009* TEST 9 ONE ARGUMENT A CONSTANT, OTHER A VARIABLE 02470809 ! 251: IVTNUM = 9 02480809 ! 252: RWAVS = 4.0 02490809 ! 253: CWAVC = CMPLX(0.0, RWAVS) 02500809 ! 254: IF (R2E(1) + 0.00005) 20090, 40092, 40091 02510809 ! 255: 40091 IF (R2E(1) - 0.00005) 40092, 40092, 20090 02520809 ! 256: 40092 IF (R2E(2) - 3.9998) 20090, 10090, 40090 02530809 ! 257: 40090 IF (R2E(2) - 4.0002) 10090, 10090, 20090 02540809 ! 258: 10090 IVPASS = IVPASS + 1 02550809 ! 259: WRITE (NUVI, 80002) IVTNUM 02560809 ! 260: GO TO 0091 02570809 ! 261: 20090 IVFAIL = IVFAIL + 1 02580809 ! 262: ZVCORR = (0.0, 4.0) 02590809 ! 263: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02600809 ! 264: 0091 CONTINUE 02610809 ! 265: CT010* TEST 10 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02620809 ! 266: IVTNUM = 10 02630809 ! 267: RWAVS = 1.5 02640809 ! 268: RWBVS = 2.0 02650809 ! 269: RWCVS = 3.5 02660809 ! 270: CWAVC = CMPLX((RWCVS + RWAVS)/ RWBVS, (RWCVS - RWAVS) / RWBVS) 02670809 ! 271: IF (R2E(1) - 2.4998) 20100, 40102, 40101 02680809 ! 272: 40101 IF (R2E(1) - 2.5002) 40102, 40102, 20100 02690809 ! 273: 40102 IF (R2E(2) - 0.99995) 20100, 10100, 40100 02700809 ! 274: 40100 IF (R2E(2) - 1.0001) 10100, 10100, 20100 02710809 ! 275: 10100 IVPASS = IVPASS + 1 02720809 ! 276: WRITE (NUVI, 80002) IVTNUM 02730809 ! 277: GO TO 0101 02740809 ! 278: 20100 IVFAIL = IVFAIL + 1 02750809 ! 279: ZVCORR = (2.5, 1.0) 02760809 ! 280: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02770809 ! 281: 0101 CONTINUE 02780809 ! 282: C***** 02790809 ! 283: WRITE(NUVI, 90002) 02800809 ! 284: WRITE(NUVI, 90013) 02810809 ! 285: WRITE(NUVI, 90014) 02820809 ! 286: C***** 02830809 ! 287: C***** TEST OF AIMAG 02840809 ! 288: C***** 02850809 ! 289: WRITE(NUVI, 17004) 02860809 ! 290: 17004 FORMAT(/ 8X, 13HTEST OF AIMAG) 02870809 ! 291: CT011* TEST 11 THE COMPLEX VALUE ZERO (0,0) 02880809 ! 292: IVTNUM = 11 02890809 ! 293: RWAVS = AIMAG((0.0, 0.0)) 02900809 ! 294: IF (RWAVS + 0.00005) 20110, 10110, 40110 02910809 ! 295: 40110 IF (RWAVS - 0.00005) 10110, 10110, 20110 02920809 ! 296: 10110 IVPASS = IVPASS + 1 02930809 ! 297: WRITE (NUVI, 80002) IVTNUM 02940809 ! 298: GO TO 0111 02950809 ! 299: 20110 IVFAIL = IVFAIL + 1 02960809 ! 300: RVCORR = 0.0 02970809 ! 301: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 02980809 ! 302: 0111 CONTINUE 02990809 ! 303: CT012* TEST 12 COMPLEX VALUE HAVING ONLY A REAL COMPONENT 03000809 ! 304: IVTNUM = 12 03010809 ! 305: RWAVS = AIMAG((3.0, 0.0)) 03020809 ! 306: IF (RWAVS + 0.00005) 20120, 10120, 40120 03030809 ! 307: 40120 IF (RWAVS - 0.00005) 10120, 10120, 20120 03040809 ! 308: 10120 IVPASS = IVPASS + 1 03050809 ! 309: WRITE (NUVI, 80002) IVTNUM 03060809 ! 310: GO TO 0121 03070809 ! 311: 20120 IVFAIL = IVFAIL + 1 03080809 ! 312: RVCORR = 0.0 03090809 ! 313: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03100809 ! 314: 0121 CONTINUE 03110809 ! 315: CT013* TEST 13 ARBITRARY COMPLEX VALUE 03120809 ! 316: IVTNUM = 13 03130809 ! 317: RWAVS = AIMAG((3.0, 4.0)) 03140809 ! 318: IF (RWAVS - 3.9998) 20130, 10130, 40130 03150809 ! 319: 40130 IF (RWAVS - 4.0002) 10130, 10130, 20130 03160809 ! 320: 10130 IVPASS = IVPASS + 1 03170809 ! 321: WRITE (NUVI, 80002) IVTNUM 03180809 ! 322: GO TO 0131 03190809 ! 323: 20130 IVFAIL = IVFAIL + 1 03200809 ! 324: RVCORR = 4.0 03210809 ! 325: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03220809 ! 326: 0131 CONTINUE 03230809 ! 327: CT014* TEST 14 IMAGINARY COMPONENT A ZERO PRECEDED BY MINUS SIGN 03240809 ! 328: IVTNUM = 14 03250809 ! 329: RWAVS = AIMAG((-3.0, -0.0)) 03260809 ! 330: IF (RWAVS + 0.00005) 20140, 10140, 40140 03270809 ! 331: 40140 IF (RWAVS - 0.00005) 10140, 10140, 20140 03280809 ! 332: 10140 IVPASS = IVPASS + 1 03290809 ! 333: WRITE (NUVI, 80002) IVTNUM 03300809 ! 334: GO TO 0141 03310809 ! 335: 20140 IVFAIL = IVFAIL + 1 03320809 ! 336: RVCORR = 0.0 03330809 ! 337: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03340809 ! 338: 0141 CONTINUE 03350809 ! 339: CT015* TEST 15 ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS 03360809 ! 340: IVTNUM = 15 03370809 ! 341: RWAVS = AIMAG((-3.0, -4.0)) 03380809 ! 342: IF (RWAVS + 4.0002) 20150, 10150, 40150 03390809 ! 343: 40150 IF (RWAVS + 3.9998) 10150, 10150, 20150 03400809 ! 344: 10150 IVPASS = IVPASS + 1 03410809 ! 345: WRITE (NUVI, 80002) IVTNUM 03420809 ! 346: GO TO 0151 03430809 ! 347: 20150 IVFAIL = IVFAIL + 1 03440809 ! 348: RVCORR = -4.0 03450809 ! 349: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03460809 ! 350: 0151 CONTINUE 03470809 ! 351: CT016* TEST 16 COMPLEX VALUE ZERO (0,0) PRECEDED BY MINUS SIGN 03480809 ! 352: IVTNUM = 16 03490809 ! 353: CWDVC = (0.0, 0.0) 03500809 ! 354: RWAVS = AIMAG(-CWDVC) 03510809 ! 355: IF (RWAVS + 0.00005) 20160, 10160, 40160 03520809 ! 356: 40160 IF (RWAVS - 0.00005) 10160, 10160, 20160 03530809 ! 357: 10160 IVPASS = IVPASS + 1 03540809 ! 358: WRITE (NUVI, 80002) IVTNUM 03550809 ! 359: GO TO 0161 03560809 ! 360: 20160 IVFAIL = IVFAIL + 1 03570809 ! 361: RVCORR = 0.0 03580809 ! 362: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03590809 ! 363: 0161 CONTINUE 03600809 ! 364: CT017* TEST 17 ARGUMENT IS A COMPLEX EXPRESSION 03610809 ! 365: IVTNUM = 17 03620809 ! 366: CWDVC = (3.5, 4.5) 03630809 ! 367: CWEVC = (4.0, 5.0) 03640809 ! 368: RWAVS = AIMAG(CWDVC - CWEVC) 03650809 ! 369: IF (RWAVS + 0.50003) 20170, 10170, 40170 03660809 ! 370: 40170 IF (RWAVS + 0.49997) 10170, 10170, 20170 03670809 ! 371: 10170 IVPASS = IVPASS + 1 03680809 ! 372: WRITE (NUVI, 80002) IVTNUM 03690809 ! 373: GO TO 0171 03700809 ! 374: 20170 IVFAIL = IVFAIL + 1 03710809 ! 375: RVCORR = -0.5 03720809 ! 376: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03730809 ! 377: 0171 CONTINUE 03740809 ! 378: CT018* TEST 18 CONJG FORMS ARGUMENT TO AIMAG 03750809 ! 379: IVTNUM = 18 03760809 ! 380: CWDVC = (3.0, 4.0) 03770809 ! 381: RWAVS = AIMAG(CONJG(CWDVC)) 03780809 ! 382: IF (RWAVS + 4.0002) 20180, 10180, 40180 03790809 ! 383: 40180 IF (RWAVS + 3.9998) 10180, 10180, 20180 03800809 ! 384: 10180 IVPASS = IVPASS + 1 03810809 ! 385: WRITE (NUVI, 80002) IVTNUM 03820809 ! 386: GO TO 0181 03830809 ! 387: 20180 IVFAIL = IVFAIL + 1 03840809 ! 388: RVCORR = -4.0 03850809 ! 389: WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03860809 ! 390: 0181 CONTINUE 03870809 ! 391: C***** 03880809 ! 392: WRITE(NUVI, 90002) 03890809 ! 393: WRITE(NUVI, 90013) 03900809 ! 394: WRITE(NUVI, 90014) 03910809 ! 395: C***** 03920809 ! 396: C***** TEST OF CONJG 03930809 ! 397: C***** 03940809 ! 398: WRITE (NUVI,17006) 03950809 ! 399: 17006 FORMAT (/ 8X, 13HTEST OF CONJG) 03960809 ! 400: CT019* TEST 19 COMPLEX VALUE ZERO (0,0) 03970809 ! 401: IVTNUM = 19 03980809 ! 402: CWAVC = CONJG((0.0, 0.0)) 03990809 ! 403: IF (R2E(1) + 0.00005) 20190, 40192, 40191 04000809 ! 404: 40191 IF (R2E(1) - 0.00005) 40192, 40192, 20190 04010809 ! 405: 40192 IF (R2E(2) + 0.00005) 20190, 10190, 40190 04020809 ! 406: 40190 IF (R2E(2) - 0.00005) 10190, 10190, 20190 04030809 ! 407: 10190 IVPASS = IVPASS + 1 04040809 ! 408: WRITE (NUVI, 80002) IVTNUM 04050809 ! 409: GO TO 0191 04060809 ! 410: 20190 IVFAIL = IVFAIL + 1 04070809 ! 411: ZVCORR = (0.0, 0.0) 04080809 ! 412: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04090809 ! 413: 0191 CONTINUE 04100809 ! 414: CT020* TEST 20 COMPLEX VALUE HAVING ONLY REAL COMPONENT 04110809 ! 415: IVTNUM = 20 04120809 ! 416: CWAVC = CONJG((3.0, 0.0)) 04130809 ! 417: IF (R2E(1) - 2.9998) 20200, 40202, 40201 04140809 ! 418: 40201 IF (R2E(1) - 3.0002) 40202, 40202, 20200 04150809 ! 419: 40202 IF (R2E(2) + 0.00005) 20200, 10200, 40200 04160809 ! 420: 40200 IF (R2E(2) - 0.00005) 10200, 10200, 20200 04170809 ! 421: 10200 IVPASS = IVPASS + 1 04180809 ! 422: WRITE (NUVI, 80002) IVTNUM 04190809 ! 423: GO TO 0201 04200809 ! 424: 20200 IVFAIL = IVFAIL + 1 04210809 ! 425: ZVCORR = (3.0, 0.0) 04220809 ! 426: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04230809 ! 427: 0201 CONTINUE 04240809 ! 428: CT021* TEST 21 ARBITRARY COMPLEX VALUE 04250809 ! 429: IVTNUM = 21 04260809 ! 430: CWAVC = CONJG((3.0, 4.0)) 04270809 ! 431: IF (R2E(1) - 2.9998) 20210, 40212, 40211 04280809 ! 432: 40211 IF (R2E(1) - 3.0002) 40212, 40212, 20210 04290809 ! 433: 40212 IF (R2E(2) + 4.0002) 20210, 10210, 40210 04300809 ! 434: 40210 IF (R2E(2) + 3.9998) 10210, 10210, 20210 04310809 ! 435: 10210 IVPASS = IVPASS + 1 04320809 ! 436: WRITE (NUVI, 80002) IVTNUM 04330809 ! 437: GO TO 0211 04340809 ! 438: 20210 IVFAIL = IVFAIL + 1 04350809 ! 439: ZVCORR = (3.0, -4.0) 04360809 ! 440: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04370809 ! 441: 0211 CONTINUE 04380809 ! 442: CWBVC = (3.0, -4.0) 04390809 ! 443: CT022* TEST 22 SECOND ARGUMENT IS A ZERO PRECEDED BY MINUS SIGN 04400809 ! 444: IVTNUM = 22 04410809 ! 445: CWAVC = CONJG((-3.0, -0.0)) 04420809 ! 446: IF (R2E(1) + 3.0002) 20220, 40222, 40221 04430809 ! 447: 40221 IF (R2E(1) + 2.9998) 40222, 40222, 20220 04440809 ! 448: 40222 IF (R2E(2) + 0.00005) 20220, 10220, 40220 04450809 ! 449: 40220 IF (R2E(2) - 0.00005) 10220, 10220, 20220 04460809 ! 450: 10220 IVPASS = IVPASS + 1 04470809 ! 451: WRITE (NUVI, 80002) IVTNUM 04480809 ! 452: GO TO 0221 04490809 ! 453: 20220 IVFAIL = IVFAIL + 1 04500809 ! 454: ZVCORR = (-3.0, 0.0) 04510809 ! 455: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04520809 ! 456: 0221 CONTINUE 04530809 ! 457: CT023* TEST 23 ABITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS 04540809 ! 458: IVTNUM = 23 04550809 ! 459: CWAVC = CONJG((-3.0, -4.0)) 04560809 ! 460: IF (R2E(1) + 3.0002) 20230, 40232, 40231 04570809 ! 461: 40231 IF (R2E(1) + 2.9998) 40232, 40232, 20230 04580809 ! 462: 40232 IF (R2E(2) - 3.9998) 20230, 10230, 40230 04590809 ! 463: 40230 IF (R2E(2) - 4.0002) 10230, 10230, 20230 04600809 ! 464: 10230 IVPASS = IVPASS + 1 04610809 ! 465: WRITE (NUVI, 80002) IVTNUM 04620809 ! 466: GO TO 0231 04630809 ! 467: 20230 IVFAIL = IVFAIL + 1 04640809 ! 468: ZVCORR = (-3.0, 4.0) 04650809 ! 469: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04660809 ! 470: 0231 CONTINUE 04670809 ! 471: CWBVC = (-3.0, 4.0) 04680809 ! 472: CT024* TEST 24 COMPLEX ZERO PRECEDED BY A MINUS SIGN 04690809 ! 473: IVTNUM = 24 04700809 ! 474: CWDVC = (0.0, 0.0) 04710809 ! 475: CWAVC = CONJG(-CWDVC) 04720809 ! 476: IF (R2E(1) + 0.00005) 20240, 40242, 40241 04730809 ! 477: 40241 IF (R2E(1) - 0.00005) 40242, 40242, 20240 04740809 ! 478: 40242 IF (R2E(2) + 0.00005) 20240, 10240, 40240 04750809 ! 479: 40240 IF (R2E(2) - 0.00005) 10240, 10240, 20240 04760809 ! 480: 10240 IVPASS = IVPASS + 1 04770809 ! 481: WRITE (NUVI, 80002) IVTNUM 04780809 ! 482: GO TO 0241 04790809 ! 483: 20240 IVFAIL = IVFAIL + 1 04800809 ! 484: ZVCORR = (0.0, 0.0) 04810809 ! 485: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04820809 ! 486: 0241 CONTINUE 04830809 ! 487: CT025* TEST 25 COMPLEX EXPRESSION PRESENTED AS ARGUMENT 04840809 ! 488: IVTNUM = 25 04850809 ! 489: CWDVC = (3.5, 4.5) 04860809 ! 490: CWEVC = (4.0, 5.0) 04870809 ! 491: CWAVC = CONJG(CWDVC - CWEVC) 04880809 ! 492: IF (R2E(1) + 0.50003) 20250, 40252, 40251 04890809 ! 493: 40251 IF (R2E(1) + 0.49997) 40252, 40252, 20250 04900809 ! 494: 40252 IF (R2E(2) - 0.49997) 20250, 10250, 40250 04910809 ! 495: 40250 IF (R2E(2) - 0.50003) 10250, 10250, 20250 04920809 ! 496: 10250 IVPASS = IVPASS + 1 04930809 ! 497: WRITE (NUVI, 80002) IVTNUM 04940809 ! 498: GO TO 0251 04950809 ! 499: 20250 IVFAIL = IVFAIL + 1 04960809 ! 500: ZVCORR = (-0.5, 0.5) 04970809 ! 501: WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04980809 ! 502: 0251 CONTINUE 04990809 ! 503: C***** 05000809 ! 504: CBB** ********************** BBCSUM0 **********************************05010809 ! 505: C**** WRITE OUT TEST SUMMARY 05020809 ! 506: C**** 05030809 ! 507: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05040809 ! 508: WRITE (I02, 90004) 05050809 ! 509: WRITE (I02, 90014) 05060809 ! 510: WRITE (I02, 90004) 05070809 ! 511: WRITE (I02, 90020) IVPASS 05080809 ! 512: WRITE (I02, 90022) IVFAIL 05090809 ! 513: WRITE (I02, 90024) IVDELE 05100809 ! 514: WRITE (I02, 90026) IVINSP 05110809 ! 515: WRITE (I02, 90028) IVTOTN, IVTOTL 05120809 ! 516: CBE** ********************** BBCSUM0 **********************************05130809 ! 517: CBB** ********************** BBCFOOT0 **********************************05140809 ! 518: C**** WRITE OUT REPORT FOOTINGS 05150809 ! 519: C**** 05160809 ! 520: WRITE (I02,90016) ZPROG, ZPROG 05170809 ! 521: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05180809 ! 522: WRITE (I02,90019) 05190809 ! 523: CBE** ********************** BBCFOOT0 **********************************05200809 ! 524: CBB** ********************** BBCFMT0A **********************************05210809 ! 525: C**** FORMATS FOR TEST DETAIL LINES 05220809 ! 526: C**** 05230809 ! 527: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 05240809 ! 528: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 05250809 ! 529: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 05260809 ! 530: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 05270809 ! 531: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 05280809 ! 532: 1I6,/,1H ,15X,10HCORRECT= ,I6) 05290809 ! 533: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05300809 ! 534: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 05310809 ! 535: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05320809 ! 536: 1A21,/,1H ,16X,10HCORRECT= ,A21) 05330809 ! 537: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 05340809 ! 538: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 05350809 ! 539: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 05360809 ! 540: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 05370809 ! 541: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 05380809 ! 542: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 05390809 ! 543: 80050 FORMAT (1H ,48X,A31) 05400809 ! 544: CBE** ********************** BBCFMT0A **********************************05410809 ! 545: CBB** ********************** BBCFMAT1 **********************************05420809 ! 546: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05430809 ! 547: C**** 05440809 ! 548: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05450809 ! 549: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 05460809 ! 550: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 05470809 ! 551: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 05480809 ! 552: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 05490809 ! 553: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 05500809 ! 554: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 05510809 ! 555: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 05520809 ! 556: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 05530809 ! 557: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 05540809 ! 558: 21H(,F12.5,2H, ,F12.5,1H)) 05550809 ! 559: CBE** ********************** BBCFMAT1 **********************************05560809 ! 560: CBB** ********************** BBCFMT0B **********************************05570809 ! 561: C**** FORMAT STATEMENTS FOR PAGE HEADERS 05580809 ! 562: C**** 05590809 ! 563: 90002 FORMAT (1H1) 05600809 ! 564: 90004 FORMAT (1H ) 05610809 ! 565: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 05620809 ! 566: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 05630809 ! 567: 90008 FORMAT (1H ,21X,A13,A17) 05640809 ! 568: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 05650809 ! 569: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 05660809 ! 570: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 05670809 ! 571: 1 7X,7HREMARKS,24X) 05680809 ! 572: 90014 FORMAT (1H ,46H----------------------------------------------, 05690809 ! 573: 1 33H---------------------------------) 05700809 ! 574: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 05710809 ! 575: C**** 05720809 ! 576: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05730809 ! 577: C**** 05740809 ! 578: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 05750809 ! 579: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 05760809 ! 580: 1 A13) 05770809 ! 581: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 05780809 ! 582: C**** 05790809 ! 583: C**** FORMAT STATEMENTS FOR RUN SUMMARY 05800809 ! 584: C**** 05810809 ! 585: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 05820809 ! 586: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 05830809 ! 587: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 05840809 ! 588: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 05850809 ! 589: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 05860809 ! 590: CBE** ********************** BBCFMT0B **********************************05870809 ! 591: C***** 05880809 ! 592: C***** END OF TEST SEGMENT 170 05890809 ! 593: STOP 05900809 ! 594: END 05910809 ! 595: 05920809
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.