![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM909.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 FM909.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C***********************************************************************00010909 ! 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 00020909 ! 6: C***** FM909 00030909 ! 7: C***** INTER4 - (393) 00040909 ! 8: C***** 00050909 ! 9: C***********************************************************************00060909 ! 10: C***** TESTING OF INTERNAL FILES - ANS. REF 00070909 ! 11: C***** USING WRITE 12.2.5 00080909 ! 12: C***** 00090909 ! 13: C***** 00100909 ! 14: CBB** ********************** BBCCOMNT **********************************00110909 ! 15: C**** 00120909 ! 16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130909 ! 17: C**** VERSION 2.0 00140909 ! 18: C**** 00150909 ! 19: C**** 00160909 ! 20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170909 ! 21: C**** GENERAL SERVICES ADMINISTRATION 00180909 ! 22: C**** FEDERAL SOFTWARE TESTING CENTER 00190909 ! 23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200909 ! 24: C**** FALLS CHURCH, VA. 22041 00210909 ! 25: C**** 00220909 ! 26: C**** (703) 756-6153 00230909 ! 27: C**** 00240909 ! 28: CBE** ********************** BBCCOMNT **********************************00250909 ! 29: C***** 00260909 ! 30: C***** S P E C I F I C A T I O N S SEGMENT 393 00270909 ! 31: C***** 00280909 ! 32: LOGICAL AVB 00290909 ! 33: DOUBLE PRECISION AVD, BVD, CVD, DVD, B1D(5) 00300909 ! 34: COMPLEX AVC, BVC, CVC 00310909 ! 35: CHARACTER A8VK*8, A97VK*97, CVCORR*97, AVCORR(24)*97 00320909 ! 36: CHARACTER*29 A291K(5) 00330909 ! 37: CHARACTER*43 A431K(2) 00340909 ! 38: CHARACTER*1 A97E1(97), A97E2(97) 00350909 ! 39: EQUIVALENCE (A97VK, A97E1), (A431K, A97E1) 00360909 ! 40: EQUIVALENCE (CVCORR, A97E2) 00370909 ! 41: C***** 00380909 ! 42: CBB** ********************** BBCINITA **********************************00390909 ! 43: C**** SPECIFICATION STATEMENTS 00400909 ! 44: C**** 00410909 ! 45: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00420909 ! 46: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00430909 ! 47: CBE** ********************** BBCINITA **********************************00440909 ! 48: CBB** ********************** BBCINITB **********************************00450909 ! 49: C**** INITIALIZE SECTION 00460909 ! 50: DATA ZVERS, ZVERSD, ZDATE 00470909 ! 51: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00480909 ! 52: DATA ZCOMPL, ZNAME, ZTAPE 00490909 ! 53: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00500909 ! 54: DATA ZPROJ, ZTAPED, ZPROG 00510909 ! 55: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00520909 ! 56: DATA REMRKS /' '/ 00530909 ! 57: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00540909 ! 58: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00550909 ! 59: C**** 00560909 ! 60: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00570909 ! 61: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00580909 ! 62: CZ03 ZPROG = 'PROGRAM NAME' 00590909 ! 63: ZDATE = '07-Nov-85 ' *RP ! 64: ZCOMPL = 'CCI 5.2 ' *RP ! 65: ZPROJ = 'TC-85- -410' *RP ! 66: ZNAME = ' ' *RP ! 67: ZTAPE = ' ' *RP ! 68: ZTAPED = '850703 ' *RP ! 69: C 00660909 ! 70: IVPASS = 0 00670909 ! 71: IVFAIL = 0 00680909 ! 72: IVDELE = 0 00690909 ! 73: IVINSP = 0 00700909 ! 74: IVTOTL = 0 00710909 ! 75: IVTOTN = 0 00720909 ! 76: ICZERO = 0 00730909 ! 77: C 00740909 ! 78: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750909 ! 79: I01 = 05 00760909 ! 80: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770909 ! 81: I02 = 06 00780909 ! 82: C 00790909 ! 83: I01 = 5 00800909 ! 84: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810909 ! 85: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00820909 ! 86: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00830909 ! 87: C 00840909 ! 88: I02 = 6 00850909 ! 89: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00860909 ! 90: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00870909 ! 91: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00880909 ! 92: C 00890909 ! 93: CBE** ********************** BBCINITB **********************************00900909 ! 94: NUVI = I02 00910909 ! 95: IVTOTL = 27 00920909 ! 96: ZPROG = 'FM909' 00930909 ! 97: CBB** ********************** BBCHED0A **********************************00940909 ! 98: C**** 00950909 ! 99: C**** WRITE REPORT TITLE 00960909 ! 100: C**** 00970909 ! 101: WRITE (I02, 90002) 00980909 ! 102: WRITE (I02, 90006) 00990909 ! 103: WRITE (I02, 90007) 01000909 ! 104: WRITE (I02, 90008) ZVERS, ZVERSD 01010909 ! 105: WRITE (I02, 90009) ZPROG, ZPROG 01020909 ! 106: WRITE (I02, 90010) ZDATE, ZCOMPL 01030909 ! 107: CBE** ********************** BBCHED0A **********************************01040909 ! 108: C***** 01050909 ! 109: C***** HEADER FOR SEGMENT 393 01060909 ! 110: C***** 01070909 ! 111: WRITE(NUVI,39300) 01080909 ! 112: 39300 FORMAT(1H ,/ 46H INTER4 - (393) INTERNAL FILES -- USING WRITE 01090909 ! 113: 1 //19H ANS. REF. - 12.2.5) 01100909 ! 114: CBB** ********************** BBCHED0B **********************************01110909 ! 115: C**** WRITE DETAIL REPORT HEADERS 01120909 ! 116: C**** 01130909 ! 117: WRITE (I02,90004) 01140909 ! 118: WRITE (I02,90004) 01150909 ! 119: WRITE (I02,90013) 01160909 ! 120: WRITE (I02,90014) 01170909 ! 121: WRITE (I02,90015) IVTOTL 01180909 ! 122: CBE** ********************** BBCHED0B **********************************01190909 ! 123: WRITE (NUVI, 39199) 01200909 ! 124: 39199 FORMAT (1H ,48X,31HNOTE 1: FOR NUMERIC VALUES, / 01210909 ! 125: 1 1H ,48X,31H OPTIONAL LEADING ZERO MAY BE/ 01220909 ! 126: 2 1H ,48X,31H BLANK FOR ABSOLUTE VALUE < 1/ 01230909 ! 127: 3 1H ,48X,31HNOTE 2: LEADING PLUS SIGN IS / 01240909 ! 128: 4 1H ,48X,31H OPTIONAL FOR NUMERIC VALUES / 01250909 ! 129: 5 1H ,48X,31HNOTE 3: E FORMAT EXPONENT MAY / 01260909 ! 130: 6 1H ,48X,31H BE E+NN OR +0NN FOR REALS / 01270909 ! 131: 7 1H ,48X,31HNOTE 4: D FORMAT EXPONENT MAY / 01280909 ! 132: 8 1H ,48X,31H BE D+NN, E+NN, OR +0NN FOR / 01290909 ! 133: 9 1H ,48X,31H DOUBLE PRECISION VALUES /) 01300909 ! 134: C***** 01310909 ! 135: CT001* TEST 1 DOUBLE PRECISION INTO VARIABLE 01320909 ! 136: IVTNUM = 1 01330909 ! 137: A97VK = 'XXXXXXXXXXXXXXXXXX' 01340909 ! 138: AVD = 23.456D3 01350909 ! 139: WRITE(UNIT=A97VK,FMT=39301) AVD 01360909 ! 140: 39301 FORMAT(13X,D10.5) 01370909 ! 141: IVCOMP = 0 01380909 ! 142: AVCORR(1) = ' .23456D+05' 01390909 ! 143: AVCORR(2) = ' .23456E+05' 01400909 ! 144: AVCORR(3) = ' .23456+005' 01410909 ! 145: DO 40011 I = 1, 3 01420909 ! 146: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 01430909 ! 147: IF (IVCOMP - 1) 40011, 10010, 40011 01440909 ! 148: 40011 CONTINUE 01450909 ! 149: GO TO 20010 01460909 ! 150: 10010 IVPASS = IVPASS + 1 01470909 ! 151: WRITE (NUVI, 80002) IVTNUM 01480909 ! 152: GO TO 0011 01490909 ! 153: 20010 IVFAIL = IVFAIL + 1 01500909 ! 154: CVCORR = ' .23456D+05' 01510909 ! 155: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01520909 ! 156: WRITE (NUVI, 80008) IVTNUM, REMRKS 01530909 ! 157: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01540909 ! 158: WRITE (NUVI, 80050) REMRKS 01550909 ! 159: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 01560909 ! 160: 70010 FORMAT(1H ,16X,10HCOMPUTED: ,54A1) 01570909 ! 161: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 01580909 ! 162: 70020 FORMAT(1H ,26X,43A1) 01590909 ! 163: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 01600909 ! 164: 70030 FORMAT(1H ,16X,10HCORRECT: ,54A1) 01610909 ! 165: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 01620909 ! 166: 70040 FORMAT(1H ,26X,43A1) 01630909 ! 167: 0011 CONTINUE 01640909 ! 168: CT002* TEST 2 INTO ARRAY ELEMENT 01650909 ! 169: IVTNUM = 2 01660909 ! 170: AVD = 2.1D1 01670909 ! 171: A431K(1) = ' ' 01680909 ! 172: A431K(2) = 'WRONG' 01690909 ! 173: WRITE(UNIT=A431K(1),FMT=39303) AVD 01700909 ! 174: 39303 FORMAT(D12.7) 01710909 ! 175: IVCOMP = 0 01720909 ! 176: AVCORR(1) = '.2100000D+02' 01730909 ! 177: AVCORR(2) = '.2100000E+02' 01740909 ! 178: AVCORR(3) = '.2100000+002' 01750909 ! 179: DO 40021 I = 1, 3 01760909 ! 180: IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1 01770909 ! 181: IF (IVCOMP - 1) 40021, 10020, 40021 01780909 ! 182: 40021 CONTINUE 01790909 ! 183: GO TO 20020 01800909 ! 184: 10020 IVPASS = IVPASS + 1 01810909 ! 185: WRITE (NUVI, 80002) IVTNUM 01820909 ! 186: GO TO 0021 01830909 ! 187: 20020 IVFAIL = IVFAIL + 1 01840909 ! 188: CVCORR = '.2100000D+02' 01850909 ! 189: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01860909 ! 190: WRITE (NUVI, 80008) IVTNUM, REMRKS 01870909 ! 191: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01880909 ! 192: WRITE (NUVI, 80050) REMRKS 01890909 ! 193: WRITE (NUVI, 80020) A431K(1) 01900909 ! 194: WRITE (NUVI, 80022) CVCORR 01910909 ! 195: 0021 CONTINUE 01920909 ! 196: CT003* TEST 3 CHARACTER SUBSTRING 01930909 ! 197: IVTNUM = 3 01940909 ! 198: A97VK = ' SOME WHERE' 01950909 ! 199: AVD = 23.45D2 01960909 ! 200: WRITE(UNIT=A97VK(21:),FMT=39305) AVD 01970909 ! 201: 39305 FORMAT(11X,D14.9) 01980909 ! 202: IVCOMP = 0 01990909 ! 203: AVCORR(1) = ' SOME WHERE .234500000D+04' 02000909 ! 204: AVCORR(2) = ' SOME WHERE .234500000E+04' 02010909 ! 205: AVCORR(3) = ' SOME WHERE .234500000+004' 02020909 ! 206: DO 40031 I = 1, 3 02030909 ! 207: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 02040909 ! 208: IF (IVCOMP - 1) 40031, 10030, 40031 02050909 ! 209: 40031 CONTINUE 02060909 ! 210: GO TO 20030 02070909 ! 211: 10030 IVPASS = IVPASS + 1 02080909 ! 212: WRITE (NUVI, 80002) IVTNUM 02090909 ! 213: GO TO 0031 02100909 ! 214: 20030 IVFAIL = IVFAIL + 1 02110909 ! 215: CVCORR = ' SOME WHERE .234500000D+04' 02120909 ! 216: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02130909 ! 217: WRITE (NUVI, 80008) IVTNUM, REMRKS 02140909 ! 218: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02150909 ! 219: WRITE (NUVI, 80050) REMRKS 02160909 ! 220: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 02170909 ! 221: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 02180909 ! 222: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 02190909 ! 223: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 02200909 ! 224: 0031 CONTINUE 02210909 ! 225: C***** TESTS 4 - 5 ARRAY, SINGLE RECORD 02220909 ! 226: CT004* TEST 4 02230909 ! 227: IVTNUM = 4 02240909 ! 228: CVD = 23.45D2 02250909 ! 229: A431K(2) = ' ' 02260909 ! 230: WRITE(UNIT=A431K,FMT=39306) CVD 02270909 ! 231: 39306 FORMAT(24X,D19.10) 02280909 ! 232: IVCOMP = 0 02290909 ! 233: AVCORR(1) = ' 0.2345000000D+04' 02300909 ! 234: AVCORR(2) = ' 0.2345000000E+04' 02310909 ! 235: AVCORR(3) = ' 0.2345000000+004' 02320909 ! 236: AVCORR(4) = ' .2345000000D+04' 02330909 ! 237: AVCORR(5) = ' .2345000000E+04' 02340909 ! 238: AVCORR(6) = ' .2345000000+004' 02350909 ! 239: AVCORR(7) = ' +.2345000000D+04' 02360909 ! 240: AVCORR(8) = ' +.2345000000E+04' 02370909 ! 241: AVCORR(9) = ' +.2345000000+004' 02380909 ! 242: AVCORR(10) = ' +0.2345000000D+04' 02390909 ! 243: AVCORR(11) = ' +0.2345000000E+04' 02400909 ! 244: AVCORR(12) = ' +0.2345000000+004' 02410909 ! 245: DO 40041 I = 1, 12 02420909 ! 246: IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1 02430909 ! 247: IF (IVCOMP - 1) 40041, 10040, 40041 02440909 ! 248: 40041 CONTINUE 02450909 ! 249: GO TO 20040 02460909 ! 250: 10040 IVPASS = IVPASS + 1 02470909 ! 251: WRITE (NUVI, 80002) IVTNUM 02480909 ! 252: GO TO 0041 02490909 ! 253: 20040 IVFAIL = IVFAIL + 1 02500909 ! 254: CVCORR = ' 0.2345000000D+04' 02510909 ! 255: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02520909 ! 256: WRITE (NUVI, 80008) IVTNUM, REMRKS 02530909 ! 257: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02540909 ! 258: WRITE (NUVI, 80050) REMRKS 02550909 ! 259: WRITE (NUVI, 70050) (A97E1(I), I = 1,43) 02560909 ! 260: WRITE (NUVI, 70060) (A97E2(I), I = 1,43) 02570909 ! 261: 70050 FORMAT(1H ,16X,10HCOMPUTED: ,43A1) 02580909 ! 262: 70060 FORMAT(1H ,16X,10HCORRECT: ,43A1) 02590909 ! 263: 0041 CONTINUE 02600909 ! 264: CT005* TEST 5 02610909 ! 265: IVTNUM = 5 02620909 ! 266: IVCOMP = 0 02630909 ! 267: IF (A431K(2).EQ.' ') IVCOMP = 1 02640909 ! 268: IF (IVCOMP - 1) 20050, 10050, 20050 02650909 ! 269: 10050 IVPASS = IVPASS + 1 02660909 ! 270: WRITE (NUVI, 80002) IVTNUM 02670909 ! 271: GO TO 0051 02680909 ! 272: 20050 IVFAIL = IVFAIL + 1 02690909 ! 273: CVCORR = ' ' 02700909 ! 274: WRITE (NUVI, 80018) IVTNUM, A431K(2), CVCORR 02710909 ! 275: 0051 CONTINUE 02720909 ! 276: C***** TESTS 6 - 10 ARRAY, 5 RECORDS, ONE BLANK 02730909 ! 277: CT006* TEST 6 02740909 ! 278: IVTNUM = 6 02750909 ! 279: B1D(1) = 11D1 02760909 ! 280: B1D(2) = 21D1 02770909 ! 281: B1D(3) = 31D1 02780909 ! 282: B1D(4) = 32D1 02790909 ! 283: B1D(5) = 51D1 02800909 ! 284: WRITE(UNIT=A291K,FMT=39307) (B1D(JVI), JVI=1,5) 02810909 ! 285: 39307 FORMAT(E11.6E2/1X,E10.5E2/2X,2(E9.4E2,3X)//4X,E7.2E2) 02820909 ! 286: IVCOMP = 0 02830909 ! 287: IF (A291K(1).EQ.'.110000E+03') IVCOMP = 1 02840909 ! 288: IF (IVCOMP - 1) 20060, 10060, 20060 02850909 ! 289: 10060 IVPASS = IVPASS + 1 02860909 ! 290: WRITE (NUVI, 80002) IVTNUM 02870909 ! 291: GO TO 0061 02880909 ! 292: 20060 IVFAIL = IVFAIL + 1 02890909 ! 293: CVCORR = '.110000E+03' 02900909 ! 294: WRITE (NUVI, 80018) IVTNUM, A291K(1), CVCORR 02910909 ! 295: 0061 CONTINUE 02920909 ! 296: CT007* TEST 7 02930909 ! 297: IVTNUM = 7 02940909 ! 298: IVCOMP = 0 02950909 ! 299: IF (A291K(2).EQ.' .21000E+03') IVCOMP = 1 02960909 ! 300: IF (IVCOMP - 1) 20070, 10070, 20070 02970909 ! 301: 10070 IVPASS = IVPASS + 1 02980909 ! 302: WRITE (NUVI, 80002) IVTNUM 02990909 ! 303: GO TO 0071 03000909 ! 304: 20070 IVFAIL = IVFAIL + 1 03010909 ! 305: CVCORR = ' .21000E+03' 03020909 ! 306: WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR 03030909 ! 307: 0071 CONTINUE 03040909 ! 308: CT008* TEST 8 03050909 ! 309: IVTNUM = 8 03060909 ! 310: IVCOMP = 0 03070909 ! 311: IF (A291K(3).EQ.' .3100E+03 .3200E+03') IVCOMP = 1 03080909 ! 312: IF (IVCOMP - 1) 20080, 10080, 20080 03090909 ! 313: 10080 IVPASS = IVPASS + 1 03100909 ! 314: WRITE (NUVI, 80002) IVTNUM 03110909 ! 315: GO TO 0081 03120909 ! 316: 20080 IVFAIL = IVFAIL + 1 03130909 ! 317: CVCORR = ' .3100+003 .3200E+03' 03140909 ! 318: WRITE (NUVI, 70070) IVTNUM, A291K(3), CVCORR 03150909 ! 319: 70070 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED: , 03160909 ! 320: 1 A29,/,1H ,16X,10HCORRECT: ,A29) 03170909 ! 321: 0081 CONTINUE 03180909 ! 322: CT009* TEST 9 03190909 ! 323: IVTNUM = 9 03200909 ! 324: IVCOMP = 0 03210909 ! 325: IF (A291K(4).EQ.' ') IVCOMP = 1 03220909 ! 326: IF (IVCOMP - 1) 20090, 10090, 20090 03230909 ! 327: 10090 IVPASS = IVPASS + 1 03240909 ! 328: WRITE (NUVI, 80002) IVTNUM 03250909 ! 329: GO TO 0091 03260909 ! 330: 20090 IVFAIL = IVFAIL + 1 03270909 ! 331: CVCORR = ' ' 03280909 ! 332: WRITE (NUVI, 80018) IVTNUM, A291K(4), CVCORR 03290909 ! 333: 0091 CONTINUE 03300909 ! 334: CT010* TEST 10 03310909 ! 335: IVTNUM = 10 03320909 ! 336: IVCOMP = 0 03330909 ! 337: IF (A291K(5).EQ.' .51E+03') IVCOMP = 1 03340909 ! 338: IF (IVCOMP - 1) 20100, 10100, 20100 03350909 ! 339: 10100 IVPASS = IVPASS + 1 03360909 ! 340: WRITE (NUVI, 80002) IVTNUM 03370909 ! 341: GO TO 0101 03380909 ! 342: 20100 IVFAIL = IVFAIL + 1 03390909 ! 343: CVCORR = ' .51E+03' 03400909 ! 344: WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR 03410909 ! 345: 0101 CONTINUE 03420909 ! 346: C***** 03430909 ! 347: WRITE(NUVI, 90002) 03440909 ! 348: WRITE(NUVI, 90013) 03450909 ! 349: WRITE(NUVI, 90014) 03460909 ! 350: C***** 03470909 ! 351: CT011* TEST 11 VARIABLE, MORE THEN ONE FIELD 03480909 ! 352: IVTNUM = 11 03490909 ! 353: AVD = 34.58673D2 03500909 ! 354: BVD = 34.58673D2 03510909 ! 355: CVD = 34.58673D2 03520909 ! 356: DVD = 34.58673D2 03530909 ! 357: WRITE(UNIT=A97VK,FMT=39309) AVD, BVD, CVD, DVD 03540909 ! 358: 39309 FORMAT(D10.5,1X,F10.5,1X,D11.5,G11.5) 03550909 ! 359: IVCOMP = 0 03560909 ! 360: CVCORR = '.34587D+04 3458.67300 0.34587D+04 3458.7' 03570909 ! 361: IF (A97VK.EQ.CVCORR) IVCOMP = 1 03580909 ! 362: IF (IVCOMP - 1) 20110, 10110, 20110 03590909 ! 363: 10110 IVPASS = IVPASS + 1 03600909 ! 364: WRITE (NUVI, 80002) IVTNUM 03610909 ! 365: GO TO 0111 03620909 ! 366: 20110 IVFAIL = IVFAIL + 1 03630909 ! 367: REMRKS = '54 PERMISSIBLE REPRESENTATIONS' 03640909 ! 368: WRITE (NUVI, 80008) IVTNUM, REMRKS 03650909 ! 369: REMRKS = 'SEE NOTES ABOVE' 03660909 ! 370: WRITE (NUVI, 80050) REMRKS 03670909 ! 371: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 03680909 ! 372: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 03690909 ! 373: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 03700909 ! 374: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 03710909 ! 375: 0111 CONTINUE 03720909 ! 376: CT012* TEST 12 GW.D FIELD WITH D.P. 03730909 ! 377: IVTNUM = 12 03740909 ! 378: AVD = 314.5673D0 03750909 ! 379: BVD = 14.45673D-1 03760909 ! 380: CVD = 85.7343D6 03770909 ! 381: WRITE(UNIT=A97VK,FMT=39310) AVD, BVD, CVD 03780909 ! 382: 39310 FORMAT(G12.5,1X,G14.5E3,1X,G10.5E2) 03790909 ! 383: IVCOMP = 0 03800909 ! 384: AVCORR(1) = ' 314.57 1.4457 .85734E+08' 03810909 ! 385: AVCORR(2) = ' +314.57 1.4457 .85734E+08' 03820909 ! 386: AVCORR(3) = ' 314.57 +1.4457 .85734E+08' 03830909 ! 387: AVCORR(4) = ' +314.57 +1.4457 .85734E+08' 03840909 ! 388: DO 40121 I = 1, 4 03850909 ! 389: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 03860909 ! 390: IF (IVCOMP - 1) 40121, 10120, 40121 03870909 ! 391: 40121 CONTINUE 03880909 ! 392: GO TO 20120 03890909 ! 393: 10120 IVPASS = IVPASS + 1 03900909 ! 394: WRITE (NUVI, 80002) IVTNUM 03910909 ! 395: GO TO 0121 03920909 ! 396: 20120 IVFAIL = IVFAIL + 1 03930909 ! 397: CVCORR = ' 314.57 1.4457 .85734E+08' 03940909 ! 398: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 03950909 ! 399: WRITE (NUVI, 80008) IVTNUM, REMRKS 03960909 ! 400: REMRKS = 'WITH PERMISSIBLE OPTIONS. SEE ' 03970909 ! 401: WRITE (NUVI, 80050) REMRKS 03980909 ! 402: REMRKS = 'NOTES ABOVE' 03990909 ! 403: WRITE (NUVI, 80050) REMRKS 04000909 ! 404: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04010909 ! 405: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04020909 ! 406: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04030909 ! 407: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04040909 ! 408: 0121 CONTINUE 04050909 ! 409: CT013* TEST 13 DIFFERENT TYPES IN SAME RECORD 04060909 ! 410: IVTNUM = 13 04070909 ! 411: KVI = 348 04080909 ! 412: AVS = 34.783 04090909 ! 413: AVD = 384.3847D1 04100909 ! 414: AVB = .TRUE. 04110909 ! 415: BVS = 3.4857 04120909 ! 416: A8VK = 'KDFJ D/.' 04130909 ! 417: WRITE(UNIT=A97VK,FMT=39311) KVI, AVS, AVD, AVB, BVS, A8VK 04140909 ! 418: 39311 FORMAT(I4,1X,E9.4,1X,D10.4,1X,L4,1X,F12.5,1X,A8) 04150909 ! 419: IVCOMP = 0 04160909 ! 420: CVCORR = ' 348 .3478E+02 0.3844D+04 T 3.48570 KDFJ D/04170909 ! 421: 1.' 04180909 ! 422: IF (A97VK.EQ.CVCORR) IVCOMP = 1 04190909 ! 423: IF (IVCOMP - 1) 20130, 10130, 20130 04200909 ! 424: 10130 IVPASS = IVPASS + 1 04210909 ! 425: WRITE (NUVI, 80002) IVTNUM 04220909 ! 426: GO TO 0131 04230909 ! 427: 20130 IVFAIL = IVFAIL + 1 04240909 ! 428: REMRKS = '72 PERMISSIBLE REPRESENTATIONS' 04250909 ! 429: WRITE (NUVI, 80008) IVTNUM, REMRKS 04260909 ! 430: REMRKS = 'SEE NOTES ABOVE' 04270909 ! 431: WRITE (NUVI, 80050) REMRKS 04280909 ! 432: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04290909 ! 433: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04300909 ! 434: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04310909 ! 435: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04320909 ! 436: 0131 CONTINUE 04330909 ! 437: CT014* TEST 14 POSITIONAL EDITING 04340909 ! 438: IVTNUM = 14 04350909 ! 439: AVB = .TRUE. 04360909 ! 440: AVS = 10.98 04370909 ! 441: A8VK = 'THISISIT' 04380909 ! 442: AVD = 3.4945D2 04390909 ! 443: BVS = 3.4945 04400909 ! 444: KVI = 3 04410909 ! 445: WRITE(UNIT=A97VK,FMT=39312) AVB, AVS, A8VK, AVD, BVS, KVI 04420909 ! 446: 39312 FORMAT(L1,T5,F5.2,A8,TR2,E10.4E2,TL10,F6.4,6X,I1) 04430909 ! 447: IVCOMP = 0 04440909 ! 448: IF (A97VK.EQ.'T 10.98THISISIT 3.4945E+03 3') 04450909 ! 449: 1 IVCOMP = 1 04460909 ! 450: IF (IVCOMP - 1) 20140, 10140, 20140 04470909 ! 451: 10140 IVPASS = IVPASS + 1 04480909 ! 452: WRITE (NUVI, 80002) IVTNUM 04490909 ! 453: GO TO 0141 04500909 ! 454: 20140 IVFAIL = IVFAIL + 1 04510909 ! 455: CVCORR = 'T 10.98THISISIT 3.4945E+03 3' 04520909 ! 456: WRITE (NUVI, 80008) IVTNUM 04530909 ! 457: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04540909 ! 458: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04550909 ! 459: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04560909 ! 460: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04570909 ! 461: 0141 CONTINUE 04580909 ! 462: CT015* TEST 15 COLON AND SIGN 04590909 ! 463: IVTNUM = 15 04600909 ! 464: AVB = .TRUE. 04610909 ! 465: AVS = 98.11 04620909 ! 466: A8VK = 'THISISIT' 04630909 ! 467: AVD = 3.4945D2 04640909 ! 468: KVI = 33 04650909 ! 469: WRITE(UNIT=A97VK,FMT=39313) AVB, AVS, A8VK, AVD, KVI 04660909 ! 470: 39313 FORMAT(L1,S,F7.2,A8,SP,D11.5,6X,SS,I2,:,F9.3) 04670909 ! 471: IVCOMP = 0 04680909 ! 472: AVCORR(1) = 'T 98.11THISISIT+.34945D+03 33' 04690909 ! 473: AVCORR(2) = 'T 98.11THISISIT+.34945E+03 33' 04700909 ! 474: AVCORR(3) = 'T 98.11THISISIT+.34945+003 33' 04710909 ! 475: DO 40151 I = 1, 3 04720909 ! 476: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 04730909 ! 477: IF (IVCOMP - 1) 40151, 10150, 40151 04740909 ! 478: 40151 CONTINUE 04750909 ! 479: GO TO 20150 04760909 ! 480: 10150 IVPASS = IVPASS + 1 04770909 ! 481: WRITE (NUVI, 80002) IVTNUM 04780909 ! 482: GO TO 0151 04790909 ! 483: 20150 IVFAIL = IVFAIL + 1 04800909 ! 484: CVCORR = 'T 98.11THISISIT+.34945D+03 33' 04810909 ! 485: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 04820909 ! 486: WRITE (NUVI, 80008) IVTNUM, REMRKS 04830909 ! 487: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 04840909 ! 488: WRITE (NUVI, 80050) REMRKS 04850909 ! 489: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04860909 ! 490: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04870909 ! 491: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04880909 ! 492: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04890909 ! 493: 0151 CONTINUE 04900909 ! 494: CT016* TEST 16 COMPLEX TYPES INTO VARIABLE 04910909 ! 495: IVTNUM = 16 04920909 ! 496: AVC = (2.343, 34.394) 04930909 ! 497: WRITE(UNIT=A97VK,FMT=39314) AVC 04940909 ! 498: 39314 FORMAT(F10.5,1X,F10.5) 04950909 ! 499: IVCOMP = 0 04960909 ! 500: AVCORR(1) = ' 2.34300 34.39400' 04970909 ! 501: AVCORR(2) = ' 2.34300 +34.39400' 04980909 ! 502: AVCORR(3) = ' +2.34300 34.39400' 04990909 ! 503: AVCORR(4) = ' +2.34300 +34.39400' 05000909 ! 504: DO 40161 I = 1, 4 05010909 ! 505: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 05020909 ! 506: IF (IVCOMP - 1) 40161, 10160, 40161 05030909 ! 507: 40161 CONTINUE 05040909 ! 508: GO TO 20160 05050909 ! 509: 10160 IVPASS = IVPASS + 1 05060909 ! 510: WRITE (NUVI, 80002) IVTNUM 05070909 ! 511: GO TO 0161 05080909 ! 512: 20160 IVFAIL = IVFAIL + 1 05090909 ! 513: CVCORR = ' +2.34300 +34.39400' 05100909 ! 514: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 05110909 ! 515: WRITE (NUVI, 80008) IVTNUM, REMRKS 05120909 ! 516: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 05130909 ! 517: WRITE (NUVI, 80050) REMRKS 05140909 ! 518: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05150909 ! 519: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05160909 ! 520: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05170909 ! 521: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05180909 ! 522: 0161 CONTINUE 05190909 ! 523: CT017* TEST 17 05200909 ! 524: IVTNUM = 17 05210909 ! 525: AVC = (34.84, 349.887) 05220909 ! 526: WRITE(UNIT=A97VK,FMT=39315) AVC 05230909 ! 527: 39315 FORMAT(E12.5,1X,E12.5) 05240909 ! 528: IVCOMP = 0 05250909 ! 529: IF (A97VK.EQ.' 0.34840E+02 0.34989E+03') IVCOMP = 1 05260909 ! 530: IF (IVCOMP - 1) 20170, 10170, 20170 05270909 ! 531: 10170 IVPASS = IVPASS + 1 05280909 ! 532: WRITE (NUVI, 80002) IVTNUM 05290909 ! 533: GO TO 0171 05300909 ! 534: 20170 IVFAIL = IVFAIL + 1 05310909 ! 535: CVCORR = ' 0.34840E+02 0.34989E+03' 05320909 ! 536: REMRKS = '16 PERMISSIBLE REPRESENTATIONS' 05330909 ! 537: WRITE (NUVI, 80008) IVTNUM, REMRKS 05340909 ! 538: REMRKS = 'SEE NOTES ABOVE' 05350909 ! 539: WRITE (NUVI, 80050) REMRKS 05360909 ! 540: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05370909 ! 541: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05380909 ! 542: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05390909 ! 543: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05400909 ! 544: 0171 CONTINUE 05410909 ! 545: CT018* TEST 18 LIST OF COMPLEX 05420909 ! 546: IVTNUM = 18 05430909 ! 547: AVC = (2.34, 2.456) 05440909 ! 548: BVC = (2.34, 2.456) 05450909 ! 549: CVC = (2.34, 2.456) 05460909 ! 550: WRITE(UNIT=A97VK,FMT=39316) AVC, BVC, CVC 05470909 ! 551: 39316 FORMAT(2(G9.4,1X),2(G10.4E2,1X),2(G11.5E3,1X)) 05480909 ! 552: IVCOMP = 0 05490909 ! 553: AVCORR(1) = '2.340 2.456 2.340 2.456 2.340005500909 ! 554: 1 2.4560' 05510909 ! 555: AVCORR(2) = '2.340 2.456 2.340 +2.456 2.340005520909 ! 556: 1 2.4560' 05530909 ! 557: AVCORR(3) = '2.340 2.456 +2.340 2.456 2.340005540909 ! 558: 1 2.4560' 05550909 ! 559: AVCORR(4) = '2.340 2.456 +2.340 +2.456 2.340005560909 ! 560: 1 2.4560' 05570909 ! 561: DO 40181 I = 1, 4 05580909 ! 562: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 05590909 ! 563: IF (IVCOMP - 1) 40181, 10180, 40181 05600909 ! 564: 40181 CONTINUE 05610909 ! 565: GO TO 20180 05620909 ! 566: 10180 IVPASS = IVPASS + 1 05630909 ! 567: WRITE (NUVI, 80002) IVTNUM 05640909 ! 568: GO TO 0181 05650909 ! 569: 20180 IVFAIL = IVFAIL + 1 05660909 ! 570: CVCORR = '2.340 2.456 2.340 2.456 2.3400 05670909 ! 571: 1 2.4560' 05680909 ! 572: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 05690909 ! 573: WRITE (NUVI, 80008) IVTNUM, REMRKS 05700909 ! 574: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 05710909 ! 575: WRITE (NUVI, 80050) REMRKS 05720909 ! 576: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05730909 ! 577: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05740909 ! 578: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05750909 ! 579: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05760909 ! 580: 0181 CONTINUE 05770909 ! 581: CT019* TEST 19 LIST FROM SUBSTRING 05780909 ! 582: IVTNUM = 19 05790909 ! 583: AVC = (5.6798, 0.9876) 05800909 ! 584: BVC = (5.6798, 0.9876) 05810909 ! 585: CVC = (5.6798, 0.9876) 05820909 ! 586: WRITE(UNIT=A97VK(1:),FMT=39317) AVC, BVC, CVC 05830909 ! 587: 39317 FORMAT(2(E6.2E1,1X),1X,2(E7.2E2,1X),1X,2(E9.2E3,1X)) 05840909 ! 588: IVCOMP = 0 05850909 ! 589: AVCORR(1) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 .99E+05860909 ! 590: 1000' 05870909 ! 591: AVCORR(2) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 0.99E+05880909 ! 592: 1000' 05890909 ! 593: AVCORR(3) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 +.99E+05900909 ! 594: 1000' 05910909 ! 595: AVCORR(4) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 .99E+05920909 ! 596: 1000' 05930909 ! 597: AVCORR(5) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+05940909 ! 598: 1000' 05950909 ! 599: AVCORR(6) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 +.99E+05960909 ! 600: 1000' 05970909 ! 601: AVCORR(7) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 .99E+05980909 ! 602: 1000' 05990909 ! 603: AVCORR(8) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 0.99E+06000909 ! 604: 1000' 06010909 ! 605: AVCORR(9) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 +.99E+06020909 ! 606: 1000' 06030909 ! 607: DO 40191 I = 1, 9 06040909 ! 608: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 06050909 ! 609: IF (IVCOMP - 1) 40191, 10190, 40191 06060909 ! 610: 40191 CONTINUE 06070909 ! 611: GO TO 20190 06080909 ! 612: 10190 IVPASS = IVPASS + 1 06090909 ! 613: WRITE (NUVI, 80002) IVTNUM 06100909 ! 614: GO TO 0191 06110909 ! 615: 20190 IVFAIL = IVFAIL + 1 06120909 ! 616: CVCORR = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+00006130909 ! 617: 1' 06140909 ! 618: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 06150909 ! 619: WRITE (NUVI, 80008) IVTNUM, REMRKS 06160909 ! 620: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 06170909 ! 621: WRITE (NUVI, 80050) REMRKS 06180909 ! 622: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06190909 ! 623: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06200909 ! 624: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06210909 ! 625: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06220909 ! 626: 0191 CONTINUE 06230909 ! 627: CT020* TEST 20 MIXED TYPES 06240909 ! 628: IVTNUM = 20 06250909 ! 629: AVC = (0.934, 34.567) 06260909 ! 630: AVS = 34.65 06270909 ! 631: AVD = 0.6354D1 06280909 ! 632: WRITE(UNIT=A97VK,FMT=39318) AVC, AVS, AVD 06290909 ! 633: 39318 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,E13.5E2) 06300909 ! 634: IVCOMP = 0 06310909 ! 635: IF (A97VK.EQ.' 0.934 34.567 34.65000 0.63540E+01') IVCO06320909 ! 636: 1MP = 1 06330909 ! 637: IF (A97VK.EQ.' .934 34.567 34.65000 .63540E+01') IVCO06330*TI ! 638: 1MP = 1 06330*TI ! 639: IF (A97VK.EQ.' 0.934 34.567 34.64999 0.63540E+01') IVCO06330*TI ! 640: 1MP = 1 06330*TI ! 641: IF (A97VK.EQ.' .934 34.567 34.64999 .63540E+01') IVCO06330*TI ! 642: 1MP = 1 06330*TI ! 643: IF (IVCOMP - 1) 20200, 10200, 20200 06340909 ! 644: 10200 IVPASS = IVPASS + 1 06350909 ! 645: WRITE (NUVI, 80002) IVTNUM 06360909 ! 646: GO TO 0201 06370909 ! 647: 20200 IVFAIL = IVFAIL + 1 06380909 ! 648: CVCORR = ' 0.934 34.567 34.65000 0.63540E+01' 06390909 ! 649: REMRKS = '32 PERMISSIBLE REPRESENTATIONS' 06400909 ! 650: WRITE (NUVI, 80008) IVTNUM, REMRKS 06410909 ! 651: REMRKS = 'SEE NOTES ABOVE' 06420909 ! 652: WRITE (NUVI, 80050) REMRKS 06430909 ! 653: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06440909 ! 654: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06450909 ! 655: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06460909 ! 656: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06470909 ! 657: 0201 CONTINUE 06480909 ! 658: C***** 06490909 ! 659: WRITE(NUVI, 90002) 06500909 ! 660: WRITE(NUVI, 90013) 06510909 ! 661: WRITE(NUVI, 90014) 06520909 ! 662: C***** 06530909 ! 663: CT021* TEST 21 MIXED TYPES WITH POSITIONAL EDITING 06540909 ! 664: IVTNUM = 21 06550909 ! 665: AVC = (0.345, 34.349) 06560909 ! 666: AVB = .FALSE. 06570909 ! 667: AVD = 34.859D-1 06580909 ! 668: AVS = 10.0 06590909 ! 669: A8VK = '12345678' 06600909 ! 670: WRITE(UNIT=A97VK,FMT=39319) AVC, AVB, AVD, AVS, A8VK 06610909 ! 671: 39319 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8) 06620909 ! 672: IVCOMP = 0 06630909 ! 673: IF (A97VK.EQ.' 0.3450 .3435E+02 F 0.34859D+01 10.00 12306640909 ! 674: 145678') IVCOMP = 1 06650909 ! 675: IF (IVCOMP - 1) 20210, 10210, 20210 06660909 ! 676: 10210 IVPASS = IVPASS + 1 06670909 ! 677: WRITE (NUVI, 80002) IVTNUM 06680909 ! 678: GO TO 0211 06690909 ! 679: 20210 IVFAIL = IVFAIL + 1 06700909 ! 680: CVCORR = ' 0.3450 .3435E+02 F 0.34859D+01 10.00 123456706710909 ! 681: 18' 06720909 ! 682: REMRKS = '96 PERMISSIBLE REPRESENTATIONS' 06730909 ! 683: WRITE (NUVI, 80008) IVTNUM, REMRKS 06740909 ! 684: REMRKS = 'SEE NOTES ABOVE' 06750909 ! 685: WRITE (NUVI, 80050) REMRKS 06760909 ! 686: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06770909 ! 687: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06780909 ! 688: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06790909 ! 689: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06800909 ! 690: 0211 CONTINUE 06810909 ! 691: C***** TESTS 22 - 26 MIXED TYPES INTO 5 RECORDS 06820909 ! 692: CT022* TEST 22 06830909 ! 693: IVTNUM = 22 06840909 ! 694: KVI = 98 06850909 ! 695: AVD = 84.0489D1 06860909 ! 696: AVB = .TRUE. 06870909 ! 697: AVC = (34.0435, 34.94) 06880909 ! 698: A8VK = 'THE LAST' 06890909 ! 699: WRITE(UNIT=A291K,FMT=39320) KVI, AVD, AVB, AVC, A8VK 06900909 ! 700: 39320 FORMAT(I5/E10.5E2//1X,L6,2(1X,E10.3)/A8) 06910909 ! 701: IVCOMP = 0 06920909 ! 702: AVCORR(1) = ' 98' 06930909 ! 703: AVCORR(2) = ' +98' 06940909 ! 704: DO 40221 I = 1, 2 06950909 ! 705: IF (A291K(1).EQ.AVCORR(I)) IVCOMP = 1 06960909 ! 706: IF (IVCOMP - 1) 40221, 10220, 40221 06970909 ! 707: 40221 CONTINUE 06980909 ! 708: GO TO 20220 06990909 ! 709: 10220 IVPASS = IVPASS + 1 07000909 ! 710: WRITE (NUVI, 80002) IVTNUM 07010909 ! 711: GO TO 0221 07020909 ! 712: 20220 IVFAIL = IVFAIL + 1 07030909 ! 713: CVCORR = ' 98' 07040909 ! 714: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 07050909 ! 715: WRITE (NUVI, 80008) IVTNUM, REMRKS 07060909 ! 716: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 07070909 ! 717: WRITE (NUVI, 80050) REMRKS 07080909 ! 718: WRITE (NUVI, 80020) A291K(1) 07090909 ! 719: WRITE (NUVI, 80022) CVCORR 07100909 ! 720: 0221 CONTINUE 07110909 ! 721: CT023* TEST 23 07120909 ! 722: IVTNUM = 23 07130909 ! 723: IVCOMP = 0 07140909 ! 724: IF (A291K(2).EQ.'.84049E+03') IVCOMP = 1 07150909 ! 725: IF (IVCOMP - 1) 20230, 10230, 20230 07160909 ! 726: 10230 IVPASS = IVPASS + 1 07170909 ! 727: WRITE (NUVI, 80002) IVTNUM 07180909 ! 728: GO TO 0231 07190909 ! 729: 20230 IVFAIL = IVFAIL + 1 07200909 ! 730: CVCORR = '.84049E+03' 07210909 ! 731: WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR 07220909 ! 732: 0231 CONTINUE 07230909 ! 733: CT024* TEST 24 07240909 ! 734: IVTNUM = 24 07250909 ! 735: IVCOMP = 0 07260909 ! 736: IF (A291K(3).EQ.' ') IVCOMP = 1 07270909 ! 737: IF (IVCOMP - 1) 20240, 10240, 20240 07280909 ! 738: 10240 IVPASS = IVPASS + 1 07290909 ! 739: WRITE (NUVI, 80002) IVTNUM 07300909 ! 740: GO TO 0241 07310909 ! 741: 20240 IVFAIL = IVFAIL + 1 07320909 ! 742: CVCORR = ' ' 07330909 ! 743: WRITE (NUVI, 80018) IVTNUM, A291K(3), CVCORR 07340909 ! 744: 0241 CONTINUE 07350909 ! 745: CT025* TEST 25 07360909 ! 746: IVTNUM = 25 07370909 ! 747: IVCOMP = 0 07380909 ! 748: IF (A291K(4).EQ.' T 0.340E+02 0.349E+02') IVCOMP = 1 07390909 ! 749: IF (IVCOMP - 1) 20250, 10250, 20250 07400909 ! 750: 10250 IVPASS = IVPASS + 1 07410909 ! 751: WRITE (NUVI, 80002) IVTNUM 07420909 ! 752: GO TO 0251 07430909 ! 753: 20250 IVFAIL = IVFAIL + 1 07440909 ! 754: CVCORR = ' T 0.340E+02 0.349E+02' 07450909 ! 755: REMRKS = '64 PERMISSIBLE REPRESENTATIONS' 07460909 ! 756: WRITE (NUVI, 80008) IVTNUM, REMRKS 07470909 ! 757: REMRKS = 'SEE NOTES ABOVE' 07480909 ! 758: WRITE (NUVI, 80050) REMRKS 07490909 ! 759: WRITE (NUVI, 70080) A291K(4), CVCORR 07500909 ! 760: 70080 FORMAT (1H ,16X,10HCOMPUTED: , A29,/ 07510909 ! 761: 1 1H ,16X,10HCORRECT: ,A29) 07520909 ! 762: 0251 CONTINUE 07530909 ! 763: CT026* TEST 26 07540909 ! 764: IVTNUM = 26 07550909 ! 765: IVCOMP = 0 07560909 ! 766: IF (A291K(5).EQ.'THE LAST') IVCOMP = 1 07570909 ! 767: IF (IVCOMP - 1) 20260, 10260, 20260 07580909 ! 768: 10260 IVPASS = IVPASS + 1 07590909 ! 769: WRITE (NUVI, 80002) IVTNUM 07600909 ! 770: GO TO 0261 07610909 ! 771: 20260 IVFAIL = IVFAIL + 1 07620909 ! 772: CVCORR = 'THE LAST' 07630909 ! 773: WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR 07640909 ! 774: 0261 CONTINUE 07650909 ! 775: CT027* TEST 27 MIXED TYPES WITH SS, SP, NX, AND : 07660909 ! 776: IVTNUM = 27 07670909 ! 777: JVI = 34 07680909 ! 778: AVS = 34.983 07690909 ! 779: BVS = 345.3 07700909 ! 780: AVD = 95.83D2 07710909 ! 781: AVB = .FALSE. 07720909 ! 782: A8VK = '.FALSE.1' 07730909 ! 783: WRITE(UNIT=A97VK,FMT=39321)JVI, AVS, AVD, AVB, A8VK, BVS 07740909 ! 784: 39321 FORMAT(S,I2,1X,SP,F7.3,SS,1X,D10.5,L2,1X,A8,1X,E10.5,:,I5,F10.4)07750909 ! 785: IVCOMP = 0 07760909 ! 786: AVCORR(1) = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03' 07770909 ! 787: AVCORR(2) = '34 +34.983 .95830D+04 F .FALSE.1 .34530+003' 07780909 ! 788: AVCORR(3) = '34 +34.983 .95830E+04 F .FALSE.1 .34530E+03' 07790909 ! 789: AVCORR(4) = '34 +34.983 .95830E+04 F .FALSE.1 .34530+003' 07800909 ! 790: AVCORR(5) = '34 +34.983 .95830+004 F .FALSE.1 .34530E+03' 07810909 ! 791: AVCORR(6) = '34 +34.983 .95830+004 F .FALSE.1 .34530+003' 07820909 ! 792: DO 40271 I = 1, 6 07830909 ! 793: IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 07840909 ! 794: IF (IVCOMP - 1) 40271, 10270, 40271 07850909 ! 795: 40271 CONTINUE 07860909 ! 796: GO TO 20270 07870909 ! 797: 10270 IVPASS = IVPASS + 1 07880909 ! 798: WRITE (NUVI, 80002) IVTNUM 07890909 ! 799: GO TO 0271 07900909 ! 800: 20270 IVFAIL = IVFAIL + 1 07910909 ! 801: CVCORR = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03' 07920909 ! 802: REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 07930909 ! 803: WRITE (NUVI, 80008) IVTNUM, REMRKS 07940909 ! 804: REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 07950909 ! 805: WRITE (NUVI, 80050) REMRKS 07960909 ! 806: WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 07970909 ! 807: WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 07980909 ! 808: WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 07990909 ! 809: WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 08000909 ! 810: 0271 CONTINUE 08010909 ! 811: C***** 08020909 ! 812: CBB** ********************** BBCSUM0 **********************************08030909 ! 813: C**** WRITE OUT TEST SUMMARY 08040909 ! 814: C**** 08050909 ! 815: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08060909 ! 816: WRITE (I02, 90004) 08070909 ! 817: WRITE (I02, 90014) 08080909 ! 818: WRITE (I02, 90004) 08090909 ! 819: WRITE (I02, 90020) IVPASS 08100909 ! 820: WRITE (I02, 90022) IVFAIL 08110909 ! 821: WRITE (I02, 90024) IVDELE 08120909 ! 822: WRITE (I02, 90026) IVINSP 08130909 ! 823: WRITE (I02, 90028) IVTOTN, IVTOTL 08140909 ! 824: CBE** ********************** BBCSUM0 **********************************08150909 ! 825: CBB** ********************** BBCFOOT0 **********************************08160909 ! 826: C**** WRITE OUT REPORT FOOTINGS 08170909 ! 827: C**** 08180909 ! 828: WRITE (I02,90016) ZPROG, ZPROG 08190909 ! 829: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08200909 ! 830: WRITE (I02,90019) 08210909 ! 831: CBE** ********************** BBCFOOT0 **********************************08220909 ! 832: CBB** ********************** BBCFMT0A **********************************08230909 ! 833: C**** FORMATS FOR TEST DETAIL LINES 08240909 ! 834: C**** 08250909 ! 835: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 08260909 ! 836: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 08270909 ! 837: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 08280909 ! 838: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 08290909 ! 839: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 08300909 ! 840: 1I6,/,1H ,15X,10HCORRECT= ,I6) 08310909 ! 841: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08320909 ! 842: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 08330909 ! 843: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08340909 ! 844: 1A21,/,1H ,16X,10HCORRECT= ,A21) 08350909 ! 845: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 08360909 ! 846: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 08370909 ! 847: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 08380909 ! 848: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 08390909 ! 849: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 08400909 ! 850: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 08410909 ! 851: 80050 FORMAT (1H ,48X,A31) 08420909 ! 852: CBE** ********************** BBCFMT0A **********************************08430909 ! 853: CBB** ********************** BBCFMAT1 **********************************08440909 ! 854: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08450909 ! 855: C**** 08460909 ! 856: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08470909 ! 857: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 08480909 ! 858: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 08490909 ! 859: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 08500909 ! 860: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08510909 ! 861: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 08520909 ! 862: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08530909 ! 863: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 08540909 ! 864: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 08550909 ! 865: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 08560909 ! 866: 21H(,F12.5,2H, ,F12.5,1H)) 08570909 ! 867: CBE** ********************** BBCFMAT1 **********************************08580909 ! 868: CBB** ********************** BBCFMT0B **********************************08590909 ! 869: C**** FORMAT STATEMENTS FOR PAGE HEADERS 08600909 ! 870: C**** 08610909 ! 871: 90002 FORMAT (1H1) 08620909 ! 872: 90004 FORMAT (1H ) 08630909 ! 873: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 08640909 ! 874: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 08650909 ! 875: 90008 FORMAT (1H ,21X,A13,A17) 08660909 ! 876: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 08670909 ! 877: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 08680909 ! 878: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 08690909 ! 879: 1 7X,7HREMARKS,24X) 08700909 ! 880: 90014 FORMAT (1H ,46H----------------------------------------------, 08710909 ! 881: 1 33H---------------------------------) 08720909 ! 882: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 08730909 ! 883: C**** 08740909 ! 884: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08750909 ! 885: C**** 08760909 ! 886: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 08770909 ! 887: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 08780909 ! 888: 1 A13) 08790909 ! 889: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 08800909 ! 890: C**** 08810909 ! 891: C**** FORMAT STATEMENTS FOR RUN SUMMARY 08820909 ! 892: C**** 08830909 ! 893: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 08840909 ! 894: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 08850909 ! 895: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 08860909 ! 896: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 08870909 ! 897: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 08880909 ! 898: CBE** ********************** BBCFMT0B **********************************08890909 ! 899: C***** 08900909 ! 900: C***** END OF TEST SEGMENT 393 08910909 ! 901: STOP 08920909 ! 902: END 08930909
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.