![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM509.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 FM509.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 FM509 00010509 ! 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 00020509 ! 6: C THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND ANS REF. 00030509 ! 7: C FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES. 15.6.1 00040509 ! 8: C THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC 15.7, 15.7.1 00050509 ! 9: C NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND 15.9.2 00060509 ! 10: C ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS. 15.9.3.2 00070509 ! 11: C 15.9.3.3 00080509 ! 12: C THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510, 00090509 ! 13: C SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513. 00100509 ! 14: C 00110509 ! 15: CBB** ********************** BBCCOMNT **********************************00120509 ! 16: C**** 00130509 ! 17: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140509 ! 18: C**** VERSION 2.0 00150509 ! 19: C**** 00160509 ! 20: C**** 00170509 ! 21: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180509 ! 22: C**** GENERAL SERVICES ADMINISTRATION 00190509 ! 23: C**** FEDERAL SOFTWARE TESTING CENTER 00200509 ! 24: C**** 5203 LEESBURG PIKE, SUITE 1100 00210509 ! 25: C**** FALLS CHURCH, VA. 22041 00220509 ! 26: C**** 00230509 ! 27: C**** (703) 756-6153 00240509 ! 28: C**** 00250509 ! 29: CBE** ********************** BBCCOMNT **********************************00260509 ! 30: IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270509 ! 31: IMPLICIT CHARACTER*27 (C) 00280509 ! 32: CBB** ********************** BBCINITA **********************************00290509 ! 33: C**** SPECIFICATION STATEMENTS 00300509 ! 34: C**** 00310509 ! 35: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320509 ! 36: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330509 ! 37: CBE** ********************** BBCINITA **********************************00340509 ! 38: C 00350509 ! 39: INTEGER I2N001(2,2) 00360509 ! 40: CHARACTER CVCOMP*12,CVCORR*12,CVN001*30 00370509 ! 41: CHARACTER C1N001(6)*10 00380509 ! 42: PARAMETER (IPN001=31) 00390509 ! 43: COMMON IVC001, IVC002, IVC003 00400509 ! 44: EXTERNAL RF513 00410509 ! 45: DATA I2N001 /1, 3, 5, 7/ 00420509 ! 46: DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/ 00430509 ! 47: DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM', 00440509 ! 48: 1 'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/ 00450509 ! 49: C 00460509 ! 50: C 00470509 ! 51: CBB** ********************** BBCINITB **********************************00480509 ! 52: C**** INITIALIZE SECTION 00490509 ! 53: DATA ZVERS, ZVERSD, ZDATE 00500509 ! 54: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00510509 ! 55: DATA ZCOMPL, ZNAME, ZTAPE 00520509 ! 56: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00530509 ! 57: DATA ZPROJ, ZTAPED, ZPROG 00540509 ! 58: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00550509 ! 59: DATA REMRKS /' '/ 00560509 ! 60: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00570509 ! 61: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00580509 ! 62: C**** 00590509 ! 63: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00600509 ! 64: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00610509 ! 65: CZ03 ZPROG = 'PROGRAM NAME' 00620509 ! 66: ZDATE = '07-Nov-85 ' *RP ! 67: ZCOMPL = 'CCI 5.2 ' *RP ! 68: ZPROJ = 'TC-85- -410' *RP ! 69: ZNAME = ' ' *RP ! 70: ZTAPE = ' ' *RP ! 71: ZTAPED = '850703 ' *RP ! 72: C 00690509 ! 73: IVPASS = 0 00700509 ! 74: IVFAIL = 0 00710509 ! 75: IVDELE = 0 00720509 ! 76: IVINSP = 0 00730509 ! 77: IVTOTL = 0 00740509 ! 78: IVTOTN = 0 00750509 ! 79: ICZERO = 0 00760509 ! 80: C 00770509 ! 81: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00780509 ! 82: I01 = 05 00790509 ! 83: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00800509 ! 84: I02 = 06 00810509 ! 85: C 00820509 ! 86: I01 = 5 00830509 ! 87: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00840509 ! 88: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00850509 ! 89: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00860509 ! 90: C 00870509 ! 91: I02 = 6 00880509 ! 92: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00890509 ! 93: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00900509 ! 94: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00910509 ! 95: C 00920509 ! 96: CBE** ********************** BBCINITB **********************************00930509 ! 97: ZPROG = 'FM509' 00940509 ! 98: IVTOTL = 16 00950509 ! 99: CBB** ********************** BBCHED0A **********************************00960509 ! 100: C**** 00970509 ! 101: C**** WRITE REPORT TITLE 00980509 ! 102: C**** 00990509 ! 103: WRITE (I02, 90002) 01000509 ! 104: WRITE (I02, 90006) 01010509 ! 105: WRITE (I02, 90007) 01020509 ! 106: WRITE (I02, 90008) ZVERS, ZVERSD 01030509 ! 107: WRITE (I02, 90009) ZPROG, ZPROG 01040509 ! 108: WRITE (I02, 90010) ZDATE, ZCOMPL 01050509 ! 109: CBE** ********************** BBCHED0A **********************************01060509 ! 110: CBB** ********************** BBCHED0B **********************************01070509 ! 111: C**** WRITE DETAIL REPORT HEADERS 01080509 ! 112: C**** 01090509 ! 113: WRITE (I02,90004) 01100509 ! 114: WRITE (I02,90004) 01110509 ! 115: WRITE (I02,90013) 01120509 ! 116: WRITE (I02,90014) 01130509 ! 117: WRITE (I02,90015) IVTOTL 01140509 ! 118: CBE** ********************** BBCHED0B **********************************01150509 ! 119: C 01160509 ! 120: CT001* TEST 001 **** FCVS PROGRAM 509 **** 01170509 ! 121: C SUBROUTINE WITH MULTIPLE ENTRIES 01180509 ! 122: C 01190509 ! 123: IVTNUM = 1 01200509 ! 124: IVCOMP = 0 01210509 ! 125: IVCORR = 25 01220509 ! 126: IVD020=3 01220*TI ! 127: CALL SN510(IVD020,IVN001) 01230*TI ! 128: CALL EN851(IVN001,IVCOMP) 01240509 ! 129: 40010 IF (IVCOMP - 25) 20010, 10010, 20010 01250509 ! 130: 10010 IVPASS = IVPASS + 1 01260509 ! 131: WRITE (I02,80002) IVTNUM 01270509 ! 132: GO TO 0011 01280509 ! 133: 20010 IVFAIL = IVFAIL + 1 01290509 ! 134: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300509 ! 135: 0011 CONTINUE 01310509 ! 136: C 01320509 ! 137: CT002* TEST 002 **** FCVS PROGRAM 509 **** 01330509 ! 138: C ENTRY WITH ONE ARGUMENT 01340509 ! 139: C 01350509 ! 140: IVTNUM = 2 01360509 ! 141: IVCOMP = 0 01370509 ! 142: IVCORR = 137 01380509 ! 143: IVN001 = 37 01390509 ! 144: CALL EN852(IVN001) 01400509 ! 145: IVCOMP = IVN001 01410509 ! 146: 40020 IF (IVCOMP - 137) 20020, 10020, 20020 01420509 ! 147: 10020 IVPASS = IVPASS + 1 01430509 ! 148: WRITE (I02,80002) IVTNUM 01440509 ! 149: GO TO 0021 01450509 ! 150: 20020 IVFAIL = IVFAIL + 1 01460509 ! 151: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01470509 ! 152: 0021 CONTINUE 01480509 ! 153: C 01490509 ! 154: CT003* TEST 003 **** FCVS PROGRAM 509 **** 01500509 ! 155: C ENTRY WITH TWO ARGUMENT 01510509 ! 156: C 01520509 ! 157: IVTNUM = 3 01530509 ! 158: IVCOMP = 0 01540509 ! 159: IVCORR = -51 01550509 ! 160: CALL EN853(-9,IVCOMP) 01560509 ! 161: 40030 IF (IVCOMP + 51) 20030, 10030, 20030 01570509 ! 162: 10030 IVPASS = IVPASS + 1 01580509 ! 163: WRITE (I02,80002) IVTNUM 01590509 ! 164: GO TO 0031 01600509 ! 165: 20030 IVFAIL = IVFAIL + 1 01610509 ! 166: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01620509 ! 167: 0031 CONTINUE 01630509 ! 168: C 01640509 ! 169: CT004* TEST 004 **** FCVS PROGRAM 509 **** 01650509 ! 170: C ENTRY WITH THREE ARGUMENTS 01660509 ! 171: C 01670509 ! 172: IVTNUM = 4 01680509 ! 173: IVCOMP = 0 01690509 ! 174: IVCORR = -71 01700509 ! 175: CALL EN854(275,147,IVCOMP) 01710509 ! 176: 40040 IF (IVCOMP + 71) 20040, 10040, 20040 01720509 ! 177: 10040 IVPASS = IVPASS + 1 01730509 ! 178: WRITE (I02,80002) IVTNUM 01740509 ! 179: GO TO 0041 01750509 ! 180: 20040 IVFAIL = IVFAIL + 1 01760509 ! 181: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770509 ! 182: 0041 CONTINUE 01780509 ! 183: C 01790509 ! 184: CT005* TEST 005 **** FCVS PROGRAM 509 **** 01800509 ! 185: C ENTRY WITH FOUR ARGUMENTS 01810509 ! 186: C 01820509 ! 187: IVTNUM = 5 01830509 ! 188: IVCOMP = 0 01840509 ! 189: IVCORR = 567 01850509 ! 190: CALL EN855(12,-15,63,IVCOMP) 01860509 ! 191: 40050 IF (IVCOMP - 567) 20050, 10050, 20050 01870509 ! 192: 10050 IVPASS = IVPASS + 1 01880509 ! 193: WRITE (I02,80002) IVTNUM 01890509 ! 194: GO TO 0051 01900509 ! 195: 20050 IVFAIL = IVFAIL + 1 01910509 ! 196: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01920509 ! 197: 0051 CONTINUE 01930509 ! 198: C 01940509 ! 199: CT006* TEST 006 **** FCVS PROGRAM 509 **** 01950509 ! 200: C ENTRY WITH ARRAY AS DUMMY ARGUMENT 01960509 ! 201: C 01970509 ! 202: IVTNUM = 6 01980509 ! 203: IVCOMP = 0 01990509 ! 204: IVCORR = 16 02000509 ! 205: IVN001 = 2 02010509 ! 206: CALL EN856(IVN001,I2N001,IVCOMP) 02020509 ! 207: 40060 IF (IVCOMP - 16) 20060, 10060, 20060 02030509 ! 208: 10060 IVPASS = IVPASS + 1 02040509 ! 209: WRITE (I02,80002) IVTNUM 02050509 ! 210: GO TO 0061 02060509 ! 211: 20060 IVFAIL = IVFAIL + 1 02070509 ! 212: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080509 ! 213: 0061 CONTINUE 02090509 ! 214: C 02100509 ! 215: CT007* TEST 007 **** FCVS PROGRAM 509 **** 02110509 ! 216: C ENTRY WITH PROCEDURE AS DUMMY ARGUMENT 02120509 ! 217: C 02130509 ! 218: IVTNUM = 7 02140509 ! 219: RVCOMP = 0.0 02150509 ! 220: RVCORR = 2.25 02160509 ! 221: CALL EN857(1.5,RVCOMP,RF513) 02170509 ! 222: IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070 02180509 ! 223: 40070 IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070 02190509 ! 224: 10070 IVPASS = IVPASS + 1 02200509 ! 225: WRITE (I02,80002) IVTNUM 02210509 ! 226: GO TO 0071 02220509 ! 227: 20070 IVFAIL = IVFAIL + 1 02230509 ! 228: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240509 ! 229: 0071 CONTINUE 02250509 ! 230: C 02260509 ! 231: CT008* TEST 008 **** FCVS PROGRAM 509 **** 02270509 ! 232: C ENTRY WITH ASTERISK AS DUMMY ARGUMENT 02280509 ! 233: C 02290509 ! 234: IVTNUM = 8 02300509 ! 235: IVCOMP = 0 02310509 ! 236: IVCORR = 19 02320509 ! 237: IVN001 = 2 02330509 ! 238: CALL EN858(IVN001,*0082,*0083) 02340509 ! 239: 0082 IVCOMP = 5 02350509 ! 240: GO TO 0084 02360509 ! 241: 0083 IVCOMP = 19 02370509 ! 242: 0084 CONTINUE 02380509 ! 243: 40080 IF (IVCOMP - 19) 20080, 10080, 20080 02390509 ! 244: 10080 IVPASS = IVPASS + 1 02400509 ! 245: WRITE (I02,80002) IVTNUM 02410509 ! 246: GO TO 0081 02420509 ! 247: 20080 IVFAIL = IVFAIL + 1 02430509 ! 248: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02440509 ! 249: 0081 CONTINUE 02450509 ! 250: C 02460509 ! 251: C TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS 02470509 ! 252: C 02480509 ! 253: CT009* TEST 009 **** FCVS PROGRAM 509 **** 02490509 ! 254: C 02500509 ! 255: IVTNUM = 9 02510509 ! 256: IVCOMP = 0 02520509 ! 257: IVCORR = 88 02530509 ! 258: IVC002 = 65 02540509 ! 259: IVC003 = 23 02550509 ! 260: CALL EN859( ) 02560509 ! 261: IVCOMP = IVC001 02570509 ! 262: 40090 IF (IVCOMP - 88) 20090, 10090, 20090 02580509 ! 263: 10090 IVPASS = IVPASS + 1 02590509 ! 264: WRITE (I02,80002) IVTNUM 02600509 ! 265: GO TO 0091 02610509 ! 266: 20090 IVFAIL = IVFAIL + 1 02620509 ! 267: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02630509 ! 268: 0091 CONTINUE 02640509 ! 269: C 02650509 ! 270: CT010* TEST 010 **** FCVS PROGRAM 509 **** 02660509 ! 271: C 02670509 ! 272: IVTNUM = 10 02680509 ! 273: IVCOMP = 0 02690509 ! 274: IVCORR = -13 02700509 ! 275: IVC001 = 4 02710509 ! 276: IVC002 = -17 02720509 ! 277: CALL EN860 02730509 ! 278: IVCOMP = IVC003 02740509 ! 279: 40100 IF (IVCOMP + 13) 20100, 10100, 20100 02750509 ! 280: 10100 IVPASS = IVPASS + 1 02760509 ! 281: WRITE (I02,80002) IVTNUM 02770509 ! 282: GO TO 0101 02780509 ! 283: 20100 IVFAIL = IVFAIL + 1 02790509 ! 284: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02800509 ! 285: 0101 CONTINUE 02810509 ! 286: C 02820509 ! 287: CT011* TEST 011 **** FCVS PROGRAM 509 **** 02830509 ! 288: C FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES 02840509 ! 289: C 02850509 ! 290: IVTNUM = 11 02860509 ! 291: RVCOMP = 0.0 02870509 ! 292: RVCORR = 3.675E-3 02880509 ! 293: RVN001 = RF513(3.5E-2) 02890509 ! 294: RVCOMP = EF852(RVN001) 02900509 ! 295: IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110 02910509 ! 296: 40110 IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110 02920509 ! 297: 10110 IVPASS = IVPASS + 1 02930509 ! 298: WRITE (I02,80002) IVTNUM 02940509 ! 299: GO TO 0111 02950509 ! 300: 20110 IVFAIL = IVFAIL + 1 02960509 ! 301: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02970509 ! 302: 0111 CONTINUE 02980509 ! 303: C 02990509 ! 304: CT012* TEST 012 **** FCVS PROGRAM 509 **** 03000509 ! 305: C SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT 03010509 ! 306: C 03020509 ! 307: IVTNUM = 12 03030509 ! 308: IVCOMP = 0 03040509 ! 309: IVCORR = 34 03050509 ! 310: CALL SN510(IPN001,IVCOMP) 03060509 ! 311: 40120 IF (IVCOMP - 34) 20120, 10120, 20120 03070509 ! 312: 10120 IVPASS = IVPASS + 1 03080509 ! 313: WRITE (I02,80002) IVTNUM 03090509 ! 314: GO TO 0121 03100509 ! 315: 20120 IVFAIL = IVFAIL + 1 03110509 ! 316: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120509 ! 317: 0121 CONTINUE 03130509 ! 318: C 03140509 ! 319: C TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT 03150509 ! 320: C WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE 03160509 ! 321: C 03170509 ! 322: C 03180509 ! 323: CT013* TEST 013 **** FCVS PROGRAM 509 **** 03190509 ! 324: C 03200509 ! 325: IVTNUM = 13 03210509 ! 326: CVCOMP = ' ' 03220509 ! 327: CVCORR = 'COLOR=YELLOW ' 03230509 ! 328: CALL SN511(CVN001(10:15),CVCOMP) 03240509 ! 329: IVCOMP = 0 03250509 ! 330: IF (CVCOMP.EQ.'COLOR=YELLOW ') IVCOMP = 1 03260509 ! 331: 40130 IF (IVCOMP - 1) 20130, 10130, 20130 03270509 ! 332: 10130 IVPASS = IVPASS + 1 03280509 ! 333: WRITE (I02,80002) IVTNUM 03290509 ! 334: GO TO 0131 03300509 ! 335: 20130 IVFAIL = IVFAIL + 1 03310509 ! 336: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03320509 ! 337: 0131 CONTINUE 03330509 ! 338: C 03340509 ! 339: CT014* TEST 014 **** FCVS PROGRAM 509 **** 03350509 ! 340: C 03360509 ! 341: IVTNUM = 14 03370509 ! 342: CVCOMP = ' ' 03380509 ! 343: CVCORR = 'COLOR=VIOLET ' 03390509 ! 344: CALL SN511(CVN001(25:30),CVCOMP) 03400509 ! 345: IVCOMP = 0 03410509 ! 346: IF (CVCOMP.EQ.'COLOR=VIOLET ') IVCOMP = 1 03420509 ! 347: 40140 IF (IVCOMP - 1) 20140, 10140, 20140 03430509 ! 348: 10140 IVPASS = IVPASS + 1 03440509 ! 349: WRITE (I02,80002) IVTNUM 03450509 ! 350: GO TO 0141 03460509 ! 351: 20140 IVFAIL = IVFAIL + 1 03470509 ! 352: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03480509 ! 353: 0141 CONTINUE 03490509 ! 354: C 03500509 ! 355: C TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN 03510509 ! 356: C ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT 03520509 ! 357: C IS AN ARRAY 03530509 ! 358: C 03540509 ! 359: C 03550509 ! 360: CT015* TEST 015 **** FCVS PROGRAM 509 **** 03560509 ! 361: C 03570509 ! 362: IVTNUM = 15 03580509 ! 363: CVCOMP = ' ' 03590509 ! 364: CVCORR = 'RST-AID: ' 03600509 ! 365: CALL SN512(C1N001(1)(3:10),CVCOMP) 03610509 ! 366: IVCOMP = 0 03620509 ! 367: IF (CVCOMP.EQ.'RST-AID: ') IVCOMP = 1 03630509 ! 368: 40150 IF (IVCOMP - 1) 20150, 10150, 20150 03640509 ! 369: 10150 IVPASS = IVPASS + 1 03650509 ! 370: WRITE (I02,80002) IVTNUM 03660509 ! 371: GO TO 0151 03670509 ! 372: 20150 IVFAIL = IVFAIL + 1 03680509 ! 373: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03690509 ! 374: 0151 CONTINUE 03700509 ! 375: C 03710509 ! 376: CT016* TEST 016 **** FCVS PROGRAM 509 **** 03720509 ! 377: C 03730509 ! 378: IVTNUM = 16 03740509 ! 379: CVCOMP = ' ' 03750509 ! 380: CVCORR = 'IFTHROUN ' 03760509 ! 381: CALL SN512(C1N001(5)(2:9),CVCOMP) 03770509 ! 382: IVCOMP = 0 03780509 ! 383: IF (CVCOMP.EQ.'IFTHROUN ') IVCOMP = 1 03790509 ! 384: 40160 IF (IVCOMP - 1) 20160, 10160, 20160 03800509 ! 385: 10160 IVPASS = IVPASS + 1 03810509 ! 386: WRITE (I02,80002) IVTNUM 03820509 ! 387: GO TO 0161 03830509 ! 388: 20160 IVFAIL = IVFAIL + 1 03840509 ! 389: WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03850509 ! 390: 0161 CONTINUE 03860509 ! 391: C 03870509 ! 392: CBB** ********************** BBCSUM0 **********************************03880509 ! 393: C**** WRITE OUT TEST SUMMARY 03890509 ! 394: C**** 03900509 ! 395: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03910509 ! 396: WRITE (I02, 90004) 03920509 ! 397: WRITE (I02, 90014) 03930509 ! 398: WRITE (I02, 90004) 03940509 ! 399: WRITE (I02, 90020) IVPASS 03950509 ! 400: WRITE (I02, 90022) IVFAIL 03960509 ! 401: WRITE (I02, 90024) IVDELE 03970509 ! 402: WRITE (I02, 90026) IVINSP 03980509 ! 403: WRITE (I02, 90028) IVTOTN, IVTOTL 03990509 ! 404: CBE** ********************** BBCSUM0 **********************************04000509 ! 405: CBB** ********************** BBCFOOT0 **********************************04010509 ! 406: C**** WRITE OUT REPORT FOOTINGS 04020509 ! 407: C**** 04030509 ! 408: WRITE (I02,90016) ZPROG, ZPROG 04040509 ! 409: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04050509 ! 410: WRITE (I02,90019) 04060509 ! 411: CBE** ********************** BBCFOOT0 **********************************04070509 ! 412: 90001 FORMAT (1H ,56X,5HFM509) 04080509 ! 413: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM509) 04090509 ! 414: CBB** ********************** BBCFMT0A **********************************04100509 ! 415: C**** FORMATS FOR TEST DETAIL LINES 04110509 ! 416: C**** 04120509 ! 417: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04130509 ! 418: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04140509 ! 419: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04150509 ! 420: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04160509 ! 421: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04170509 ! 422: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04180509 ! 423: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04190509 ! 424: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04200509 ! 425: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04210509 ! 426: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04220509 ! 427: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04230509 ! 428: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04240509 ! 429: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04250509 ! 430: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04260509 ! 431: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04270509 ! 432: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04280509 ! 433: 80050 FORMAT (1H ,48X,A31) 04290509 ! 434: CBE** ********************** BBCFMT0A **********************************04300509 ! 435: CBB** ********************** BBCFMAT1 **********************************04310509 ! 436: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04320509 ! 437: C**** 04330509 ! 438: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04340509 ! 439: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04350509 ! 440: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04360509 ! 441: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04370509 ! 442: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04380509 ! 443: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04390509 ! 444: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04400509 ! 445: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04410509 ! 446: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04420509 ! 447: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04430509 ! 448: 21H(,F12.5,2H, ,F12.5,1H)) 04440509 ! 449: CBE** ********************** BBCFMAT1 **********************************04450509 ! 450: CBB** ********************** BBCFMT0B **********************************04460509 ! 451: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04470509 ! 452: C**** 04480509 ! 453: 90002 FORMAT (1H1) 04490509 ! 454: 90004 FORMAT (1H ) 04500509 ! 455: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04510509 ! 456: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04520509 ! 457: 90008 FORMAT (1H ,21X,A13,A17) 04530509 ! 458: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04540509 ! 459: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04550509 ! 460: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04560509 ! 461: 1 7X,7HREMARKS,24X) 04570509 ! 462: 90014 FORMAT (1H ,46H----------------------------------------------, 04580509 ! 463: 1 33H---------------------------------) 04590509 ! 464: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04600509 ! 465: C**** 04610509 ! 466: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04620509 ! 467: C**** 04630509 ! 468: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04640509 ! 469: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04650509 ! 470: 1 A13) 04660509 ! 471: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04670509 ! 472: C**** 04680509 ! 473: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04690509 ! 474: C**** 04700509 ! 475: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04710509 ! 476: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04720509 ! 477: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04730509 ! 478: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04740509 ! 479: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04750509 ! 480: CBE** ********************** BBCFMT0B **********************************04760509 ! 481: STOP 04770509 ! 482: END 04780509 ! 483: C 00010510 ! 484: C DATE***82/08/02*18.33.46 ! 485: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 486: C AUDIT FCVS78 V2.0 ! 487: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020510 ! 488: C 00030510 ! 489: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF 00040510 ! 490: C MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM. 00050510 ! 491: C 00060510 ! 492: SUBROUTINE SN510(IVD021,IVD002) 00070*TI ! 493: INTEGER I2D001(2,2) 00080510 ! 494: COMMON IVC001, IVC002, IVC003 00090510 ! 495: IVD001 = IVD021 00090*TI ! 496: DO 70010 IVN001 = 1, 3 00100510 ! 497: IVD001 = IVD001 + 1 00110510 ! 498: 70010 CONTINUE 00120510 ! 499: IVD002 = IVD001 00130510 ! 500: RETURN 00140510 ! 501: ENTRY EN851(IVD003,IVD004) 00150510 ! 502: IVD004 = 3*IVD003 + 7 00160510 ! 503: RETURN 00170510 ! 504: ENTRY EN852(IVD005) 00180510 ! 505: IVD005 = IVD005 + 100 00190510 ! 506: RETURN 00200510 ! 507: ENTRY EN853(IVD006,IVD007) 00210510 ! 508: IVD007 = 5*(IVD006 + 2) - 16 00220510 ! 509: RETURN 00230510 ! 510: ENTRY EN854(IVD008,IVD009,IVD010) 00240510 ! 511: IVD010 = 4*(IVD008 - 2*IVD009) + 5 00250510 ! 512: RETURN 00260510 ! 513: ENTRY EN855(IVD011, IVD012, IVD013, IVD014) 00270510 ! 514: IVD014 = IVD013*(2*IVD011 + IVD012) 00280510 ! 515: RETURN 00290510 ! 516: ENTRY EN856(IVD015,I2D001,IVD016) 00300510 ! 517: IVD016 = 0 00310510 ! 518: DO 70020 IVN001 = 1, IVD015 00320510 ! 519: DO 70020 IVN002 = 1, IVD015 00330510 ! 520: 70020 IVD016 = IVD016 + I2D001(IVN001,IVN002) 00340510 ! 521: RETURN 00350510 ! 522: ENTRY EN857(RVD017,RVD018,RFD001) 00360510 ! 523: RVD018 = RFD001(RVD017) 00370510 ! 524: RETURN 00380510 ! 525: ENTRY EN858(IVD019,*,*) 00390510 ! 526: RETURN IVD019 00400510 ! 527: ENTRY EN859( ) 00410510 ! 528: IVC001 = IVC002 + IVC003 00420510 ! 529: RETURN 00430510 ! 530: ENTRY EN860 00440510 ! 531: IVC003 = IVC001 + IVC002 00450510 ! 532: RETURN 00460510 ! 533: END 00470510 ! 534: C 00480510 ! 535: C 00010511 ! 536: C DATE***82/08/02*18.33.46 ! 537: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 538: C AUDIT FCVS78 V2.0 ! 539: C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020511 ! 540: C 00030511 ! 541: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE 00040511 ! 542: C OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS 00050511 ! 543: C ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE 00060511 ! 544: C 00070511 ! 545: SUBROUTINE SN511(CVD001,CVD002) 00080511 ! 546: CHARACTER CVD001*6, CVD002*12 00090511 ! 547: CVD002 = 'COLOR='//CVD001 00100511 ! 548: RETURN 00110511 ! 549: END 00120511 ! 550: C 00010512 ! 551: C DATE***82/08/02*18.33.46 ! 552: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 553: C AUDIT FCVS78 V2.0 ! 554: C THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509. 00020512 ! 555: C 00030512 ! 556: C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF 00040512 ! 557: C AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH 00050512 ! 558: C IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY. 00060512 ! 559: C 00070512 ! 560: SUBROUTINE SN512(C1D001,CVD001) 00080512 ! 561: CHARACTER C1D001(6)*8,CVD001*8 00090512 ! 562: CVD001 = C1D001(1) 00100512 ! 563: RETURN 00110512 ! 564: END 00120512 ! 565: C 00010513 ! 566: C DATE***82/08/02*18.33.46 ! 567: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 568: C AUDIT FCVS78 V2.0 ! 569: C THIS FUNCTION IS TO BE RUN WITH ROUTINE 509. 00020513 ! 570: C 00030513 ! 571: C THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF 00040513 ! 572: C MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM. 00050513 ! 573: C 00060513 ! 574: FUNCTION RF513(RVD001) 00070513 ! 575: RF513 = RVD001**2 00080513 ! 576: RETURN 00090513 ! 577: ENTRY EF852(RVD002) 00100513 ! 578: EF852 = 3*RVD002 00110513 ! 579: RETURN 00120513 ! 580: END 00130513
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.