![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM719.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 FM719.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 FM719 00010719 ! 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 00020719 ! 6: C THIS ROUTINE TESTS DO STATEMENTS USING REAL, ANS REF. 00030719 ! 7: C DOUBLE PRECISION, OR MIXED TYPE DO-VARIABLES. 11.10 00040719 ! 8: C ALSO TESTED ARE ACTIVE AND INACTIVE 11.10.2 00050719 ! 9: C DO LOOPS. 11.10.3 00060719 ! 10: C 00070719 ! 11: C THIS ROUTINE USES FUNCTION SUBPROGRAM IF720 AND 00080719 ! 12: C SUBROUTINE SUBPROGRAM SN721. 00090719 ! 13: C 00100719 ! 14: CBB** ********************** BBCCOMNT **********************************00110719 ! 15: C**** 00120719 ! 16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130719 ! 17: C**** VERSION 2.0 00140719 ! 18: C**** 00150719 ! 19: C**** 00160719 ! 20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170719 ! 21: C**** GENERAL SERVICES ADMINISTRATION 00180719 ! 22: C**** FEDERAL SOFTWARE TESTING CENTER 00190719 ! 23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200719 ! 24: C**** FALLS CHURCH, VA. 22041 00210719 ! 25: C**** 00220719 ! 26: C**** (703) 756-6153 00230719 ! 27: C**** 00240719 ! 28: CBE** ********************** BBCCOMNT **********************************00250719 ! 29: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00260719 ! 30: IMPLICIT CHARACTER*27 (C) 00270719 ! 31: CBB** ********************** BBCINITA **********************************00280719 ! 32: C**** SPECIFICATION STATEMENTS 00290719 ! 33: C**** 00300719 ! 34: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310719 ! 35: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320719 ! 36: CBE** ********************** BBCINITA **********************************00330719 ! 37: C 00340719 ! 38: DOUBLE PRECISION DVCOMP, DVCORR, DVN001 00350719 ! 39: C 00360719 ! 40: C 00370719 ! 41: CBB** ********************** BBCINITB **********************************00380719 ! 42: C**** INITIALIZE SECTION 00390719 ! 43: DATA ZVERS, ZVERSD, ZDATE 00400719 ! 44: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00410719 ! 45: DATA ZCOMPL, ZNAME, ZTAPE 00420719 ! 46: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430719 ! 47: DATA ZPROJ, ZTAPED, ZPROG 00440719 ! 48: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450719 ! 49: DATA REMRKS /' '/ 00460719 ! 50: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470719 ! 51: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480719 ! 52: C**** 00490719 ! 53: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500719 ! 54: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510719 ! 55: CZ03 ZPROG = 'PROGRAM NAME' 00520719 ! 56: ZDATE = '07-Nov-85 ' *RP ! 57: ZCOMPL = 'CCI 5.2 ' *RP ! 58: ZPROJ = 'TC-85- -410' *RP ! 59: ZNAME = ' ' *RP ! 60: ZTAPE = ' ' *RP ! 61: ZTAPED = '850703 ' *RP ! 62: C 00590719 ! 63: IVPASS = 0 00600719 ! 64: IVFAIL = 0 00610719 ! 65: IVDELE = 0 00620719 ! 66: IVINSP = 0 00630719 ! 67: IVTOTL = 0 00640719 ! 68: IVTOTN = 0 00650719 ! 69: ICZERO = 0 00660719 ! 70: C 00670719 ! 71: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680719 ! 72: I01 = 05 00690719 ! 73: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700719 ! 74: I02 = 06 00710719 ! 75: C 00720719 ! 76: I01 = 5 00730719 ! 77: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740719 ! 78: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750719 ! 79: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760719 ! 80: C 00770719 ! 81: I02 = 6 00780719 ! 82: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790719 ! 83: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800719 ! 84: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810719 ! 85: C 00820719 ! 86: CBE** ********************** BBCINITB **********************************00830719 ! 87: ZPROG = 'FM719' 00840719 ! 88: IVTOTL = 14 00850719 ! 89: CBB** ********************** BBCHED0A **********************************00860719 ! 90: C**** 00870719 ! 91: C**** WRITE REPORT TITLE 00880719 ! 92: C**** 00890719 ! 93: WRITE (I02, 90002) 00900719 ! 94: WRITE (I02, 90006) 00910719 ! 95: WRITE (I02, 90007) 00920719 ! 96: WRITE (I02, 90008) ZVERS, ZVERSD 00930719 ! 97: WRITE (I02, 90009) ZPROG, ZPROG 00940719 ! 98: WRITE (I02, 90010) ZDATE, ZCOMPL 00950719 ! 99: CBE** ********************** BBCHED0A **********************************00960719 ! 100: CBB** ********************** BBCHED0B **********************************00970719 ! 101: C**** WRITE DETAIL REPORT HEADERS 00980719 ! 102: C**** 00990719 ! 103: WRITE (I02,90004) 01000719 ! 104: WRITE (I02,90004) 01010719 ! 105: WRITE (I02,90013) 01020719 ! 106: WRITE (I02,90014) 01030719 ! 107: WRITE (I02,90015) IVTOTL 01040719 ! 108: CBE** ********************** BBCHED0B **********************************01050719 ! 109: C 01060719 ! 110: CT001* TEST 001 **** FCVS PROGRAM 719 **** 01070719 ! 111: C REAL DO-VARIABLE 01080719 ! 112: C 01090719 ! 113: IVTNUM = 1 01100719 ! 114: RVCOMP = 0.0 01110719 ! 115: RVCORR = 3.0 01120719 ! 116: DO 0010 RVN001 = 1.1, 2.4, 0.5 01130719 ! 117: RVCOMP = RVCOMP + 1.0 01140719 ! 118: 0010 CONTINUE 01150719 ! 119: IF (RVCOMP - 0.29998E+01) 20010, 10010, 40010 01160719 ! 120: 40010 IF (RVCOMP - 0.30002E+01) 10010, 10010, 20010 01170719 ! 121: 10010 IVPASS = IVPASS + 1 01180719 ! 122: WRITE (I02,80002) IVTNUM 01190719 ! 123: GO TO 0011 01200719 ! 124: 20010 IVFAIL = IVFAIL + 1 01210719 ! 125: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01220719 ! 126: 0011 CONTINUE 01230719 ! 127: C 01240719 ! 128: CT002* TEST 002 **** FCVS PROGRAM 719 **** 01250719 ! 129: C DOUBLE PRECISION DO-VARIABLE 01260719 ! 130: C 01270719 ! 131: IVTNUM = 2 01280719 ! 132: DVCOMP = 0.0D0 01290719 ! 133: DVCORR = 6.0D0 01300719 ! 134: DO 0020 DVN001 = 1.0D-2, 12.0D-2, 2.0D-2 01310719 ! 135: DVCOMP = DVCOMP + 1.0D0 01320719 ! 136: 0020 CONTINUE 01330719 ! 137: IF (DVCOMP - 0.5999999997D+01) 20020, 10020, 40020 01340719 ! 138: 40020 IF (DVCOMP - 0.6000000003D+01) 10020, 10020, 20020 01350719 ! 139: 10020 IVPASS = IVPASS + 1 01360719 ! 140: WRITE (I02,80002) IVTNUM 01370719 ! 141: GO TO 0021 01380719 ! 142: 20020 IVFAIL = IVFAIL + 1 01390719 ! 143: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01400719 ! 144: 0021 CONTINUE 01410719 ! 145: C 01420719 ! 146: C TESTS 3 THRU 10 TEST ACTIVE AND INACTIVE DO-LOOPS 01430719 ! 147: C 01440719 ! 148: C 01450719 ! 149: C 01460719 ! 150: CT003* TEST 003 **** FCVS PROGRAM 719 **** 01470719 ! 151: C RETURN IS FROM A FUNCTION BACK TO LOOP 01480719 ! 152: C 01490719 ! 153: IVTNUM = 3 01500719 ! 154: IVCOMP = 0 01510719 ! 155: IVCORR = 9 01520719 ! 156: DO 0032 IVN001 = 1, 3 01530719 ! 157: IVCOMP = IVCOMP + IF720(IVN001) 01540719 ! 158: 0032 CONTINUE 01550719 ! 159: 40030 IF (IVCOMP - 9) 20030, 10030, 20030 01560719 ! 160: 10030 IVPASS = IVPASS + 1 01570719 ! 161: WRITE (I02,80002) IVTNUM 01580719 ! 162: GO TO 0031 01590719 ! 163: 20030 IVFAIL = IVFAIL + 1 01600719 ! 164: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01610719 ! 165: 0031 CONTINUE 01620719 ! 166: C 01630719 ! 167: CT004* TEST 004 **** FCVS PROGRAM 719 **** 01640719 ! 168: C RETURN IS FROM A SUBROUTINE TO A STATEMENT OUTSIDE LOOP 01650719 ! 169: C 01660719 ! 170: IVTNUM = 4 01670719 ! 171: IVCOMP = 0 01680719 ! 172: IVCORR = -59 01690719 ! 173: IVN002 = 0 01700719 ! 174: DO 0042 IVN001 = 1, 5 01710719 ! 175: CALL SN721(IVN002,*0043) 01720719 ! 176: 0042 CONTINUE 01730719 ! 177: 0043 IVCOMP = IVN002 - 60 01740719 ! 178: 40040 IF (IVCOMP + 59) 20040, 10040, 20040 01750719 ! 179: 10040 IVPASS = IVPASS + 1 01760719 ! 180: WRITE (I02,80002) IVTNUM 01770719 ! 181: GO TO 0041 01780719 ! 182: 20040 IVFAIL = IVFAIL + 1 01790719 ! 183: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800719 ! 184: 0041 CONTINUE 01810719 ! 185: C 01820719 ! 186: CT005* TEST 005 **** FCVS PROGRAM 719 **** 01830719 ! 187: C RETURN IS FROM A SUBROUTINE TO A STATEMENT INSIDE LOOP 01840719 ! 188: C 01850719 ! 189: IVTNUM = 5 01860719 ! 190: IVCOMP = 0 01870719 ! 191: IVCORR = 1 01880719 ! 192: IVN002 = 1 01890719 ! 193: DO 0053 IVN001 = 1, 8 01900719 ! 194: CALL SN721(IVN002,*0052) 01910719 ! 195: GO TO 20050 01920719 ! 196: 0052 IVN002 = IVN002 - 1 01930719 ! 197: 0053 CONTINUE 01940719 ! 198: IVCOMP = IVN002 01950719 ! 199: 40050 IF (IVCOMP - 1) 20050, 10050, 20050 01960719 ! 200: 10050 IVPASS = IVPASS + 1 01970719 ! 201: WRITE (I02,80002) IVTNUM 01980719 ! 202: GO TO 0051 01990719 ! 203: 20050 IVFAIL = IVFAIL + 1 02000719 ! 204: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02010719 ! 205: 0051 CONTINUE 02020719 ! 206: C 02030719 ! 207: CT006* TEST 006 **** FCVS PROGRAM 719 **** 02040719 ! 208: C RETURN IS FROM AN ENTRY TO A STATEMENT OUTSIDE LOOP 02050719 ! 209: C 02060719 ! 210: IVTNUM = 6 02070719 ! 211: IVCOMP = 0 02080719 ! 212: IVCORR = -34 02090719 ! 213: IVN002 = -17 02100719 ! 214: DO 0062 IVN001 = 1, 4 02110719 ! 215: CALL EN721(IVN002,*0063) 02120719 ! 216: 0062 CONTINUE 02130719 ! 217: 0063 IVCOMP = IVN002 02140719 ! 218: 40060 IF (IVCOMP + 34) 20060, 10060, 20060 02150719 ! 219: 10060 IVPASS = IVPASS + 1 02160719 ! 220: WRITE (I02,80002) IVTNUM 02170719 ! 221: GO TO 0061 02180719 ! 222: 20060 IVFAIL = IVFAIL + 1 02190719 ! 223: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02200719 ! 224: 0061 CONTINUE 02210719 ! 225: C 02220719 ! 226: CT007* TEST 007 **** FCVS PROGRAM 719 **** 02230719 ! 227: C RETURN IS FROM AN ENTRY TO A STATEMENT INSIDE LOOP 02240719 ! 228: C 02250719 ! 229: IVTNUM = 7 02260719 ! 230: IVCOMP = 0 02270719 ! 231: IVCORR = 63 02280719 ! 232: IVN002 = 7 02290719 ! 233: DO 0073 IVN001 = 1, 3 02300719 ! 234: CALL EN721(IVN002,*0072) 02310719 ! 235: GO TO 20070 02320719 ! 236: 0072 IVN002 = IVN002 + 1 02330719 ! 237: 0073 CONTINUE 02340719 ! 238: IVCOMP = IVN002 02350719 ! 239: 40070 IF (IVCOMP - 63) 20070, 10070, 20070 02360719 ! 240: 10070 IVPASS = IVPASS + 1 02370719 ! 241: WRITE (I02,80002) IVTNUM 02380719 ! 242: GO TO 0071 02390719 ! 243: 20070 IVFAIL = IVFAIL + 1 02400719 ! 244: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02410719 ! 245: 0071 CONTINUE 02420719 ! 246: C 02430719 ! 247: CT008* TEST 008 **** FCVS PROGRAM 719 **** 02440719 ! 248: C RETURN IS FROM AN ENTRY TO A STATEMENT OUTSIDE INNER LOOP OF A 02450719 ! 249: C NESTED DO-LOOP 02460719 ! 250: C 02470719 ! 251: IVTNUM = 8 02480719 ! 252: IVCOMP = 0 02490719 ! 253: IVCORR = 3 02500719 ! 254: IVN003 = 0 02510719 ! 255: DO 0084 IVN001 = 1, 3 02520719 ! 256: IVN003 = IVN003 + 1 02530719 ! 257: DO 0082 IVN002 = IVN001, 4 02540719 ! 258: CALL EN722(1,*0083,*0084) 02550719 ! 259: 0082 CONTINUE 02560719 ! 260: 0083 IVCOMP = IVN003 02570719 ! 261: 0084 CONTINUE 02580719 ! 262: 40080 IF (IVCOMP - 3) 20080, 10080, 20080 02590719 ! 263: 10080 IVPASS = IVPASS + 1 02600719 ! 264: WRITE (I02,80002) IVTNUM 02610719 ! 265: GO TO 0081 02620719 ! 266: 20080 IVFAIL = IVFAIL + 1 02630719 ! 267: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02640719 ! 268: 0081 CONTINUE 02650719 ! 269: C 02660719 ! 270: CT009* TEST 009 **** FCVS PROGRAM 719 **** 02670719 ! 271: C RETURN IS FROM AN ENTRY TO A STATEMENT INSIDE INNER LOOP OF A 02680719 ! 272: C NESTED DO-LOOP 02690719 ! 273: C 02700719 ! 274: IVTNUM = 9 02710719 ! 275: IVCOMP = 0 02720719 ! 276: IVCORR = 12 02730719 ! 277: IVN003 = 0 02740719 ! 278: DO 0095 IVN001 = 1, 3 02750719 ! 279: IVN003 = IVN003 + 1 02760719 ! 280: DO 0093 IVN002 = IVN001, IVN001 + 1 02770719 ! 281: CALL EN722(2,*0094,*0092) 02780719 ! 282: IVN004 = 10 02790719 ! 283: 0092 IVN004 = IVN002*IVN003 02800719 ! 284: 0093 CONTINUE 02810719 ! 285: 0094 IVCOMP = IVN004 02820719 ! 286: 0095 CONTINUE 02830719 ! 287: 40090 IF (IVCOMP - 12) 20090, 10090, 20090 02840719 ! 288: 10090 IVPASS = IVPASS + 1 02850719 ! 289: WRITE (I02,80002) IVTNUM 02860719 ! 290: GO TO 0091 02870719 ! 291: 20090 IVFAIL = IVFAIL + 1 02880719 ! 292: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02890719 ! 293: 0091 CONTINUE 02900719 ! 294: C 02910719 ! 295: CT010* TEST 010 **** FCVS PROGRAM 719 **** 02920719 ! 296: C RETURN IS FROM AN ENTRY TO A STATEMENT EITHER INSIDE OR OUTSIDE 02930719 ! 297: C INNER LOOP OF A NESTED DO-LOOP 02940719 ! 298: C 02950719 ! 299: IVTNUM = 10 02960719 ! 300: IVCOMP = 0 02970719 ! 301: IVCORR = 9 02980719 ! 302: IVN003 = 0 02990719 ! 303: IVN004 = 0 03000719 ! 304: DO 0105 IVN001 = 1, 3 03010719 ! 305: IVN003 = IVN003 + 1 03020719 ! 306: IVN005 = (3 + (-1)**IVN001)/2 03030719 ! 307: DO 0103 IVN002 = IVN001, IVN001 + 1 03040719 ! 308: CALL EN722(IVN005,*0104,*0102) 03050719 ! 309: IVN004 = 10 03060719 ! 310: 0102 IVN004 = IVN004 + IVN002 + IVN003 03070719 ! 311: 0103 CONTINUE 03080719 ! 312: 0104 IVCOMP = IVN004 03090719 ! 313: 0105 CONTINUE 03100719 ! 314: 40100 IF (IVCOMP - 9) 20100, 10100, 20100 03110719 ! 315: 10100 IVPASS = IVPASS + 1 03120719 ! 316: WRITE (I02,80002) IVTNUM 03130719 ! 317: GO TO 0101 03140719 ! 318: 20100 IVFAIL = IVFAIL + 1 03150719 ! 319: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03160719 ! 320: 0101 CONTINUE 03170719 ! 321: C TESTS 11 THRU 14 TEST DO STATEMENTS WITH MIXED INTEGER, REAL, 03180719 ! 322: C AND DOUBLE PRECISION. 03190719 ! 323: C 03200719 ! 324: C 03210719 ! 325: C 03220719 ! 326: CT011* TEST 011 **** FCVS PROGRAM 719 **** 03230719 ! 327: C 03240719 ! 328: IVTNUM = 11 03250719 ! 329: IVCOMP = 0 03260719 ! 330: IVCORR = 30 03270719 ! 331: DO 0112 IVN001 = 6.7, 0.9325D+1 03280719 ! 332: IVCOMP = IVCOMP + IVN001 03290719 ! 333: 0112 CONTINUE 03300719 ! 334: 40110 IF (IVCOMP - 30) 20110, 10110, 20110 03310719 ! 335: 10110 IVPASS = IVPASS + 1 03320719 ! 336: WRITE (I02,80002) IVTNUM 03330719 ! 337: GO TO 0111 03340719 ! 338: 20110 IVFAIL = IVFAIL + 1 03350719 ! 339: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03360719 ! 340: 0111 CONTINUE 03370719 ! 341: C 03380719 ! 342: CT012* TEST 012 **** FCVS PROGRAM 719 **** 03390719 ! 343: C 03400719 ! 344: IVTNUM = 12 03410719 ! 345: IVCOMP = 0 03420719 ! 346: IVCORR = -26 03430719 ! 347: DVN001 = 3.54D0 03440719 ! 348: DO 0122 IVN001 = -5.3, 2*(DVN001 - 8), -1.46 03450719 ! 349: IVCOMP = IVCOMP + IVN001 03460719 ! 350: 0122 CONTINUE 03470719 ! 351: 40120 IF (IVCOMP + 26) 20120, 10120, 20120 03480719 ! 352: 10120 IVPASS = IVPASS + 1 03490719 ! 353: WRITE (I02,80002) IVTNUM 03500719 ! 354: GO TO 0121 03510719 ! 355: 20120 IVFAIL = IVFAIL + 1 03520719 ! 356: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03530719 ! 357: 0121 CONTINUE 03540719 ! 358: C 03550719 ! 359: CT013* TEST 013 **** FCVS PROGRAM 719 **** 03560719 ! 360: C 03570719 ! 361: IVTNUM = 13 03580719 ! 362: RVCOMP = 0.0 03590719 ! 363: RVCORR = 4.84E-6 03600719 ! 364: IVN001 = 1 03610719 ! 365: DVN001 = 2.0D-7 03620719 ! 366: DO 0132 RVN001 = (IVN001 + .12)*1.0E-6, DVN001*(6 + 0.7), 6.0E-8 03630719 ! 367: RVCOMP = RVCOMP + RVN001 03640719 ! 368: 0132 CONTINUE 03650719 ! 369: IF (RVCOMP - 0.48397E-05) 20130, 10130, 40130 03660719 ! 370: 40130 IF (RVCOMP - 0.48403E-05) 10130, 10130, 20130 03670719 ! 371: 10130 IVPASS = IVPASS + 1 03680719 ! 372: WRITE (I02,80002) IVTNUM 03690719 ! 373: GO TO 0131 03700719 ! 374: 20130 IVFAIL = IVFAIL + 1 03710719 ! 375: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03720719 ! 376: 0131 CONTINUE 03730719 ! 377: C 03740719 ! 378: CT014* TEST 014 **** FCVS PROGRAM 719 **** 03750719 ! 379: C 03760719 ! 380: IVTNUM = 14 03770719 ! 381: DVCOMP = 0.0D0 03780719 ! 382: DVCORR = 1.8D3 03790719 ! 383: IVN001 = 1 03800719 ! 384: DO 0142 DVN001 = 2.25E+2, 300*(1.65 + IVN001), 150 03810719 ! 385: DVCOMP = DVCOMP + DVN001 03820719 ! 386: 0142 CONTINUE 03830719 ! 387: IF (DVCOMP - 0.1799999999D+04) 20140, 10140, 40140 03840719 ! 388: 40140 IF (DVCOMP - 0.1800000001D+04) 10140, 10140, 20140 03850719 ! 389: 10140 IVPASS = IVPASS + 1 03860719 ! 390: WRITE (I02,80002) IVTNUM 03870719 ! 391: GO TO 0141 03880719 ! 392: 20140 IVFAIL = IVFAIL + 1 03890719 ! 393: WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 03900719 ! 394: 0141 CONTINUE 03910719 ! 395: C 03920719 ! 396: CBB** ********************** BBCSUM0 **********************************03930719 ! 397: C**** WRITE OUT TEST SUMMARY 03940719 ! 398: C**** 03950719 ! 399: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03960719 ! 400: WRITE (I02, 90004) 03970719 ! 401: WRITE (I02, 90014) 03980719 ! 402: WRITE (I02, 90004) 03990719 ! 403: WRITE (I02, 90020) IVPASS 04000719 ! 404: WRITE (I02, 90022) IVFAIL 04010719 ! 405: WRITE (I02, 90024) IVDELE 04020719 ! 406: WRITE (I02, 90026) IVINSP 04030719 ! 407: WRITE (I02, 90028) IVTOTN, IVTOTL 04040719 ! 408: CBE** ********************** BBCSUM0 **********************************04050719 ! 409: CBB** ********************** BBCFOOT0 **********************************04060719 ! 410: C**** WRITE OUT REPORT FOOTINGS 04070719 ! 411: C**** 04080719 ! 412: WRITE (I02,90016) ZPROG, ZPROG 04090719 ! 413: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04100719 ! 414: WRITE (I02,90019) 04110719 ! 415: CBE** ********************** BBCFOOT0 **********************************04120719 ! 416: 90001 FORMAT (1H ,56X,5HFM719) 04130719 ! 417: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM719) 04140719 ! 418: CBB** ********************** BBCFMT0A **********************************04150719 ! 419: C**** FORMATS FOR TEST DETAIL LINES 04160719 ! 420: C**** 04170719 ! 421: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04180719 ! 422: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04190719 ! 423: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04200719 ! 424: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04210719 ! 425: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04220719 ! 426: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04230719 ! 427: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04240719 ! 428: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04250719 ! 429: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04260719 ! 430: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04270719 ! 431: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04280719 ! 432: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04290719 ! 433: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04300719 ! 434: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04310719 ! 435: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04320719 ! 436: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04330719 ! 437: 80050 FORMAT (1H ,48X,A31) 04340719 ! 438: CBE** ********************** BBCFMT0A **********************************04350719 ! 439: CBB** ********************** BBCFMAT1 **********************************04360719 ! 440: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04370719 ! 441: C**** 04380719 ! 442: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04390719 ! 443: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04400719 ! 444: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04410719 ! 445: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04420719 ! 446: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04430719 ! 447: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04440719 ! 448: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04450719 ! 449: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04460719 ! 450: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04470719 ! 451: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04480719 ! 452: 21H(,F12.5,2H, ,F12.5,1H)) 04490719 ! 453: CBE** ********************** BBCFMAT1 **********************************04500719 ! 454: CBB** ********************** BBCFMT0B **********************************04510719 ! 455: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04520719 ! 456: C**** 04530719 ! 457: 90002 FORMAT (1H1) 04540719 ! 458: 90004 FORMAT (1H ) 04550719 ! 459: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04560719 ! 460: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04570719 ! 461: 90008 FORMAT (1H ,21X,A13,A17) 04580719 ! 462: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04590719 ! 463: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04600719 ! 464: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04610719 ! 465: 1 7X,7HREMARKS,24X) 04620719 ! 466: 90014 FORMAT (1H ,46H----------------------------------------------, 04630719 ! 467: 1 33H---------------------------------) 04640719 ! 468: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04650719 ! 469: C**** 04660719 ! 470: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04670719 ! 471: C**** 04680719 ! 472: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04690719 ! 473: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04700719 ! 474: 1 A13) 04710719 ! 475: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04720719 ! 476: C**** 04730719 ! 477: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04740719 ! 478: C**** 04750719 ! 479: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04760719 ! 480: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04770719 ! 481: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04780719 ! 482: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04790719 ! 483: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04800719 ! 484: CBE** ********************** BBCFMT0B **********************************04810719 ! 485: STOP 04820719 ! 486: END 04830719 ! 487: C THIS FUNCTION IS TO BE RUN WITH ROUTINE 719. 00010720 ! 488: C DATE***82/08/02*18.33.46 ! 489: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 490: C AUDIT FCVS78 V2.0 ! 491: C 00020720 ! 492: C THIS FUNCTION IS REFERENCED IN THE RANGE OF A DO-LOOP TO TEST 00030720 ! 493: C LOOP CONTROL PROCESSING. 00040720 ! 494: FUNCTION IF720(IVN001) 00050720 ! 495: IF720 = 2*IVN001 - 1 00060720 ! 496: RETURN 00070720 ! 497: END 00080720 ! 498: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 719. 00010721 ! 499: C DATE***82/08/02*18.33.46 ! 500: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 501: C AUDIT FCVS78 V2.0 ! 502: C 00020721 ! 503: C THIS SUBROUTINE IS CALLED IN THE RANGE OF A DO-LOOP TO TEST 00030721 ! 504: C ALTERNATE RETURN CONTROL. 00040721 ! 505: SUBROUTINE SN721(IVN001,*) 00050721 ! 506: IVN001 = IVN001 + 1 00060721 ! 507: RETURN 1 00070721 ! 508: ENTRY EN721(IVN002,*) 00080721 ! 509: IVN002 = 2*IVN002 00090721 ! 510: RETURN 1 00100721 ! 511: ENTRY EN722(IVN003,*,*) 00110721 ! 512: RETURN IVN003 00120721 ! 513: END 00130721
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.