|
|
1.1 ! root 1: C***********************************************************************00010500 ! 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 00020500 ! 6: C***** FM500 00030500 ! 7: C***** BLKD1 - (260) 00040500 ! 8: C***** THIS PROGRAM USES SN501 AND AN502 00050500 ! 9: C***********************************************************************00060500 ! 10: C***** TESTING OF BLOCK DATA SUBPROGRAMS FEATURES ANS REF 00070500 ! 11: C***** IMPLICIT, PARAMETER, EXTERNAL, AND SAVE 16 00080500 ! 12: C***** THIS SEGMENT USES BLOCK DATA PROGRAM 00090500 ! 13: C***** AN502 AND SUBROUTINE SN501 00100500 ! 14: C***** 00110500 ! 15: C***** S P E C I F I C A T I O N S SEGMENT 260 00120500 ! 16: EXTERNAL AN502 00130500 ! 17: C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00140500 ! 18: C***** PARAMETER (KPI = 2, LPI = 10) 00150500 ! 19: C***** INTEGER FXVI 00160500 ! 20: C***** REAL JX1S 00170500 ! 21: C***** DOUBLE PRECISION AX1D, BX4D 00180500 ! 22: C***** DIMENSION BX4D(KPI, KPI, KPI, KPI) 00190500 ! 23: C***** COMPLEX AXVC, BX1C, CZ5C 00200500 ! 24: C***** LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00210500 ! 25: C***** CHARACTER*1 A1XVK, B1X1K, C1X7K 00220500 ! 26: C***** CHARACTER*2 D2Z1K 00230500 ! 27: C***** CHARACTER*4 E4XVK, G4X2K 00240500 ! 28: C***** CHARACTER*(LPI) I10XVK 00250500 ! 29: C***** 00260500 ! 30: C***** COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00270500 ! 31: C***** COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00280500 ! 32: C***** COMMON /BLK3/ RXVD, AX1D(2), BX4D 00290500 ! 33: C***** COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00300500 ! 34: C***** COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00310500 ! 35: C***** COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00320500 ! 36: C***** S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00330500 ! 37: C***** 00340500 ! 38: CALL SN501 00350500 ! 39: STOP 00360500 ! 40: C***** END OF TEST SEGMENT 260 00370500 ! 41: END 00380500 ! 42: C***********************************************************************00010501 ! 43: C DATE***82/08/02*18.33.46 ! 44: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 45: C AUDIT FCVS78 V2.0 ! 46: C***** FORTRAN 77 00020501 ! 47: C***** FM501 SN501 - (251) 00030501 ! 48: C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM500 00040501 ! 49: C***********************************************************************00050501 ! 50: C***** 00060501 ! 51: C***** GENERAL PURPOSE 00070501 ! 52: C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250 00080501 ! 53: C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090501 ! 54: C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100501 ! 55: C***** VARIABLES 00110501 ! 56: C***** 00120501 ! 57: CBB** ********************** BBCCOMNT **********************************00130501 ! 58: C**** 00140501 ! 59: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150501 ! 60: C**** VERSION 2.0 00160501 ! 61: C**** 00170501 ! 62: C**** 00180501 ! 63: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190501 ! 64: C**** GENERAL SERVICES ADMINISTRATION 00200501 ! 65: C**** FEDERAL SOFTWARE TESTING CENTER 00210501 ! 66: C**** 5203 LEESBURG PIKE, SUITE 1100 00220501 ! 67: C**** FALLS CHURCH, VA. 22041 00230501 ! 68: C**** 00240501 ! 69: C**** (703) 756-6153 00250501 ! 70: C**** 00260501 ! 71: CBE** ********************** BBCCOMNT **********************************00270501 ! 72: SUBROUTINE SN501 00280501 ! 73: C***** 00290501 ! 74: IMPLICIT INTEGER (H) 00300501 ! 75: IMPLICIT DOUBLE PRECISION (R) 00310501 ! 76: IMPLICIT CHARACTER*2 (S) 00320501 ! 77: C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00330501 ! 78: PARAMETER (KPI = 2, LPI = 10) 00340501 ! 79: INTEGER FXVI 00350501 ! 80: REAL JX1S 00360501 ! 81: DOUBLE PRECISION AX1D, BX4D, DVCORR 00370501 ! 82: DIMENSION BX4D(KPI, KPI, KPI, KPI) 00380501 ! 83: COMPLEX AXVC, BX1C, CZ5C 00390501 ! 84: LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00400501 ! 85: CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01 00410501 ! 86: CHARACTER*2 D2Z1K, CVNC02 00420501 ! 87: CHARACTER*4 E4XVK, G4X2K, CVNC04 00430501 ! 88: CHARACTER*(LPI) I10XVK, CVNC10 00440501 ! 89: C***** 00450501 ! 90: COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00460501 ! 91: COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00470501 ! 92: COMMON /BLK3/ RXVD, AX1D(2), BX4D 00480501 ! 93: COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00490501 ! 94: COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00500501 ! 95: COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00510501 ! 96: 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00520501 ! 97: C***** 00530501 ! 98: SAVE/BLK6/ 00540501 ! 99: C***** 00550501 ! 100: EQUIVALENCE (NYVI, EZVS) 00560501 ! 101: C***** LOCAL DECLARATIONS 00570501 ! 102: DOUBLE PRECISION AVD 00580501 ! 103: COMPLEX AVC 00590501 ! 104: C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. 00600501 ! 105: CBB** ********************** BBCINITA **********************************00610501 ! 106: C**** SPECIFICATION STATEMENTS 00620501 ! 107: C**** 00630501 ! 108: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00640501 ! 109: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00650501 ! 110: CBE** ********************** BBCINITA **********************************00660501 ! 111: CBB** ********************** BBCINITB **********************************00670501 ! 112: C**** INITIALIZE SECTION 00680501 ! 113: DATA ZVERS, ZVERSD, ZDATE 00690501 ! 114: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00700501 ! 115: DATA ZCOMPL, ZNAME, ZTAPE 00710501 ! 116: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00720501 ! 117: DATA ZPROJ, ZTAPED, ZPROG 00730501 ! 118: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00740501 ! 119: DATA REMRKS /' '/ 00750501 ! 120: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00760501 ! 121: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00770501 ! 122: C**** 00780501 ! 123: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00790501 ! 124: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00800501 ! 125: CZ03 ZPROG = 'PROGRAM NAME' 00810501 ! 126: ZDATE = '07-Nov-85 ' *RP ! 127: ZCOMPL = 'CCI 5.2 ' *RP ! 128: ZPROJ = 'TC-85- -410' *RP ! 129: ZNAME = ' ' *RP ! 130: ZTAPE = ' ' *RP ! 131: ZTAPED = '850703 ' *RP ! 132: C 00880501 ! 133: IVPASS = 0 00890501 ! 134: IVFAIL = 0 00900501 ! 135: IVDELE = 0 00910501 ! 136: IVINSP = 0 00920501 ! 137: IVTOTL = 0 00930501 ! 138: IVTOTN = 0 00940501 ! 139: ICZERO = 0 00950501 ! 140: C 00960501 ! 141: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00970501 ! 142: I01 = 05 00980501 ! 143: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00990501 ! 144: I02 = 06 01000501 ! 145: C 01010501 ! 146: I01 = 5 01020501 ! 147: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030501 ! 148: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01040501 ! 149: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01050501 ! 150: C 01060501 ! 151: I02 = 6 01070501 ! 152: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01080501 ! 153: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01090501 ! 154: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01100501 ! 155: C 01110501 ! 156: CBE** ********************** BBCINITB **********************************01120501 ! 157: NWVI = I02 01130501 ! 158: IVTOTL = 37 01140501 ! 159: ZPROG='FM500' 01150501 ! 160: CBB** ********************** BBCHED0A **********************************01160501 ! 161: C**** 01170501 ! 162: C**** WRITE REPORT TITLE 01180501 ! 163: C**** 01190501 ! 164: WRITE (I02, 90002) 01200501 ! 165: WRITE (I02, 90006) 01210501 ! 166: WRITE (I02, 90007) 01220501 ! 167: WRITE (I02, 90008) ZVERS, ZVERSD 01230501 ! 168: WRITE (I02, 90009) ZPROG, ZPROG 01240501 ! 169: WRITE (I02, 90010) ZDATE, ZCOMPL 01250501 ! 170: CBE** ********************** BBCHED0A **********************************01260501 ! 171: C***** 01270501 ! 172: WRITE(NWVI,26000) 01280501 ! 173: 26000 FORMAT( / 40H BLKD1 - (260) BLOCK DATA SUBPROGRAMS --/ 01290501 ! 174: 1 37H IMPLICIT, PARAMETER, EXTERNAL, SAVE// 01300501 ! 175: 2 15H ANS REF. - 16) 01310501 ! 176: C***** 01320501 ! 177: CBB** ********************** BBCHED0B **********************************01330501 ! 178: C**** WRITE DETAIL REPORT HEADERS 01340501 ! 179: C**** 01350501 ! 180: WRITE (I02,90004) 01360501 ! 181: WRITE (I02,90004) 01370501 ! 182: WRITE (I02,90013) 01380501 ! 183: WRITE (I02,90014) 01390501 ! 184: WRITE (I02,90015) IVTOTL 01400501 ! 185: CBE** ********************** BBCHED0B **********************************01410501 ! 186: C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1 01420501 ! 187: C**** REPLACE THE DELETE COMMENT WITH DELETE CODE 01430501 ! 188: CT001* TEST 1 INTEGER VARIABLE 01440501 ! 189: IVTNUM=1 01450501 ! 190: WRITE (NWVI,70140) 01460501 ! 191: IVCORR=5 01470501 ! 192: 40010 IF (IXVI - 5) 20010,10010,20010 01480501 ! 193: 10010 IVPASS=IVPASS+1 01490501 ! 194: WRITE (NWVI,80002) IVTNUM 01500501 ! 195: GO TO 0011 01510501 ! 196: 20010 IVFAIL=IVFAIL+1 01520501 ! 197: WRITE (NWVI,80008) IVTNUM 01530501 ! 198: WRITE (NWVI,80024) IXVI 01540501 ! 199: WRITE (NWVI,80026) IVCORR 01550501 ! 200: 0011 CONTINUE 01560501 ! 201: CT002* TEST 2 INTEGER DECLARE VARIABLE 01570501 ! 202: IVTNUM = 2 01580501 ! 203: IVCORR=6 01590501 ! 204: IF (FXVI - 6) 20020,10020,20020 01600501 ! 205: 10020 IVPASS=IVPASS+1 01610501 ! 206: WRITE (NWVI,80002) IVTNUM 01620501 ! 207: GO TO 0021 01630501 ! 208: 20020 IVFAIL=IVFAIL+1 01640501 ! 209: WRITE (NWVI,80008) IVTNUM 01650501 ! 210: WRITE (NWVI,80024) FXVI 01660501 ! 211: WRITE (NWVI,80026) IVCORR 01670501 ! 212: 0021 CONTINUE 01680501 ! 213: CT003* TEST 3 INTEGER ARRAY 01690501 ! 214: IVTNUM = 3 01700501 ! 215: IVCORR=8 01710501 ! 216: IF (KX1I(2) - 8) 20030,10030,20030 01720501 ! 217: 10030 IVPASS=IVPASS+1 01730501 ! 218: WRITE (NWVI,80002) IVTNUM 01740501 ! 219: GO TO 0031 01750501 ! 220: 20030 IVFAIL=IVFAIL+1 01760501 ! 221: WRITE (NWVI,80008) IVTNUM 01770501 ! 222: WRITE (NWVI,80024) KX1I(2) 01780501 ! 223: WRITE (NWVI,80026) IVCORR 01790501 ! 224: 0031 CONTINUE 01800501 ! 225: CT004* TEST 4 IMPLICIT INTEGER ARRAY 01810501 ! 226: IVTNUM = 4 01820501 ! 227: IVCORR=1 01830501 ! 228: IF (HX2I(1,2) - 1) 20040,10040,20040 01840501 ! 229: 10040 IVPASS=IVPASS+1 01850501 ! 230: WRITE (NWVI,80002) IVTNUM 01860501 ! 231: GO TO 0041 01870501 ! 232: 20040 IVFAIL=IVFAIL+1 01880501 ! 233: WRITE (NWVI,80008) IVTNUM 01890501 ! 234: WRITE (NWVI,80024) HX2I(1,2) 01900501 ! 235: WRITE (NWVI,80026) IVCORR 01910501 ! 236: 0041 CONTINUE 01920501 ! 237: CT005* TEST 5 01930501 ! 238: IVTNUM = 5 01940501 ! 239: IVCORR=5 01950501 ! 240: IF (HX2I(2,2) - 5) 20050,10050,20050 01960501 ! 241: 10050 IVPASS=IVPASS+1 01970501 ! 242: WRITE (NWVI,80002) IVTNUM 01980501 ! 243: GO TO 0051 01990501 ! 244: 20050 IVFAIL=IVFAIL+1 02000501 ! 245: WRITE (NWVI,80008) IVTNUM 02010501 ! 246: WRITE (NWVI,80024) HX2I(2,2) 02020501 ! 247: WRITE (NWVI,80026) IVCORR 02030501 ! 248: 0051 CONTINUE 02040501 ! 249: CT006* TEST 6 DO INITIALIZE INTEGER ARRAY 02050501 ! 250: IVTNUM = 6 02060501 ! 251: IVINSP=IVINSP+1 02070501 ! 252: WRITE (NWVI,80004) IVTNUM 02080501 ! 253: DO 70101 KVI = 1, 2 02090501 ! 254: IVI = MX2I(KVI, KVI) - 4 02100501 ! 255: WRITE (NWVI, 70100) IVI 02110501 ! 256: 70101 CONTINUE 02120501 ! 257: CT007* TEST 7 REAL VARIABLE 02130501 ! 258: IVTNUM = 7 02140501 ! 259: RVCORR=5.3 02150501 ! 260: RVCOMP=0.0 02160501 ! 261: RVCOMP=AXVS - 5.3 02170501 ! 262: IF (RVCOMP + .00005) 20070,10070,40070 02180501 ! 263: 40070 IF (RVCOMP - .00005) 10070,10070,20070 02190501 ! 264: 10070 IVPASS=IVPASS+1 02200501 ! 265: WRITE (NWVI,80002) IVTNUM 02210501 ! 266: GO TO 0071 02220501 ! 267: 20070 IVFAIL=IVFAIL+1 02230501 ! 268: WRITE (NWVI,80008) IVTNUM 02240501 ! 269: WRITE (NWVI,80028) AXVS 02250501 ! 270: WRITE (NWVI,80030) RVCORR 02260501 ! 271: 0071 CONTINUE 02270501 ! 272: CT008* TEST 8 EXTENDED PRECISION REAL 02280501 ! 273: IVTNUM = 8 02290501 ! 274: AVS = BXVS - 1.23456789012345 02300501 ! 275: RVCOMP=1.23456789012345 02310501 ! 276: IF (AVS + .00005) 20080,10080,40080 02320501 ! 277: 40080 IF (AVS - .00005) 10080,10080,20080 02330501 ! 278: 10080 IVPASS=IVPASS+1 02340501 ! 279: WRITE (NWVI,80002) IVTNUM 02350501 ! 280: GO TO 0081 02360501 ! 281: 20080 IVFAIL=IVFAIL+1 02370501 ! 282: WRITE (NWVI,80004) IVTNUM 02380501 ! 283: 70080 FORMAT (1H ,16X,10HCOMPUTED: ,E20.14) 02390501 ! 284: WRITE (NWVI,70080) BXVS 02400501 ! 285: 70081 FORMAT (1H ,16X,10HCORRECT: ,E20.14) 02410501 ! 286: WRITE (NWVI, 70081) RVCOMP 02420501 ! 287: 0081 CONTINUE 02430501 ! 288: CT009* TEST 9 DECLARED REAL ARRAY 02440501 ! 289: IVTNUM = 9 02450501 ! 290: RVCORR=2.45 02460501 ! 291: RVCOMP=2.0 02470501 ! 292: RVCOMP=(JX1S(1) - 2.45) 02480501 ! 293: IF (RVCOMP + .00005) 20090,10090,40090 02490501 ! 294: 40090 IF (RVCOMP - .00005) 10090,10090,20090 02500501 ! 295: 10090 IVPASS=IVPASS+1 02510501 ! 296: WRITE (NWVI,80002) IVTNUM 02520501 ! 297: GO TO 0091 02530501 ! 298: 20090 IVFAIL=IVFAIL+1 02540501 ! 299: WRITE (NWVI,80008) IVTNUM 02550501 ! 300: WRITE (NWVI,80028) JX1S(1) 02560501 ! 301: WRITE (NWVI,80030) RVCORR 02570501 ! 302: 0091 CONTINUE 02580501 ! 303: CT010* TEST 10 02590501 ! 304: IVTNUM = 10 02600501 ! 305: RVCORR=4.58 02610501 ! 306: RVCOMP=2.0 02620501 ! 307: RVCOMP=(JX1S(2) - 4.58) 02630501 ! 308: 40100 IF (RVCOMP + .00005) 20100,10100,40101 02640501 ! 309: 40101 IF (RVCOMP - .00005) 10100,10100,20100 02650501 ! 310: 10100 IVPASS=IVPASS+1 02660501 ! 311: WRITE (NWVI,80002) 02670501 ! 312: GO TO 0100 02680501 ! 313: 20100 IVFAIL=IVFAIL+1 02690501 ! 314: WRITE (NWVI,80008) IVTNUM 02700501 ! 315: WRITE (NWVI,80028) JX1S(2) 02710501 ! 316: WRITE (NWVI,80030) RVCORR 02720501 ! 317: 0100 CONTINUE 02730501 ! 318: CT011* TEST 11 REAL ARRAY - NAME ONLY 02740501 ! 319: IVTNUM = 11 02750501 ! 320: IVINSP=IVINSP+1 02760501 ! 321: WRITE (NWVI,80004) IVTNUM 02770501 ! 322: DO 70103 KVI = 1, 2 02780501 ! 323: AVS = CX2S(KVI, KVI) - 1.2 02790501 ! 324: WRITE (NWVI, 70102) AVS 02800501 ! 325: 70103 CONTINUE 02810501 ! 326: CT012* TEST 12 EQUIVALENCED REAL ARRAY 02820501 ! 327: IVTNUM = 12 02830501 ! 328: IVINSP=IVINSP+1 02840501 ! 329: WRITE (NWVI,80004) IVTNUM 02850501 ! 330: DO 70104 KVI=1,2 02860501 ! 331: AVS = DZ3S(KVI, KVI, KVI) - 1.1 02870501 ! 332: WRITE (NWVI, 70102) AVS 02880501 ! 333: 70104 CONTINUE 02890501 ! 334: CT013* TEST 13 REAL VARIABLE - EQUIVALENCED INTEGER 02900501 ! 335: IVTNUM = 13 02910501 ! 336: IVCORR=34 02920501 ! 337: IVI = NYVI - 34 02930501 ! 338: 40130 IF (IVI - 0) 20130,10130,20130 02940501 ! 339: 10130 IVPASS=IVPASS+1 02950501 ! 340: WRITE (NWVI,80002) IVTNUM 02960501 ! 341: GO TO 0131 02970501 ! 342: 20130 IVFAIL=IVFAIL+1 02980501 ! 343: WRITE (NWVI,80008) IVTNUM 02990501 ! 344: WRITE (NWVI,80028) NYVI 03000501 ! 345: WRITE (NWVI,80026) IVCORR 03010501 ! 346: 0131 CONTINUE 03020501 ! 347: CT014* TEST 14 DOUBLE PRECISION ARRAY 03030501 ! 348: IVTNUM = 14 03040501 ! 349: KVI=1 03050501 ! 350: AVD = AX1D(KVI) - 1.456D3 03060501 ! 351: DVCORR=1.456D3 03070501 ! 352: IF (AVD + .0000000005) 20140,40141,40140 03080501 ! 353: 40140 IF (AVD - .0000000005) 40141,40141,20140 03090501 ! 354: 40141 KVI=2 03100501 ! 355: AVD = AX1D(KVI) - 1.456D3 03110501 ! 356: IF (AVD + .0000000005) 20140,10140,40142 03120501 ! 357: 40142 IF (AVD - .0000000005) 10140,10140,20140 03130501 ! 358: 10140 IVPASS=IVPASS+1 03140501 ! 359: WRITE (NWVI,80002) IVTNUM 03150501 ! 360: GO TO 0141 03160501 ! 361: 20140 IVFAIL=IVFAIL+1 03170501 ! 362: WRITE (NWVI,80008) IVTNUM 03180501 ! 363: WRITE (NWVI, 80033) AX1D(KVI) 03190501 ! 364: WRITE (NWVI,80035) DVCORR 03200501 ! 365: 0141 CONTINUE 03210501 ! 366: CT015* TEST 15 DIMENSION DOUBLE PRECISION ARRAY 03220501 ! 367: IVTNUM = 15 03230501 ! 368: AVD = BX4D(1,2,1,1) - 34.9D8 03240501 ! 369: IF (AVD + .0000000005) 20150,10150,40150 03250501 ! 370: 40150 IF (AVD - .0000000005) 10150,10150,20150 03260501 ! 371: 10150 IVPASS=IVPASS+1 03270501 ! 372: WRITE (NWVI,80002) IVTNUM 03280501 ! 373: GO TO 0151 03290501 ! 374: 20150 IVFAIL=IVFAIL+1 03300501 ! 375: DVCORR=34.9D8 03310501 ! 376: WRITE (NWVI,80008) IVTNUM 03320501 ! 377: WRITE (NWVI, 80033) BX4D(1,2,1,1) 03330501 ! 378: WRITE (NWVI,80035) DVCORR 03340501 ! 379: 0151 CONTINUE 03350501 ! 380: CT016* TEST 16 03360501 ! 381: IVTNUM = 16 03370501 ! 382: DVCORR=0.00 03380501 ! 383: AVD = BX4D(1,2,1,2) - 2.123D0 03390501 ! 384: IF (AVD + .0000000005) 20160,10160,40160 03400501 ! 385: 40160 IF (AVD - .0000000005) 10160,10160,20160 03410501 ! 386: 10160 IVPASS=IVPASS+1 03420501 ! 387: WRITE (NWVI,80002) IVTNUM 03430501 ! 388: GO TO 0161 03440501 ! 389: 20160 IVFAIL=IVFAIL+1 03450501 ! 390: DVCORR=2.123D0 03460501 ! 391: WRITE (NWVI,80008) IVTNUM 03470501 ! 392: WRITE (NWVI, 80033) BX4D(1,2,1,2) 03480501 ! 393: WRITE (NWVI,80035) DVCORR 03490501 ! 394: 0161 CONTINUE 03500501 ! 395: CT017* TEST 17 03510501 ! 396: IVTNUM = 17 03520501 ! 397: DVCORR=0.00 03530501 ! 398: AVD = BX4D(2,1,1,2) - 873.84D-1 03540501 ! 399: IF (AVD + .0000000005) 20170,10170,40170 03550501 ! 400: 40170 IF (AVD - .0000000005) 10170,10170,20170 03560501 ! 401: 10170 IVPASS=IVPASS+1 03570501 ! 402: WRITE (NWVI,80002) IVTNUM 03580501 ! 403: GO TO 0171 03590501 ! 404: 20170 IVFAIL=IVFAIL+1 03600501 ! 405: WRITE (NWVI,80008) IVTNUM 03610501 ! 406: DVCORR=873.84D-1 03620501 ! 407: WRITE (NWVI, 80033) BX4D(2,1,1,2) 03630501 ! 408: WRITE (NWVI,80035) DVCORR 03640501 ! 409: 0171 CONTINUE 03650501 ! 410: CT018* TEST 18 COMPLEX VARIABLE 03660501 ! 411: IVTNUM = 18 03670501 ! 412: AVC = AXVC - (1.5, 2.3) 03680501 ! 413: IVINSP=IVINSP+1 03690501 ! 414: WRITE (NWVI,80004) IVTNUM 03700501 ! 415: WRITE (NWVI,70107) AVC 03710501 ! 416: CT019* TEST 19 COMPLEX ARRAY 03720501 ! 417: IVTNUM = 19 03730501 ! 418: AVC = BX1C(1) - (1.1, 1.2) 03740501 ! 419: IVINSP=IVINSP+1 03750501 ! 420: WRITE (NWVI,80004) IVTNUM 03760501 ! 421: WRITE (NWVI, 70107) AVC 03770501 ! 422: CT020* TEST 20 03780501 ! 423: IVTNUM = 20 03790501 ! 424: AVC = BX1C(2) - (3.2, 2.3) 03800501 ! 425: IVINSP=IVINSP+1 03810501 ! 426: WRITE (NWVI,80004) IVTNUM 03820501 ! 427: WRITE (NWVI, 70107) AVC 03830501 ! 428: CT021* TEST 21 COMPLEX ARRAY - EQUIVALENCE 03840501 ! 429: IVTNUM = 21 03850501 ! 430: AVC = CZ5C(1,1,1,2,1) - (1.2, 2.1) 03860501 ! 431: IVINSP=IVINSP+1 03870501 ! 432: WRITE (NWVI,80004) IVTNUM 03880501 ! 433: WRITE (NWVI, 70107) AVC 03890501 ! 434: CT022* TEST 22 03900501 ! 435: IVTNUM = 22 03910501 ! 436: AVC = CZ5C(1,2,1,1,2) - (45.3, 2.1) 03920501 ! 437: IVINSP=IVINSP+1 03930501 ! 438: WRITE (NWVI,80004) IVTNUM 03940501 ! 439: WRITE (NWVI, 70107) AVC 03950501 ! 440: CT023* TEST 23 03960501 ! 441: IVTNUM = 23 03970501 ! 442: AVC = CZ5C(2,1,1,1,2) - (309.89, 102.1) 03980501 ! 443: IVINSP=IVINSP+1 03990501 ! 444: WRITE (NWVI,80004) IVTNUM 04000501 ! 445: WRITE (NWVI, 70107) AVC 04010501 ! 446: CT024* TEST 24 LOGICAL VARIABLE 04020501 ! 447: IVTNUM = 24 04030501 ! 448: IVCOMP=0 04040501 ! 449: IF (AXVB) IVCOMP=1 04050501 ! 450: 40240 IF (IVCOMP-1) 20240,10240,20240 04060501 ! 451: 10240 IVPASS=IVPASS+1 04070501 ! 452: WRITE (NWVI,80002) IVTNUM 04080501 ! 453: GO TO 0241 04090501 ! 454: 20240 IVFAIL=IVFAIL+1 04100501 ! 455: WRITE (NWVI,80008) IVTNUM 04110501 ! 456: 0241 CONTINUE 04120501 ! 457: CT025* TEST 25 LOGICAL ARRAY - EQUIVALENCE 04130501 ! 458: IVTNUM = 25 04140501 ! 459: IVCOMP=0 04150501 ! 460: IF (.NOT. BZ1B(2)) IVCOMP=1 04160501 ! 461: 40250 IF (IVCOMP-1) 20250,10250,20250 04170501 ! 462: 10250 IVPASS=IVPASS+1 04180501 ! 463: WRITE (NWVI,80002) IVTNUM 04190501 ! 464: GO TO 0251 04200501 ! 465: 20250 IVFAIL=IVFAIL+1 04210501 ! 466: WRITE (NWVI,80008) IVTNUM 04220501 ! 467: 0251 CONTINUE 04230501 ! 468: CT026* TEST 26 DECLARED LOGICAL ARRAY 04240501 ! 469: IVTNUM = 26 04250501 ! 470: IVCOMP=0 04260501 ! 471: IF (CX6B(1,1,1,2,2,1)) IVCOMP=1 04270501 ! 472: 40260 IF (IVCOMP-1) 20260,10260,20260 04280501 ! 473: 10260 IVPASS=IVPASS+1 04290501 ! 474: WRITE (NWVI,80002) IVTNUM 04300501 ! 475: GO TO 0261 04310501 ! 476: 20260 IVFAIL=IVFAIL+1 04320501 ! 477: WRITE (NWVI,80008) IVTNUM 04330501 ! 478: 0261 CONTINUE 04340501 ! 479: CT027* TEST 27 1 CHARACTER VARIABLE 04350501 ! 480: IVTNUM = 27 04360501 ! 481: CVNC01='A' 04370501 ! 482: IVCOMP=0 04380501 ! 483: IF (A1XVK .EQ. 'A') IVCOMP=1 04390501 ! 484: 40270 IF (IVCOMP-1) 20270,10270,20270 04400501 ! 485: 10270 IVPASS=IVPASS+1 04410501 ! 486: WRITE (NWVI,80002) IVTNUM 04420501 ! 487: GO TO 0271 04430501 ! 488: 20270 IVFAIL=IVFAIL+1 04440501 ! 489: WRITE (NWVI,80008) IVTNUM 04450501 ! 490: WRITE (NWVI,80020) A1XVK 04460501 ! 491: WRITE (NWVI,80022) CVNC01 04470501 ! 492: 0271 CONTINUE 04480501 ! 493: CT028* TEST 28 1 CHARACTER ARRAY 04490501 ! 494: IVTNUM = 28 04500501 ! 495: CVNC01='K' 04510501 ! 496: IVCOMP=0 04520501 ! 497: IF (B1X1K(1) .EQ. 'K') IVCOMP=1 04530501 ! 498: 40280 IF (IVCOMP-1) 20280,10280,20280 04540501 ! 499: 10280 IVPASS=IVPASS+1 04550501 ! 500: WRITE (NWVI,80002) IVTNUM 04560501 ! 501: GO TO 0281 04570501 ! 502: 20280 IVFAIL=IVFAIL+1 04580501 ! 503: WRITE (NWVI,80008) IVTNUM 04590501 ! 504: WRITE (NWVI,80020) B1X1K(1) 04600501 ! 505: WRITE (NWVI,80022) CVNC01 04610501 ! 506: 0281 CONTINUE 04620501 ! 507: CT029* TEST 29 04630501 ! 508: IVTNUM = 29 04640501 ! 509: CVNC01='K' 04650501 ! 510: IVCOMP=0 04660501 ! 511: IF (B1X1K(2) .EQ. 'K') IVCOMP=1 04670501 ! 512: IF (IVCOMP-1) 20290,10290,20290 04680501 ! 513: 10290 IVPASS=IVPASS+1 04690501 ! 514: WRITE (NWVI,80002) IVTNUM 04700501 ! 515: GO TO 0291 04710501 ! 516: 20290 IVFAIL=IVFAIL+1 04720501 ! 517: WRITE (NWVI,80008) IVTNUM 04730501 ! 518: WRITE (NWVI,80020) B1X1K(2) 04740501 ! 519: WRITE (NWVI,80022) CVNC01 04750501 ! 520: 0291 CONTINUE 04760501 ! 521: CT030* TEST 30 7 DIMENSION 1 CHARACTER ARRAY 04770501 ! 522: IVTNUM = 30 04780501 ! 523: CVNC01='X' 04790501 ! 524: IVCOMP=0 04800501 ! 525: KVI=1 04810501 ! 526: IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04820501 ! 527: 40300 IF(IVCOMP-1) 20300,40301,20300 04830501 ! 528: 40301 KVI=2 04840501 ! 529: IVCOMP=0 04850501 ! 530: IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04860501 ! 531: 40302 IF (IVCOMP-1) 20300,40303,20300 04870501 ! 532: 40303 IVPASS=IVPASS+1 04880501 ! 533: WRITE (NWVI,80002) IVTNUM 04890501 ! 534: GO TO 0301 04900501 ! 535: 20300 IVFAIL=IVFAIL+1 04910501 ! 536: WRITE (NWVI,80008) IVTNUM 04920501 ! 537: WRITE (NWVI,80020) C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) 04930501 ! 538: WRITE (NWVI,80022) CVNC01 04940501 ! 539: 0301 CONTINUE 04950501 ! 540: CT031* TEST 31 IMPLICIT 2 CHARACTER VARIABLE 04960501 ! 541: IVTNUM = 31 04970501 ! 542: CVNC02='.,' 04980501 ! 543: IVCOMP=0 04990501 ! 544: IF (S2XVK .EQ. '.,') IVCOMP=1 05000501 ! 545: 40310 IF (IVCOMP-1) 20310,10310,20310 05010501 ! 546: 10310 IVPASS=IVPASS+1 05020501 ! 547: WRITE (NWVI,80002) IVTNUM 05030501 ! 548: GO TO 0311 05040501 ! 549: 20310 IVFAIL=IVFAIL+1 05050501 ! 550: WRITE (NWVI,80008) IVTNUM 05060501 ! 551: WRITE (NWVI,80020) S2XVK 05070501 ! 552: WRITE (NWVI,80022) CVNC02 05080501 ! 553: 0311 CONTINUE 05090501 ! 554: CT032* TEST 32 2 CHARACTER ARRAY - EQUIVALENCED 05100501 ! 555: IVTNUM = 32 05110501 ! 556: CVNC02='TE' 05120501 ! 557: IVCOMP=0 05130501 ! 558: IF (D2Z1K(1) .EQ. 'TE') IVCOMP=1 05140501 ! 559: 40320 IF (IVCOMP-1) 20320,10320,20320 05150501 ! 560: 10320 IVPASS=IVPASS+1 05160501 ! 561: WRITE (NWVI,80002) IVTNUM 05170501 ! 562: GO TO 0321 05180501 ! 563: 20320 IVFAIL=IVFAIL+1 05190501 ! 564: WRITE (NWVI,80008) IVTNUM 05200501 ! 565: WRITE (NWVI,80020) D2Z1K(1) 05210501 ! 566: WRITE (NWVI,80022) CVNC02 05220501 ! 567: 0321 CONTINUE 05230501 ! 568: CT033* TEST 33 05240501 ! 569: IVTNUM = 33 05250501 ! 570: CVNC02='ST' 05260501 ! 571: IVCOMP=0 05270501 ! 572: IF (D2Z1K(2) .EQ. 'ST') IVCOMP=1 05280501 ! 573: 40330 IF (IVCOMP-1) 20330,10330,20330 05290501 ! 574: 10330 IVPASS=IVPASS+1 05300501 ! 575: WRITE (NWVI,80002) IVTNUM 05310501 ! 576: GO TO 0331 05320501 ! 577: 20330 IVFAIL=IVFAIL+1 05330501 ! 578: WRITE (NWVI,80008) IVTNUM 05340501 ! 579: WRITE (NWVI,80020) D2Z1K(2) 05350501 ! 580: WRITE (NWVI,80022) CVNC02 05360501 ! 581: 0331 CONTINUE 05370501 ! 582: CT034* TEST 34 DECLARED 4 CHARACTER VARIABLE 05380501 ! 583: IVTNUM = 34 05390501 ! 584: CVNC04='ZXCV' 05400501 ! 585: IVCOMP=0 05410501 ! 586: IF (E4XVK .EQ. 'ZXCV') IVCOMP=1 05420501 ! 587: 40340 IF (IVCOMP-1) 20340,10340,20340 05430501 ! 588: 10340 IVPASS=IVPASS+1 05440501 ! 589: WRITE (NWVI,80002) IVTNUM 05450501 ! 590: GO TO 0341 05460501 ! 591: 20340 IVFAIL=IVFAIL+1 05470501 ! 592: WRITE (NWVI,80008) IVTNUM 05480501 ! 593: WRITE (NWVI,80020) E4XVK 05490501 ! 594: WRITE (NWVI,80022) CVNC04 05500501 ! 595: 0341 CONTINUE 05510501 ! 596: CT035* TEST 35 DECLARED 4 CHARACTER ARRAY 05520501 ! 597: IVTNUM = 35 05530501 ! 598: CVNC02='SO' 05540501 ! 599: IVCOMP=0 05550501 ! 600: IF (G4X2K(1,1) .EQ. 'SO') IVCOMP=1 05560501 ! 601: 40350 IF (IVCOMP-1) 20350,10350,20350 05570501 ! 602: 10350 IVPASS=IVPASS+1 05580501 ! 603: WRITE (NWVI,80002) IVTNUM 05590501 ! 604: GO TO 0351 05600501 ! 605: 20350 IVFAIL=IVFAIL+1 05610501 ! 606: WRITE (NWVI,80008) IVTNUM 05620501 ! 607: WRITE (NWVI,80020) G4X2K(1,1) 05630501 ! 608: WRITE (NWVI,80022) CVNC02 05640501 ! 609: 0351 CONTINUE 05650501 ! 610: CT036* TEST 36 05660501 ! 611: IVTNUM = 36 05670501 ! 612: CVNC02='OS' 05680501 ! 613: IVCOMP=0 05690501 ! 614: IF (G4X2K(2,1) .EQ. 'OS') IVCOMP=1 05700501 ! 615: 40360 IF (IVCOMP-1) 20360,10360,20360 05710501 ! 616: 10360 IVPASS=IVPASS+1 05720501 ! 617: WRITE (NWVI,80002) IVTNUM 05730501 ! 618: GO TO 0361 05740501 ! 619: 20360 IVFAIL=IVFAIL+1 05750501 ! 620: WRITE (NWVI,80008) IVTNUM 05760501 ! 621: WRITE (NWVI,80020) G4X2K(2,1) 05770501 ! 622: WRITE (NWVI,80022) CVNC02 05780501 ! 623: 0361 CONTINUE 05790501 ! 624: CT037* TEST 37 CHARACTER VARIABLE - PARAMTER LENGTH 05800501 ! 625: IVTNUM = 37 05810501 ! 626: CVNC10='FINAL TEST' 05820501 ! 627: IVCOMP=0 05830501 ! 628: IF (I10XVK .EQ. 'FINAL TEST') IVCOMP=1 05840501 ! 629: 40370 IF (IVCOMP-1) 20370, 10370, 20370 05850501 ! 630: 10370 IVPASS=IVPASS+1 05860501 ! 631: WRITE (NWVI,80002) IVTNUM 05870501 ! 632: GO TO 0371 05880501 ! 633: 20370 IVFAIL=IVFAIL+1 05890501 ! 634: WRITE (NWVI,80008) IVTNUM 05900501 ! 635: WRITE (NWVI,80020) I10XVK 05910501 ! 636: WRITE (NWVI,80022) CVNC10 05920501 ! 637: 0371 CONTINUE 05930501 ! 638: C***** 05940501 ! 639: 70100 FORMAT(1H ,26X,I5) 05950501 ! 640: 70102 FORMAT(1H ,26X,F7.2) 05960501 ! 641: 70106 FORMAT(1H ,26X,F7.2) 05970501 ! 642: 70107 FORMAT(1H ,26X,1H(,F7.2,2H, ,F7.2,1H),4X,14HSHOULD BE ZERO) 05980501 ! 643: 70140 FORMAT (/49X,28HALL VISUAL ANSWERS SHOULD BE 05990501 ! 644: 1 /49X,27HZERO FOR TEST SEGMENT TO BE 06000501 ! 645: 2 /49X,10HSUCCESSFUL) 06010501 ! 646: CBB** ********************** BBCSUM0 **********************************06020501 ! 647: C**** WRITE OUT TEST SUMMARY 06030501 ! 648: C**** 06040501 ! 649: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06050501 ! 650: WRITE (I02, 90004) 06060501 ! 651: WRITE (I02, 90014) 06070501 ! 652: WRITE (I02, 90004) 06080501 ! 653: WRITE (I02, 90020) IVPASS 06090501 ! 654: WRITE (I02, 90022) IVFAIL 06100501 ! 655: WRITE (I02, 90024) IVDELE 06110501 ! 656: WRITE (I02, 90026) IVINSP 06120501 ! 657: WRITE (I02, 90028) IVTOTN, IVTOTL 06130501 ! 658: CBE** ********************** BBCSUM0 **********************************06140501 ! 659: CBB** ********************** BBCFOOT0 **********************************06150501 ! 660: C**** WRITE OUT REPORT FOOTINGS 06160501 ! 661: C**** 06170501 ! 662: WRITE (I02,90016) ZPROG, ZPROG 06180501 ! 663: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06190501 ! 664: WRITE (I02,90019) 06200501 ! 665: CBE** ********************** BBCFOOT0 **********************************06210501 ! 666: CBB** ********************** BBCFMT0A **********************************06220501 ! 667: C**** FORMATS FOR TEST DETAIL LINES 06230501 ! 668: C**** 06240501 ! 669: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 06250501 ! 670: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 06260501 ! 671: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 06270501 ! 672: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 06280501 ! 673: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 06290501 ! 674: 1I6,/,1H ,15X,10HCORRECT= ,I6) 06300501 ! 675: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 06310501 ! 676: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 06320501 ! 677: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 06330501 ! 678: 1A21,/,1H ,16X,10HCORRECT= ,A21) 06340501 ! 679: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 06350501 ! 680: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 06360501 ! 681: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 06370501 ! 682: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 06380501 ! 683: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 06390501 ! 684: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 06400501 ! 685: 80050 FORMAT (1H ,48X,A31) 06410501 ! 686: CBE** ********************** BBCFMT0A **********************************06420501 ! 687: CBB** ********************** BBCFMAT1 **********************************06430501 ! 688: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06440501 ! 689: C**** 06450501 ! 690: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 06460501 ! 691: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 06470501 ! 692: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 06480501 ! 693: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 06490501 ! 694: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 06500501 ! 695: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 06510501 ! 696: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 06520501 ! 697: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 06530501 ! 698: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 06540501 ! 699: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 06550501 ! 700: 21H(,F12.5,2H, ,F12.5,1H)) 06560501 ! 701: CBE** ********************** BBCFMAT1 **********************************06570501 ! 702: CBB** ********************** BBCFMT0B **********************************06580501 ! 703: C**** FORMAT STATEMENTS FOR PAGE HEADERS 06590501 ! 704: C**** 06600501 ! 705: 90002 FORMAT (1H1) 06610501 ! 706: 90004 FORMAT (1H ) 06620501 ! 707: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 06630501 ! 708: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06640501 ! 709: 90008 FORMAT (1H ,21X,A13,A17) 06650501 ! 710: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 06660501 ! 711: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 06670501 ! 712: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 06680501 ! 713: 1 7X,7HREMARKS,24X) 06690501 ! 714: 90014 FORMAT (1H ,46H----------------------------------------------, 06700501 ! 715: 1 33H---------------------------------) 06710501 ! 716: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 06720501 ! 717: C**** 06730501 ! 718: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06740501 ! 719: C**** 06750501 ! 720: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 06760501 ! 721: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 06770501 ! 722: 1 A13) 06780501 ! 723: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 06790501 ! 724: C**** 06800501 ! 725: C**** FORMAT STATEMENTS FOR RUN SUMMARY 06810501 ! 726: C**** 06820501 ! 727: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 06830501 ! 728: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 06840501 ! 729: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 06850501 ! 730: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 06860501 ! 731: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 06870501 ! 732: CBE** ********************** BBCFMT0B **********************************06880501 ! 733: C***** 06890501 ! 734: RETURN 06900501 ! 735: END 06910501 ! 736: C***********************************************************************00010502 ! 737: C DATE***82/08/02*18.33.46 ! 738: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 739: C AUDIT FCVS78 V2.0 ! 740: C***** FORTRAN 77 00020502 ! 741: C***** FM502 AN502 00030502 ! 742: C***** THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500 00040502 ! 743: C***********************************************************************00050502 ! 744: C***** 00060502 ! 745: C***** GENERAL PURPOSE 00070502 ! 746: C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080502 ! 747: C***** TO BE RUN WITH SEGMENT FM500 00090502 ! 748: C***** THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL 00100502 ! 749: C***** AND SAVE STATEMENTS WITHIN IT. 00110502 ! 750: C***** 00120502 ! 751: BLOCK DATA AN502 00130502 ! 752: C***** 00140502 ! 753: IMPLICIT INTEGER (H) 00150502 ! 754: IMPLICIT DOUBLE PRECISION (R) 00160502 ! 755: IMPLICIT CHARACTER*2 (S) 00170502 ! 756: C***** 00180502 ! 757: SAVE/BLK6/ 00190502 ! 758: C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00200502 ! 759: PARAMETER (KPI = 2, LPI = 10) 00210502 ! 760: INTEGER FXVI 00220502 ! 761: REAL JX1S 00230502 ! 762: DOUBLE PRECISION AX1D, BX4D 00240502 ! 763: DIMENSION BX4D(KPI, KPI, KPI, KPI) 00250502 ! 764: COMPLEX AXVC, BX1C, CZ5C 00260502 ! 765: LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00270502 ! 766: CHARACTER*1 A1XVK, B1X1K, C1X7K 00280502 ! 767: CHARACTER*2 D2Z1K 00290502 ! 768: CHARACTER*4 E4XVK, G4X2K 00300502 ! 769: CHARACTER*(LPI) I10XVK 00310502 ! 770: C***** 00320502 ! 771: COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00330502 ! 772: COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00340502 ! 773: COMMON /BLK3/ RXVD, AX1D(2), BX4D 00350502 ! 774: COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00360502 ! 775: COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00370502 ! 776: COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00380502 ! 777: 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00390502 ! 778: C***** DECLARATION OF VARIABLES FOR EQUIVALENCE STATEMENTS 00400502 ! 779: DIMENSION AY3S(2,2,2) 00410502 ! 780: COMPLEX AY5C (2,2,2,2,2) 00420502 ! 781: LOGICAL AY1B(2) 00430502 ! 782: CHARACTER*2 A2Y1K(2) 00440502 ! 783: CHARACTER*1 APK 00450502 ! 784: PARAMETER (IPI = 5, APS = 5.3, JPI = 2, APK = 'X', MPI = 128) 00460502 ! 785: C***** 00470502 ! 786: EQUIVALENCE (AY3S, DZ3S) 00480502 ! 787: EQUIVALENCE (NYVI, EZVS) 00490502 ! 788: EQUIVALENCE (AY5C, CZ5C) 00500502 ! 789: EQUIVALENCE (AY1B, BZ1B) 00510502 ! 790: EQUIVALENCE (A2Y1K, D2Z1K) 00520502 ! 791: C***** 00530502 ! 792: DATA IXVI, FXVI, KX1I(2), HX2I(1,2), HX2I(2,2), 00540502 ! 793: 1 ((MX2I(IVI, JVI), IVI=1,2), JVI=1,2) /IPI, 6, 8, 1, 5, 4*4/ 00550502 ! 794: DATA AXVS, BXVS, JX1S(1), JX1S(2), CX2S /APS, 1.23456789012345, 00560502 ! 795: 1 2.45, 4.58, 4*1.2/ 00570502 ! 796: DATA AY3S / 8*1.1/ 00580502 ! 797: DATA NYVI /34/ 00590502 ! 798: DATA AX1D, BX4D(1,2,1,1), BX4D(1,2,1,2), BX4D(2,1,1,2) 00600502 ! 799: 1 /JPI*1.456D3, 34.9D8, 2.123D0, 873.84D-1/ 00610502 ! 800: DATA AXVC /(1.5, 2.3)/ 00620502 ! 801: DATA AY5C(1,1,1,2,1), AY5C(1,2,1,1,2), AY5C(2,1,1,1,2) 00630502 ! 802: 1 /(1.2, 2.1), (45.3, 2.1), (309.89, 102.1)/ 00640502 ! 803: DATA BX1C(1), BX1C(2), AXVB /(1.1, 1.2), (3.2, 2.3), .TRUE./ 00650502 ! 804: DATA AY1B(2), CX6B(1,1,1,2,2,1) /.FALSE., .TRUE./ 00660502 ! 805: DATA A1XVK, C1X7K, S2XVK, A2Y1K(1), A2Y1K(2), E4XVK, G4X2K(1,1),00670502 ! 806: 1 G4X2K(2,1), I10XVK, (B1X1K(IVI), IVI=1,2) 00680502 ! 807: 2 /'A', MPI*APK, '.,', 'TE', 'ST', 'ZXCV', 'SO', 'OS', 00690502 ! 808: 3 'FINAL TEST', 2*'K'/ 00700502 ! 809: C***** 00710502 ! 810: END 00720502
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.