![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM722.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 FM722.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 FM722 00010722 ! 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 00020722 ! 6: C ************************************************************* 00030722 ! 7: C THE FULL LANGUAGE SET ALLOWS DATA TYPES TO BE DECLARED DOUBLE 00040722 ! 8: C PRECISION AND COMPLEX. 00050722 ! 9: C (FSTC TEST/PROGRAM IDENTIFICATION S04AF-2P) 00060722 ! 10: C ************************************************************* 00070722 ! 11: C REFERENCES. 00080722 ! 12: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00090722 ! 13: C X3.9-1978 00100722 ! 14: C 00110722 ! 15: C SECTION 4 DATA TYPES AND CONSTANTS 00120722 ! 16: C PARAGRAPHS: 00130722 ! 17: C 00140722 ! 18: C 4.1 00150722 ! 19: C 4.1.2 00160722 ! 20: C 00170722 ! 21: C SECTION 8 SPECIFICATION STATEMENTS 00180722 ! 22: C PARAGRAPHS: 00190722 ! 23: C 8.4.1 00200722 ! 24: C 8.6 00210722 ! 25: C 00220722 ! 26: C TEST DATA TYPES DOUBLE PRECISION AND COMPLEX USING: 00230722 ! 27: C 00240722 ! 28: C TYP V [,V1] 00250722 ! 29: C 00260722 ! 30: C TYP = DOUBLE PRECISION OR COMPLEX 00270722 ! 31: C V = VARIABLE NAME, ARRAY NAME, ARRAY DECLARATOR, 00280722 ! 32: C SYMBOLIC NAME OF A CONSTANT, FUNCTION NAME, 00290722 ! 33: C OR DUMMY PROCEDURE NAME 00300722 ! 34: C 00310722 ! 35: C FM722 USES FUNCTIONS DF723, ZF724 AND SUBROUTINE SN725 00320722 ! 36: C **************************************************************** 00330722 ! 37: C 00340722 ! 38: CBB** ********************** BBCCOMNT **********************************00350722 ! 39: C**** 00360722 ! 40: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00370722 ! 41: C**** VERSION 2.0 00380722 ! 42: C**** 00390722 ! 43: C**** 00400722 ! 44: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00410722 ! 45: C**** GENERAL SERVICES ADMINISTRATION 00420722 ! 46: C**** FEDERAL SOFTWARE TESTING CENTER 00430722 ! 47: C**** 5203 LEESBURG PIKE, SUITE 1100 00440722 ! 48: C**** FALLS CHURCH, VA. 22041 00450722 ! 49: C**** 00460722 ! 50: C**** (703) 756-6153 00470722 ! 51: C**** 00480722 ! 52: CBE** ********************** BBCCOMNT **********************************00490722 ! 53: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00500722 ! 54: IMPLICIT CHARACTER*27 (C) 00510722 ! 55: C 00520722 ! 56: CBB** ********************** BBCINITA **********************************00530722 ! 57: C**** SPECIFICATION STATEMENTS 00540722 ! 58: C**** 00550722 ! 59: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00560722 ! 60: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00570722 ! 61: CBE** ********************** BBCINITA **********************************00580722 ! 62: DOUBLE PRECISION NVCOMP,DF723 00590722 ! 63: COMPLEX ICP001,I2N002(2),ZF724 00600722 ! 64: REAL R2NN02(2) 00610722 ! 65: EQUIVALENCE (ZVCOMP,R2NN02) 00620722 ! 66: PARAMETER (DPN001=5.834D6,IPN001=2,DCN004=1.456D3) 00630722 ! 67: PARAMETER (ICP001=(3.2, 2.3)) 00640722 ! 68: DIMENSION D2N001(IPN001) 00650722 ! 69: EXTERNAL DF723,ZF724 00660722 ! 70: COMMON /BVN001/ DVC006 00670722 ! 71: DATA D2N001(1),D2N001(2) / IPN001*DCN004 / 00680722 ! 72: DATA I2N002(1),I2N002(2) / IPN001*(3.2, 2.3) / 00690722 ! 73: DSN001(DVN003,DVN004) = DVN003 + DVN004 00700722 ! 74: DSN006(DVN007,DVN008) = (DSN001(DVN007,DVN007) + DVN008) 00710722 ! 75: ZSN001(RVN001,RVN002) = CMPLX(RVN001,RVN002) + 00720722 ! 76: 1CMPLX(RVN002,RVN002) 00730722 ! 77: C 00740722 ! 78: C 00750722 ! 79: CBB** ********************** BBCINITB **********************************00760722 ! 80: C**** INITIALIZE SECTION 00770722 ! 81: DATA ZVERS, ZVERSD, ZDATE 00780722 ! 82: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00790722 ! 83: DATA ZCOMPL, ZNAME, ZTAPE 00800722 ! 84: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00810722 ! 85: DATA ZPROJ, ZTAPED, ZPROG 00820722 ! 86: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00830722 ! 87: DATA REMRKS /' '/ 00840722 ! 88: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00850722 ! 89: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00860722 ! 90: C**** 00870722 ! 91: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00880722 ! 92: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00890722 ! 93: CZ03 ZPROG = 'PROGRAM NAME' 00900722 ! 94: ZDATE = '07-Nov-85 ' *RP ! 95: ZCOMPL = 'CCI 5.2 ' *RP ! 96: ZPROJ = 'TC-85- -410' *RP ! 97: ZNAME = ' ' *RP ! 98: ZTAPE = ' ' *RP ! 99: ZTAPED = '850703 ' *RP ! 100: C 00970722 ! 101: IVPASS = 0 00980722 ! 102: IVFAIL = 0 00990722 ! 103: IVDELE = 0 01000722 ! 104: IVINSP = 0 01010722 ! 105: IVTOTL = 0 01020722 ! 106: IVTOTN = 0 01030722 ! 107: ICZERO = 0 01040722 ! 108: C 01050722 ! 109: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01060722 ! 110: I01 = 05 01070722 ! 111: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01080722 ! 112: I02 = 06 01090722 ! 113: C 01100722 ! 114: I01 = 5 01110722 ! 115: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01120722 ! 116: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01130722 ! 117: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01140722 ! 118: C 01150722 ! 119: I02 = 6 01160722 ! 120: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01170722 ! 121: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01180722 ! 122: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01190722 ! 123: C 01200722 ! 124: CBE** ********************** BBCINITB **********************************01210722 ! 125: ZPROG='FM722' 01220722 ! 126: IVTOTL = 12 01230722 ! 127: CBB** ********************** BBCHED0A **********************************01240722 ! 128: C**** 01250722 ! 129: C**** WRITE REPORT TITLE 01260722 ! 130: C**** 01270722 ! 131: WRITE (I02, 90002) 01280722 ! 132: WRITE (I02, 90006) 01290722 ! 133: WRITE (I02, 90007) 01300722 ! 134: WRITE (I02, 90008) ZVERS, ZVERSD 01310722 ! 135: WRITE (I02, 90009) ZPROG, ZPROG 01320722 ! 136: WRITE (I02, 90010) ZDATE, ZCOMPL 01330722 ! 137: CBE** ********************** BBCHED0A **********************************01340722 ! 138: CBB** ********************** BBCHED0B **********************************01350722 ! 139: C**** WRITE DETAIL REPORT HEADERS 01360722 ! 140: C**** 01370722 ! 141: WRITE (I02,90004) 01380722 ! 142: WRITE (I02,90004) 01390722 ! 143: WRITE (I02,90013) 01400722 ! 144: WRITE (I02,90014) 01410722 ! 145: WRITE (I02,90015) IVTOTL 01420722 ! 146: CBE** ********************** BBCHED0B **********************************01430722 ! 147: C 01440722 ! 148: CT001* TEST 001 **** FCVS PROGRAM 722 **** 01450722 ! 149: C 01460722 ! 150: C TEST 001 IS DESIGNED TO TEST A DOUBLE PRECISION CONSTANT 01470722 ! 151: C VALUE SET WITH PARAMETER STATEMENT 01480722 ! 152: C 01490722 ! 153: IVTNUM = 1 01500722 ! 154: DVCOMP=0.0D0 01510722 ! 155: DVCOMP=DPN001 01520722 ! 156: DVCORR=5.834D6 01530722 ! 157: IF (DPN001 - 5.833999997D6) 20010,10010,40010 01540722 ! 158: 40010 IF (DPN001 - 5.834000003D6) 10010,10010,20010 01550722 ! 159: 10010 IVPASS = IVPASS + 1 01560722 ! 160: WRITE (I02,80002) IVTNUM 01570722 ! 161: GO TO 0011 01580722 ! 162: 20010 IVFAIL = IVFAIL + 1 01590722 ! 163: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01600722 ! 164: 0011 CONTINUE 01610722 ! 165: C 01620722 ! 166: CT002* TEST 002 **** FCVS PROGRAM 722 **** 01630722 ! 167: C 01640722 ! 168: C TEST 002 IS DESIGNED TO TEST A DOUBLE PRECISION VARIABLE 01650722 ! 169: C 01660722 ! 170: IVTNUM = 2 01670722 ! 171: DVCOMP=0.0D0 01680722 ! 172: NVCOMP=.1212345D2 01690722 ! 173: DVCOMP=NVCOMP 01700722 ! 174: DVCORR=.1212345D2 01710722 ! 175: IF (NVCOMP - .1212344999D2) 20020,40021,40020 01720722 ! 176: 40020 IF (NVCOMP - .1212345001D2) 40021,40021,20020 01730722 ! 177: 40021 DVCOMP = DVCOMP + .1212345D2 01740722 ! 178: DVCORR=.2424690D2 01750722 ! 179: IF (DVCOMP - .2424689998D2) 20020,10020,40022 01760722 ! 180: 40022 IF (DVCOMP - .2424690002D2) 10020,10020,20020 01770722 ! 181: 10020 IVPASS = IVPASS + 1 01780722 ! 182: WRITE (I02,80002) IVTNUM 01790722 ! 183: GO TO 0021 01800722 ! 184: 20020 IVFAIL = IVFAIL + 1 01810722 ! 185: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01820722 ! 186: 0021 CONTINUE 01830722 ! 187: C 01840722 ! 188: CT003* TEST 003 **** FCVS PROGRAM 722 **** 01850722 ! 189: C 01860722 ! 190: C TEST 003 A DOUBLE PRECISION ARRAY 01870722 ! 191: C 01880722 ! 192: IVTNUM = 3 01890722 ! 193: DVCOMP=0.0D0 01900722 ! 194: DVCORR=2.912D3 01910722 ! 195: DVCOMP=D2N001(1) + D2N001(2) 01920722 ! 196: IF (DVCOMP - 2.911999998D3) 20030,10030,40030 01930722 ! 197: 40030 IF (DVCOMP - 2.912000002D3) 10030,10030,20030 01940722 ! 198: 10030 IVPASS = IVPASS + 1 01950722 ! 199: WRITE (I02,80002) IVTNUM 01960722 ! 200: GO TO 0031 01970722 ! 201: 20030 IVFAIL = IVFAIL + 1 01980722 ! 202: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01990722 ! 203: 0031 CONTINUE 02000722 ! 204: C 02010722 ! 205: CT004* TEST 004 **** FCVS PROGRAM 722 **** 02020722 ! 206: C 02030722 ! 207: C TEST 004 IS DESIGNED TO TEST A DOUBLE PRECISION FUNCTION 02040722 ! 208: C DF723 02050722 ! 209: C 02060722 ! 210: IVTNUM = 4 02070722 ! 211: DVCOMP=0.0D0 02080722 ! 212: DVN009=.1211D2 02090722 ! 213: DVCOMP=DF723(DVN009) 02100722 ! 214: DVCORR=1.001211D4 02110722 ! 215: IF (DVCOMP - 1.001210999D4) 20040,10040,40040 02120722 ! 216: 40040 IF (DVCOMP - 1.001211001D4) 10040,10040,20040 02130722 ! 217: 10040 IVPASS = IVPASS + 1 02140722 ! 218: WRITE (I02,80002) IVTNUM 02150722 ! 219: GO TO 0041 02160722 ! 220: 20040 IVFAIL = IVFAIL + 1 02170722 ! 221: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02180722 ! 222: 0041 CONTINUE 02190722 ! 223: C 02200722 ! 224: CT005* TEST 005 **** FCVS PROGRAM 722 **** 02210722 ! 225: C 02220722 ! 226: C TEST 005 IS DESIGNED TO TEST A DOUBLE PRECISION DUMMY 02230722 ! 227: C PROCEDURE (DF723 USED AS DUMMY ARGUMENT FOR SUBROUTINE 02240722 ! 228: C FS528 02250722 ! 229: C 02260722 ! 230: IVTNUM = 5 02270722 ! 231: DVCOMP=0.0D0 02280722 ! 232: DVCORR=1200000.0D-2 02290722 ! 233: DVN009=0.0D0 02300722 ! 234: DVN009=10D2 02310722 ! 235: CALL SN725(DF723,DVN009) 02320722 ! 236: DVCOMP=DVC006 02330722 ! 237: IF (DVCOMP - .1199999999D5) 20050,10050,40050 02340722 ! 238: 40050 IF (DVCOMP - .1200000001D5) 10050,10050,20050 02350722 ! 239: 10050 IVPASS = IVPASS + 1 02360722 ! 240: WRITE (I02,80002) IVTNUM 02370722 ! 241: GO TO 0051 02380722 ! 242: 20050 IVFAIL = IVFAIL + 1 02390722 ! 243: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02400722 ! 244: 0051 CONTINUE 02410722 ! 245: C 02420722 ! 246: CT006* TEST 006 **** FCVS PROGRAM 722 **** 02430722 ! 247: C 02440722 ! 248: C TEST 006 DOUBLE PRECISION FUNCTION NAME USING 02450722 ! 249: C STATEMENT FUNCTION STATEMENT 02460722 ! 250: C 02470722 ! 251: IVTNUM = 6 02480722 ! 252: DVCOMP=0.0D0 02490722 ! 253: DVCORR=20D2 02500722 ! 254: DVN009=10D2 02510722 ! 255: DVN010=10D2 02520722 ! 256: DVCOMP=DSN001(DVN009,DVN010) 02530722 ! 257: IF (DVCOMP - 19.99999999D2) 20060,10060,40060 02540722 ! 258: 40060 IF (DVCOMP - 20.00000001D2) 10060,10060,20060 02550722 ! 259: 10060 IVPASS = IVPASS + 1 02560722 ! 260: WRITE (I02,80002) IVTNUM 02570722 ! 261: GO TO 0061 02580722 ! 262: 20060 IVFAIL = IVFAIL + 1 02590722 ! 263: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02600722 ! 264: 0061 CONTINUE 02610722 ! 265: C 02620722 ! 266: CT007* TEST 007 **** FCVS PROGRAM 722 **** 02630722 ! 267: C 02640722 ! 268: C TEST 007 DOUBLE PRECISION FUNCTION NAME USED IN 02650722 ! 269: C A STATEMENT FUNCTION STATEMENT AS A DUMMY ARGUMENT 02660722 ! 270: C 02670722 ! 271: IVTNUM = 7 02680722 ! 272: DVCOMP=0.0D0 02690722 ! 273: DVCORR=30D2 02700722 ! 274: DVN009=10D2 02710722 ! 275: DVN010=10D2 02720722 ! 276: DVCOMP=DSN006(DVN009,DVN010) 02730722 ! 277: IF (DVCOMP - 29.99999998D2) 20070,10070,40070 02740722 ! 278: 40070 IF (DVCOMP - 30.00000002D2) 10070,10070,20070 02750722 ! 279: 10070 IVPASS = IVPASS + 1 02760722 ! 280: WRITE (I02,80002) IVTNUM 02770722 ! 281: GO TO 0071 02780722 ! 282: 20070 IVFAIL = IVFAIL + 1 02790722 ! 283: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02800722 ! 284: 0071 CONTINUE 02810722 ! 285: C 02820722 ! 286: C THE FOLLOWING GROUP OF TESTS ARE DESIGNED TO 02830722 ! 287: C TEST COMPLEX DATA TYPES 02840722 ! 288: C 02850722 ! 289: C 02860722 ! 290: CT008* TEST 008 **** FCVS PROGRAM 722 **** 02870722 ! 291: C 02880722 ! 292: C TEST 008 DATA TYPE CAN BE A COMPLEX VARIABLE 02890722 ! 293: C 02900722 ! 294: IVTNUM = 8 02910722 ! 295: ZVCOMP=(0.0, 0.0) 02920722 ! 296: ZVCORR=(1.0, 1.0) 02930722 ! 297: ZVN001=(6.5, 2.2) 02940722 ! 298: ZVN002=(5.5, 1.2) 02950722 ! 299: ZVCOMP=ZVN001-ZVN002 02960722 ! 300: IF (R2NN02(1) - 0.9995) 20080,40081,40080 02970722 ! 301: 40080 IF (R2NN02(1) - 1.0001) 40081,40081,20080 02980722 ! 302: 40081 IF (R2NN02(2) - 0.9995) 20080,10080,40082 02990722 ! 303: 40082 IF (R2NN02(2) - 1.0001) 10080,10080,20080 03000722 ! 304: 10080 IVPASS = IVPASS + 1 03010722 ! 305: WRITE (I02,80002) IVTNUM 03020722 ! 306: GO TO 0081 03030722 ! 307: 20080 IVFAIL = IVFAIL + 1 03040722 ! 308: WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03050722 ! 309: 0081 CONTINUE 03060722 ! 310: C 03070722 ! 311: CT009* TEST 009 **** FCVS PROGRAM 722 **** 03080722 ! 312: C 03090722 ! 313: C TEST 009 COMPLEX CONSTANT 03100722 ! 314: C 03110722 ! 315: IVTNUM = 9 03120722 ! 316: ZVCOMP=(0.0, 0.0) 03130722 ! 317: ZVCORR=(6.4, 4.6) 03140722 ! 318: ZVCOMP=ICP001+ICP001 03150722 ! 319: IF (R2NN02(1) - 6.3996) 20090,10090,40090 03160722 ! 320: 40090 IF (R2NN02(1) - 6.4004) 40091,40091,20090 03170722 ! 321: 40091 IF (R2NN02(2) - 4.5997) 20090,10090,40092 03180722 ! 322: 40092 IF (R2NN02(2) - 4.6003) 10090,10090,20090 03190722 ! 323: 10090 IVPASS = IVPASS + 1 03200722 ! 324: WRITE (I02,80002) IVTNUM 03210722 ! 325: GO TO 0091 03220722 ! 326: 20090 IVFAIL = IVFAIL + 1 03230722 ! 327: WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03240722 ! 328: 0091 CONTINUE 03250722 ! 329: C 03260722 ! 330: CT010* TEST 010 **** FCVS PROGRAM 722 **** 03270722 ! 331: C 03280722 ! 332: C TEST 010 COMPLEX ARRAY 03290722 ! 333: C 03300722 ! 334: IVTNUM = 10 03310722 ! 335: ZVCOMP=(0.0, 0.0) 03320722 ! 336: ZVCORR=(6.4, 4.6) 03330722 ! 337: ZVCOMP=I2N002(1)+I2N002(2) 03340722 ! 338: IF (R2NN02(1) - 6.3996) 20100,10100,40100 03350722 ! 339: 40100 IF (R2NN02(1) - 6.4004) 40101,40101,20100 03360722 ! 340: 40101 IF (R2NN02(2) - 4.5997) 20100,10100,40102 03370722 ! 341: 40102 IF (R2NN02(2) - 4.6003) 10100,10100,20100 03380722 ! 342: 10100 IVPASS = IVPASS + 1 03390722 ! 343: WRITE (I02,80002) IVTNUM 03400722 ! 344: GO TO 0101 03410722 ! 345: 20100 IVFAIL = IVFAIL + 1 03420722 ! 346: WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03430722 ! 347: 0101 CONTINUE 03440722 ! 348: C 03450722 ! 349: CT011* TEST 011 **** FCVS PROGRAM 722 **** 03460722 ! 350: C 03470722 ! 351: C TEST 011 COMPLEX FUNCTION NAME (USING STATEMENT FUNCTION) 03480722 ! 352: C FUNCTION NAME CAN BE COMPLEX 03490722 ! 353: C 03500722 ! 354: IVTNUM = 11 03510722 ! 355: ZVCORR=(3.0, 4.0) 03520722 ! 356: ZVCOMP=(0.0, 0.0) 03530722 ! 357: RVN004=1.0 03540722 ! 358: RVN005=2.0 03550722 ! 359: ZVCOMP=(ZSN001(RVN004,RVN005)) 03560722 ! 360: IF (R2NN02(1) - 2.9998) 20110,10110,40110 03570722 ! 361: 40110 IF (R2NN02(1) - 3.0002) 40111,40111,20110 03580722 ! 362: 40111 IF (R2NN02(2) - 3.9998) 20110,10110,40112 03590722 ! 363: 40112 IF (R2NN02(2) - 4.0002) 10110,10110,20110 03600722 ! 364: 10110 IVPASS = IVPASS + 1 03610722 ! 365: WRITE (I02,80002) IVTNUM 03620722 ! 366: GO TO 0111 03630722 ! 367: 20110 IVFAIL = IVFAIL + 1 03640722 ! 368: WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03650722 ! 369: 0111 CONTINUE 03660722 ! 370: C 03670722 ! 371: CT012* TEST 012 **** FCVS PROGRAM 722 **** 03680722 ! 372: C 03690722 ! 373: C TEST 012 TEST COMPLEX FUNCTION NAME IN A FUNCTION SUBPROGRAM 03700722 ! 374: C 03710722 ! 375: IVTNUM = 12 03720722 ! 376: ZVCORR=(3.0, 4.0) 03730722 ! 377: ZVCOMP=(0.0, 0.0) 03740722 ! 378: RVN004=1.0 03750722 ! 379: RVN005=2.0 03760722 ! 380: ZVCOMP=ZF724(RVN004,RVN005) 03770722 ! 381: IF (R2NN02(1) - 2.9998) 20120,10120,40120 03780722 ! 382: 40120 IF (R2NN02(1) - 3.0002) 40121,40121,20120 03790722 ! 383: 40121 IF (R2NN02(2) - 3.9998) 20120,10120,40122 03800722 ! 384: 40122 IF (R2NN02(2) - 4.0002) 10120,10120,20120 03810722 ! 385: 10120 IVPASS = IVPASS + 1 03820722 ! 386: WRITE (I02,80002) IVTNUM 03830722 ! 387: GO TO 0121 03840722 ! 388: 20120 IVFAIL = IVFAIL + 1 03850722 ! 389: WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03860722 ! 390: 0121 CONTINUE 03870722 ! 391: C 03880722 ! 392: CBB** ********************** BBCSUM0 **********************************03890722 ! 393: C**** WRITE OUT TEST SUMMARY 03900722 ! 394: C**** 03910722 ! 395: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03920722 ! 396: WRITE (I02, 90004) 03930722 ! 397: WRITE (I02, 90014) 03940722 ! 398: WRITE (I02, 90004) 03950722 ! 399: WRITE (I02, 90020) IVPASS 03960722 ! 400: WRITE (I02, 90022) IVFAIL 03970722 ! 401: WRITE (I02, 90024) IVDELE 03980722 ! 402: WRITE (I02, 90026) IVINSP 03990722 ! 403: WRITE (I02, 90028) IVTOTN, IVTOTL 04000722 ! 404: CBE** ********************** BBCSUM0 **********************************04010722 ! 405: CBB** ********************** BBCFOOT0 **********************************04020722 ! 406: C**** WRITE OUT REPORT FOOTINGS 04030722 ! 407: C**** 04040722 ! 408: WRITE (I02,90016) ZPROG, ZPROG 04050722 ! 409: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04060722 ! 410: WRITE (I02,90019) 04070722 ! 411: CBE** ********************** BBCFOOT0 **********************************04080722 ! 412: 90001 FORMAT (1H ,56X,5HFM722) 04090722 ! 413: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM722) 04100722 ! 414: CBB** ********************** BBCFMT0A **********************************04110722 ! 415: C**** FORMATS FOR TEST DETAIL LINES 04120722 ! 416: C**** 04130722 ! 417: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04140722 ! 418: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04150722 ! 419: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04160722 ! 420: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04170722 ! 421: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04180722 ! 422: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04190722 ! 423: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04200722 ! 424: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04210722 ! 425: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04220722 ! 426: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04230722 ! 427: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04240722 ! 428: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04250722 ! 429: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04260722 ! 430: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04270722 ! 431: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04280722 ! 432: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04290722 ! 433: 80050 FORMAT (1H ,48X,A31) 04300722 ! 434: CBE** ********************** BBCFMT0A **********************************04310722 ! 435: CBB** ********************** BBCFMAT1 **********************************04320722 ! 436: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04330722 ! 437: C**** 04340722 ! 438: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04350722 ! 439: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04360722 ! 440: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04370722 ! 441: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04380722 ! 442: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04390722 ! 443: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04400722 ! 444: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04410722 ! 445: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04420722 ! 446: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04430722 ! 447: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04440722 ! 448: 21H(,F12.5,2H, ,F12.5,1H)) 04450722 ! 449: CBE** ********************** BBCFMAT1 **********************************04460722 ! 450: CBB** ********************** BBCFMT0B **********************************04470722 ! 451: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04480722 ! 452: C**** 04490722 ! 453: 90002 FORMAT (1H1) 04500722 ! 454: 90004 FORMAT (1H ) 04510722 ! 455: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04520722 ! 456: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04530722 ! 457: 90008 FORMAT (1H ,21X,A13,A17) 04540722 ! 458: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04550722 ! 459: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04560722 ! 460: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04570722 ! 461: 1 7X,7HREMARKS,24X) 04580722 ! 462: 90014 FORMAT (1H ,46H----------------------------------------------, 04590722 ! 463: 1 33H---------------------------------) 04600722 ! 464: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04610722 ! 465: C**** 04620722 ! 466: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04630722 ! 467: C**** 04640722 ! 468: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04650722 ! 469: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04660722 ! 470: 1 A13) 04670722 ! 471: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04680722 ! 472: C**** 04690722 ! 473: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04700722 ! 474: C**** 04710722 ! 475: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04720722 ! 476: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04730722 ! 477: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04740722 ! 478: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04750722 ! 479: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04760722 ! 480: CBE** ********************** BBCFMT0B **********************************04770722 ! 481: END 04780722 ! 482: DOUBLE PRECISION FUNCTION DF723(DVN008) 00010723 ! 483: C DATE***82/08/02*18.33.46 ! 484: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 485: C AUDIT FCVS78 V2.0 ! 486: C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST 00020723 ! 487: C DOUBLE PRECISION FUNCTIONS 00030723 ! 488: IMPLICIT DOUBLE PRECISION (D) 00040723 ! 489: DF723=DVN008 + 100D2 00050723 ! 490: RETURN 00060723 ! 491: END 00070723 ! 492: COMPLEX FUNCTION ZF724(RVN006,RVN007) 00010724 ! 493: C DATE***82/08/02*18.33.46 ! 494: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 495: C AUDIT FCVS78 V2.0 ! 496: C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST 00020724 ! 497: C COMPLEX FUNCTION NAME 00030724 ! 498: IMPLICIT COMPLEX (Z) 00040724 ! 499: ZF724= CMPLX(RVN006,RVN007) + CMPLX(RVN007,RVN007) 00050724 ! 500: RETURN 00060724 ! 501: END 00070724 ! 502: SUBROUTINE SN725(DTINT, DVN008) 00010725 ! 503: C DATE***82/08/02*18.33.46 ! 504: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 505: C AUDIT FCVS78 V2.0 ! 506: C THIS ROUTINE IS USED BY PROGRAM FM722 00020725 ! 507: C TO TEST A DOUBLE PRECISION FUNCTION NAME USED AS AN 00030725 ! 508: C ACTUAL ARGUMENT 00040725 ! 509: IMPLICIT DOUBLE PRECISION (D) 00050725 ! 510: COMMON /BVN001/ DVC006 00060725 ! 511: DVC006=DTINT(DVN008) + 10D2 00070725 ! 512: RETURN 00080725 ! 513: END 00090725
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.