|
|
1.1 ! root 1: C***********************************************************************00010903 ! 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 00020903 ! 6: C***** FM903 IOFMTF - (354) 00030903 ! 7: C***** THIS PROGRAM CALLS SUBROUTINE SN904 00040903 ! 8: C***********************************************************************00050903 ! 9: C***** GENERAL PURPOSE ANS REFS 00060903 ! 10: C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8 00070903 ! 11: C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1 00080903 ! 12: C***** DOUBLE PRECISION AND COMPLEX DATA TYPES. 00090903 ! 13: C***** TO TEST ALL FORMS OF CHARACTER EXPRESSIONS AS 13.1.2 00100903 ! 14: C***** FORMAT SPECIFIERS. 00110903 ! 15: C***** RESTRICTIONS OBSERVED 00120903 ! 16: C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1 00130903 ! 17: C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 00140903 ! 18: C***** W IS EQUAL TO OR GREATER THAN D 00150903 ! 19: C***** * FIELD WIDTH IS NEVER ZERO 00160903 ! 20: C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3 00170903 ! 21: C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00180903 ! 22: C***** IN THE FORMAT SPECIFICATION 00190903 ! 23: C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 00200903 ! 24: C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9 00210903 ! 25: C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2 00220903 ! 26: C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1 00230903 ! 27: C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED 00240903 ! 28: C***** INTEGER CONSTANT 00250903 ! 29: C***** GENERAL COMMENTS 00260903 ! 30: C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9 00270903 ! 31: C***** 00280903 ! 32: C***** CALL SUBROUTINE SN904 (SEGMENT 790) 00290903 ! 33: C***** 00300903 ! 34: CBB** ********************** BBCCOMNT **********************************00310903 ! 35: C**** 00320903 ! 36: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00330903 ! 37: C**** VERSION 2.0 00340903 ! 38: C**** 00350903 ! 39: C**** 00360903 ! 40: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00370903 ! 41: C**** GENERAL SERVICES ADMINISTRATION 00380903 ! 42: C**** FEDERAL SOFTWARE TESTING CENTER 00390903 ! 43: C**** 5203 LEESBURG PIKE, SUITE 1100 00400903 ! 44: C**** FALLS CHURCH, VA. 22041 00410903 ! 45: C**** 00420903 ! 46: C**** (703) 756-6153 00430903 ! 47: C**** 00440903 ! 48: CBE** ********************** BBCCOMNT **********************************00450903 ! 49: C***** 00460903 ! 50: C INPUT DATA TO THIS SEGMENT CONSISTS OF 14 CARD IMAGES IN COL. 1 - 56 00470903 ! 51: COL. 1-----------------------------------------------------56 00480903 ! 52: CARD 1 333144446666225555 00490903 ! 53: CARD 2 1234567890 00500903 ! 54: CARD 3 1234567890 00510903 ! 55: CARD 4 1234567890 00520903 ! 56: CARD 5 1234567890 00530903 ! 57: CARD 6 12345 00540903 ! 58: CARD 7 12345123.5123.45D-01 12345D+01 00550903 ! 59: CARD 8 12 345 678 00560903 ! 60: CARD 9 5-1111 3333-5555 7777-9999 00570903 ! 61: CARD 10 12345678901234567890123456781234567890123456789012345678 00580903 ! 62: CARD 11 12345678901234123456789012341234567890123412345678901234 00590903 ! 63: CARD 12 12345678901234123456789012341234567890123456789012345678 00600903 ! 64: CARD 13 12345678901234567890123456781234567890123456789012345678 00610903 ! 65: CARD 14 12345678901234123456789012341234567890123412345678901234 00620903 ! 66: C***** 00630903 ! 67: C***** S P E C I F I C A T I O N S SEGMENT 354 00640903 ! 68: C***** 00650903 ! 69: INTEGER J1I(6) 00660903 ! 70: INTEGER IA1I(8) 00670903 ! 71: CHARACTER*11 A11VK 00680903 ! 72: CHARACTER*15 C151K(7) 00690903 ! 73: CHARACTER*19 A19VK 00700903 ! 74: CHARACTER*25 C251K(6) 00710903 ! 75: CHARACTER*32 A32VK 00720903 ! 76: CHARACTER*52 A52VK 00730903 ! 77: CHARACTER*65 A65VK 00740903 ! 78: CHARACTER*85 A85VK 00750903 ! 79: DOUBLE PRECISION AVD, A1D(4), B4D(2,1,2,2) 00760903 ! 80: COMPLEX AVC, BVC, CVC, A2C(2,2) 00770903 ! 81: EXTERNAL SN904 00780903 ! 82: C***** 00790903 ! 83: CBB** ********************** BBCINITA **********************************00800903 ! 84: C**** SPECIFICATION STATEMENTS 00810903 ! 85: C**** 00820903 ! 86: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00830903 ! 87: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00840903 ! 88: CBE** ********************** BBCINITA **********************************00850903 ! 89: CBB** ********************** BBCINITB **********************************00860903 ! 90: C**** INITIALIZE SECTION 00870903 ! 91: DATA ZVERS, ZVERSD, ZDATE 00880903 ! 92: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00890903 ! 93: DATA ZCOMPL, ZNAME, ZTAPE 00900903 ! 94: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00910903 ! 95: DATA ZPROJ, ZTAPED, ZPROG 00920903 ! 96: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00930903 ! 97: DATA REMRKS /' '/ 00940903 ! 98: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00950903 ! 99: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00960903 ! 100: C**** 00970903 ! 101: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00980903 ! 102: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00990903 ! 103: CZ03 ZPROG = 'PROGRAM NAME' 01000903 ! 104: ZDATE = '07-Nov-85 ' *RP ! 105: ZCOMPL = 'CCI 5.2 ' *RP ! 106: ZPROJ = 'TC-85- -410' *RP ! 107: ZNAME = ' ' *RP ! 108: ZTAPE = ' ' *RP ! 109: ZTAPED = '850703 ' *RP ! 110: C 01070903 ! 111: IVPASS = 0 01080903 ! 112: IVFAIL = 0 01090903 ! 113: IVDELE = 0 01100903 ! 114: IVINSP = 0 01110903 ! 115: IVTOTL = 0 01120903 ! 116: IVTOTN = 0 01130903 ! 117: ICZERO = 0 01140903 ! 118: C 01150903 ! 119: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01160903 ! 120: I01 = 05 01170903 ! 121: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01180903 ! 122: I02 = 06 01190903 ! 123: C 01200903 ! 124: I01 = 5 01210903 ! 125: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01220903 ! 126: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01230903 ! 127: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01240903 ! 128: C 01250903 ! 129: I02 = 6 01260903 ! 130: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01270903 ! 131: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01280903 ! 132: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01290903 ! 133: C 01300903 ! 134: CBE** ********************** BBCINITB **********************************01310903 ! 135: IRVI = I01 01320903 ! 136: NUVI = I02 01330903 ! 137: IVTOTL = 13 01340903 ! 138: ZPROG = 'FM903' 01350903 ! 139: CBB** ********************** BBCHED0A **********************************01360903 ! 140: C**** 01370903 ! 141: C**** WRITE REPORT TITLE 01380903 ! 142: C**** 01390903 ! 143: WRITE (I02, 90002) 01400903 ! 144: WRITE (I02, 90006) 01410903 ! 145: WRITE (I02, 90007) 01420903 ! 146: WRITE (I02, 90008) ZVERS, ZVERSD 01430903 ! 147: WRITE (I02, 90009) ZPROG, ZPROG 01440903 ! 148: WRITE (I02, 90010) ZDATE, ZCOMPL 01450903 ! 149: CBE** ********************** BBCHED0A **********************************01460903 ! 150: C***** HEADER FORMAT STATEMENT 01470903 ! 151: WRITE(NUVI, 35400) 01480903 ! 152: 35400 FORMAT(1H ,/ 1X, 35HIOFMTF - (354) ADDITIONAL FORMATTED//1X, 01490903 ! 153: 1 14HDATA TRANSFERS,//1X, 01500903 ! 154: 2 31HANS REF. - 12.9.5.2 13.1 13.5) 01510903 ! 155: CBB** ********************** BBCHED0B **********************************01520903 ! 156: C**** WRITE DETAIL REPORT HEADERS 01530903 ! 157: C**** 01540903 ! 158: WRITE (I02,90004) 01550903 ! 159: WRITE (I02,90004) 01560903 ! 160: WRITE (I02,90013) 01570903 ! 161: WRITE (I02,90014) 01580903 ! 162: WRITE (I02,90015) IVTOTL 01590903 ! 163: CBE** ********************** BBCHED0B **********************************01600903 ! 164: C***** TEST THAT A FORMAT MAY BE A CHARACTER VARIABLE, 12.4.2(3) 01610903 ! 165: C***** A CHARACTER EXPRESSION, A CHARACTER ARRAY, OR A 12.4.2(4) 01620903 ! 166: C***** CHARACTER ARRAY ELEMENT. 13.1.2 01630903 ! 167: C***** NOTE THAT THE LENGTH OF THE FORMAT MAY EXCEED THE 01640903 ! 168: C***** LENGTH OF AN ARRAY ELEMENT IF THE FORMAT SPECIFIER 01650903 ! 169: C***** IS AN ARRAY, BUT NOT IF THE SPECIFIER IS AN ARRAY ELEMENT. 01660903 ! 170: WRITE(NUVI, 35401) 01670903 ! 171: 35401 FORMAT(/8X, 30HCHARACTER EXPRESSION AS FORMAT/) 01680903 ! 172: A19VK = '(I3,I1,I4,I4,I2,I4)' 01690903 ! 173: C***** CARD 1 01700903 ! 174: READ(IRVI, A19VK) J1I(3), J1I(1), J1I(4), J1I(6), J1I(2), J1I(5)01710903 ! 175: CT001* TEST 1 - CHARACTER EXPRESSION AS FORMAT 01720903 ! 176: IVTNUM = 1 01730903 ! 177: REMRKS = 'LEADING PLUS SIGN OPTIONAL' 01740903 ! 178: WRITE (NUVI, 80004) IVTNUM, REMRKS 01750903 ! 179: A65VK = '16X,10HCOMPUTED: /26X,I1, 1X, I2, 1X, I3, 1X, I4, 1X, 01760903 ! 180: 1I5, 1X, I6' 01770903 ! 181: A85VK = '16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE/26X01780903 ! 182: 1,26H1 22 333 4444 5555 6666' 01790903 ! 183: WRITE(NUVI, '(/1X,' // A65VK // '/1X,' // A85VK // ')') J1I 01800903 ! 184: IVINSP = IVINSP + 1 01810903 ! 185: WRITE (NUVI, 70010) 01820903 ! 186: 70010 FORMAT (26X,26H1 22 333 4444 +5555 +6666) 01830903 ! 187: CT002* TEST 2 - CHARACTER ARRAY AS FORMAT 01840903 ! 188: IVTNUM = 2 01850903 ! 189: WRITE (NUVI, 80004) IVTNUM, REMRKS 01860903 ! 190: WRITE (NUVI, 80020) 01870903 ! 191: C251K(1) = '(26X, I6, 1X, I5, 1X, I4,' 01880903 ! 192: C251K(2) = ' 1X, I3, 1X, I2, 1X, I1 /' 01890903 ! 193: C251K(3) = '17X,9HCORRECT: ,22X,26H2 ' 01900903 ! 194: C251K(4) = 'CORRECT ANSWERS POSSIBLE/' 01910903 ! 195: C251K(5) = '26X,26H 6666 5555 4444 ' 01920903 ! 196: C251K(6) = '333 22 1) ' 01930903 ! 197: WRITE(NUVI, C251K) (J1I(7-IVI), IVI=1,6) 01940903 ! 198: IVINSP = IVINSP + 1 01950903 ! 199: WRITE (NUVI, 70020) 01960903 ! 200: 70020 FORMAT (26X,26H +6666 +5555 4444 333 22 1) 01970903 ! 201: CT003* TEST 3 - CHARACTER ARRAY ELEMENT AS FORMAT 01980903 ! 202: IVTNUM = 3 01990903 ! 203: WRITE (NUVI, 80004) IVTNUM, REMRKS 02000903 ! 204: WRITE (NUVI, 80020) 02010903 ! 205: C***** 02020903 ! 206: C151K(1) = '(I1,2X,I2)' 02030903 ! 207: C151K(3) = '(2X,I3,1X,I4)' 02040903 ! 208: C151K(5) = '(I5,T1,I1)' 02050903 ! 209: C151K(7) = '(TR4,I2,TL2,I3)' 02060903 ! 210: C***** CARDS 2-5 02070903 ! 211: DO 0032 IVI = 1, 7, 2 02080903 ! 212: READ(IRVI, C151K(IVI)) IA1I(IVI), IA1I(IVI+1) 02090903 ! 213: 0032 CONTINUE 02100903 ! 214: WRITE(NUVI, 70030) IA1I 02110903 ! 215: 70030 FORMAT (25X, 8(1X, I5)) 02120903 ! 216: IVINSP = IVINSP + 1 02130903 ! 217: WRITE (NUVI, 70031) 02140903 ! 218: 70031 FORMAT (1H ,16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE)02150903 ! 219: WRITE (NUVI, 70032) 02160903 ! 220: 70032 FORMAT(26X, ' 1 45 345 7890 12345 1 56 567'/ 02170903 ! 221: 1 26X, ' +1 +45 +345 +7890 12345 +1 +56 +567') 02180903 ! 222: C***** 02190903 ! 223: C***** TEST ADDITIONAL INTEGER EDITING FEATURES. 02200903 ! 224: C***** - IW.M EDITING DESCRIPTOR 13.5.9.1 02210903 ! 225: C***** NOTE THAT IF M IS ZERO AND THE VALUE OF THE INTERNAL 02220903 ! 226: C***** DATUM IS ZERO, THE OUTPUT FIELD CONSISTS OF ONLY BLANK 02230903 ! 227: C***** CHARACTERS REGARDLESS OF THE SIGN CONTROL IN EFFECT. 02240903 ! 228: WRITE(NUVI, 35404) 02250903 ! 229: 35404 FORMAT(/8X, 32HINTEGER EDITING AND OUT OF RANGE/) 02260903 ! 230: C***** CARD 6 02270903 ! 231: READ(IRVI, 35405) (IA1I(IVI), IVI=1,4) 02280903 ! 232: 35405 FORMAT(I6.6, T1, I6.4, TL6, I6.2, TL9, I6.0) 02290903 ! 233: CT004* TEST 4 - INTEGER EDITING 02300903 ! 234: IVTNUM = 4 02310903 ! 235: WRITE (NUVI, 80004) IVTNUM,REMRKS 02320903 ! 236: WRITE (NUVI, 80020) 02330903 ! 237: WRITE(NUVI, 70040) (IA1I(IVI), IVI=1,4) 02340903 ! 238: 70040 FORMAT(25X, 4(1X, I6)) 02350903 ! 239: IVINSP = IVINSP + 1 02360903 ! 240: WRITE (NUVI, 70031) 02370903 ! 241: WRITE (NUVI, 70041) 02380903 ! 242: 70041 FORMAT(26X, 27H 12345 12345 12345 12345/ 02390903 ! 243: 1 26X, 27H+12345 +12345 +12345 +12345) 02400903 ! 244: CT005* TEST 5 - OUT OF RANGE 02410903 ! 245: IVTNUM = 5 02420903 ! 246: WRITE (NUVI, 80004) IVTNUM 02430903 ! 247: WRITE (NUVI, 80020) 02440903 ! 248: JVI = 0 02450903 ! 249: IVI = 12 02460903 ! 250: WRITE (NUVI, 70050) -IVI, IVI, IVI, IVI, IVI, JVI, JVI, JVI 02470903 ! 251: 70050 FORMAT (26X, SS, I5.5, S, 1X, I5.5, SS, 1X, I5.3, 1X, I5.1, 02480903 ! 252: 1 1X, I5.0, 1X, 1H(, I5.0, 1H), S, 1X, 1H(, I5.0, 1H), 02490903 ! 253: 2 SP, 1X, 1H(, I5.0, 1H)) 02500903 ! 254: IVINSP = IVINSP + 1 02510903 ! 255: WRITE (NUVI, 80022) 02520903 ! 256: WRITE (NUVI, 70051) 02530903 ! 257: 70051 FORMAT (26X, 45H***** 00012 012 12 12 ( ) ( ), 02540903 ! 258: 1 8H ( )) 02550903 ! 259: C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS 02560903 ! 260: WRITE (NUVI, 90002) 02570903 ! 261: WRITE (NUVI, 90013) 02580903 ! 262: WRITE (NUVI, 90014) 02590903 ! 263: C***** 02600903 ! 264: C***** TEST ADDITIONAL DOUBLE PRECISION EDITING FEATURES. 13.5.9.2 02610903 ! 265: C***** - D.P. MAY BE READ, WRITTEN WITH F AND E 13.5.9.2.1 02620903 ! 266: C***** EDIT DESCRIPTOR. 13.5.9.2.2 02630903 ! 267: C***** (D AND G FORMATS ARE TEST IN INTERNAL FILE SEGMENTS 02640903 ! 268: C***** 392 AND 393.) 02650903 ! 269: C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4) 02660903 ! 270: C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4) 02670903 ! 271: C***** - IF SP AND FIELD TOO SMALL, THE PLUS IS NOT 13.5.9(5) 02680903 ! 272: C***** OPTIONAL 02690903 ! 273: WRITE(NUVI, 35408) 02700903 ! 274: 35408 FORMAT(/8X,41HDOUBLE PRECISION EDITING AND OUT OF RANGE/) 02710903 ! 275: C***** CARD 7 02720903 ! 276: READ(IRVI, 35409) B4D 02730903 ! 277: 35409 FORMAT(1X, 2F5.2, F10.2, F10.5, TL40, 1X, 2E5.2, E10.2, E10.5E5)02740903 ! 278: CT006* TEST 6 - DOUBLE PRECISION EDITING AND OUT OF RANGE 02750903 ! 279: IVTNUM = 6 02760903 ! 280: REMRKS = '2 COMPUTED LINES EXPECTED' 02770903 ! 281: WRITE (NUVI, 80004) IVTNUM,REMRKS 02780903 ! 282: WRITE (NUVI, 80020) 02790903 ! 283: B4D(2,1,2,2) = (B4D(2,1,2,2) * 10) ** 12 02800903 ! 284: WRITE(NUVI, 70060) B4D 02810903 ! 285: 70060 FORMAT(26X, SP, F6.2, SS, 1X, F5.4, 1X, F6.3, 1X, F6.4, 02820*TI ! 286: 1 /26X,2P,E6.1,0P,2(5X,E10.5),5X,E9.5E1) 02830*TI ! 287: IVINSP = IVINSP + 1 02840903 ! 288: WRITE (NUVI, 70061) 02850903 ! 289: 70061 FORMAT(/1H ,16X,10HCORRECT: ,22X,31HCORRESPONDING LINES MUST02860903 ! 290: 1 MATCH ,/1H ,48X,31HEITHER OF THE FOLLOWING TWO , 02870903 ! 291: 2 /1H ,48X,31HCORRECT ANSWERS ) 02880903 ! 292: WRITE (NUVI, 70062) 02890903 ! 293: 70062 FORMAT(26X,26H****** ***** 12.345 1.2345/26X, 02900903 ! 294: 1 50H****** .12350E+03 .12345E+02 *********/02910903 ! 295: 2 /26X,26H****** ***** 12.345 1.2345/26X, 02920903 ! 296: 3 50H****** .12350+003 .12345+002 *********)02930903 ! 297: C***** 02940903 ! 298: C***** TEST ADDITIONAL COMPLEX EDITING FEATURES. 13.5.9.2.4 02950903 ! 299: C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4) 02960903 ! 300: C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4) 02970903 ! 301: WRITE(NUVI, 35411) 02980903 ! 302: 35411 FORMAT(/8X, 32HCOMPLEX EDITING AND OUT OF RANGE/) 02990903 ! 303: CT007* TEST 7 - COMPLEX EDITING AND OUT OF RANGE 03000903 ! 304: IVTNUM = 7 03010903 ! 305: WRITE (NUVI, 80004) IVTNUM, REMRKS 03020903 ! 306: WRITE (NUVI, 80020) 03030903 ! 307: AVC = (25.25, 75.75) 03040903 ! 308: BVC = (0.25E+10, 0.75E+10) 03050903 ! 309: WRITE(NUVI, 70070) AVC, AVC, BVC, BVC 03060903 ! 310: 70070 FORMAT (26X, F7.2, 3X, F6.2, 3X, F5.2, 3X, F4.2, 03070903 ! 311: 1 /26X, E8.2E3, 3X, E7.2E2, 2(4X, E6.2E1)) 03080903 ! 312: IVINSP = IVINSP + 1 03090903 ! 313: WRITE (NUVI, 70061) 03100903 ! 314: WRITE (NUVI, 70071) 03110903 ! 315: 70071 FORMAT (26X, 31H 25.25 75.75 25.25 ****/ 03120903 ! 316: 1 25X, 39H .25E+010 .75E+10 ****** ******// 03130903 ! 317: 2 26X, 31H +25.25 +75.75 25.25 ****/ 03140903 ! 318: 3 25X, 39H .25E+010 .75E+10 ****** ******) 03150903 ! 319: C***** 03160903 ! 320: C***** - TEST BZ, BN EDIT DESCRIPTORS 13.5.8 03170903 ! 321: C***** - TEST T, TL, TR EDIT DESCRIPTORS 13.5.3.1 03180903 ! 322: WRITE(NUVI, 35414) 03190903 ! 323: 35414 FORMAT(/8X,36HBZ, BN, T, TL AND TR EDIT DESCRIPTOR/) 03200903 ! 324: CT008* TEST 8 - BZ, BN, T, TL, AND TR EDIT DESCRIPTOR 03210903 ! 325: IVTNUM = 8 03220903 ! 326: REMRKS = 'LEADING PLUS SIGN OPTIONAL' 03230903 ! 327: WRITE (NUVI, 80004) IVTNUM,REMRKS 03240903 ! 328: WRITE (NUVI, 80020) 03250903 ! 329: C***** CARD 8 03260903 ! 330: READ(IRVI, 70080) AVD, B4D(2,1,1,2), A2C(1,1), AVC 03270903 ! 331: 70080 FORMAT(BN, D5.2, BZ, D5.2, TL40, 2F5.2, T1, TR1, TL1, BN, 2F5.1)03280903 ! 332: WRITE(NUVI, 70081) AVD, B4D(2,1,1,2), A2C(1,1), AVC 03290903 ! 333: 70081 FORMAT (25X, 2F6.2, (((4(1X, F6.2))))) 03300903 ! 334: IVINSP = IVINSP + 1 03310903 ! 335: WRITE (NUVI, 70031) 03320903 ! 336: WRITE (NUVI, 70082) 03330903 ! 337: 70082 FORMAT(25X, TR26, 14H 123.40 567.80, T25, 13H 12.34506.78, 03340903 ! 338: 1 1X, 13H120.34 506.78// 03350903 ! 339: 2 25X, TR26, 14H 123.40 567.80, T25, 13H +12.34506.78, 03360903 ! 340: 3 1X, 13H120.34 506.78) 03370903 ! 341: C***** 03380903 ! 342: C***** PASS A CHARACTER CONSTANT, WHICH IS A LEGITIMATE FORMAT 03390903 ! 343: C***** SPECIFIER TO A SUBROUTINE. 03400903 ! 344: WRITE(NUVI, 35417) 03410903 ! 345: 35417 FORMAT(/8X,15HSUBROUTINE CALL/) 03420903 ! 346: CT009* TEST 9 - SUBROUTINE CALL 03430903 ! 347: IVTNUM = 9 03440903 ! 348: WRITE (NUVI, 80004) IVTNUM,REMRKS 03450903 ! 349: C***** CARD 9 03460903 ! 350: A11VK = '(I5, 6(I5))' 03470903 ! 351: CALL SN904(A11VK, IRVI, NUVI) 03480903 ! 352: IVINSP = IVINSP + 1 03490903 ! 353: C***** 03500903 ! 354: C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS 03510903 ! 355: WRITE (NUVI, 90002) 03520903 ! 356: WRITE (NUVI, 90013) 03530903 ! 357: WRITE (NUVI, 90014) 03540903 ! 358: C***** 03550903 ! 359: C***** - TEST SS AND SP EDIT DESCRIPTORS. 13.5.6 03560903 ! 360: C***** - TEST ALSO THAT A FORMAT SPECIFICATION MAY BE 13.1.2 03570903 ! 361: C***** ALTERED BY A CHARACTER SUBSTRING SUBSTITUTION. 5.7 03580903 ! 362: WRITE(NUVI, 35419) 03590903 ! 363: 35419 FORMAT(/8X,25HSS AND SP EDIT DESCRIPTOR/) 03600903 ! 364: CT010* TEST 10 - SS AND SP EDIT DESCRIPTORS 03610903 ! 365: IVTNUM = 10 03620903 ! 366: WRITE (NUVI, 80004) IVTNUM, REMRKS 03630903 ! 367: WRITE (NUVI, 80020) 03640903 ! 368: IVI = 12345 03650903 ! 369: AVS = 25.25 03660903 ! 370: A1D(2) = 5.5D0 03670903 ! 371: A2C(2,1) = (3.0, 4.0) 03680903 ! 372: A52VK = '(26X,SP,F5.1,SS,2X,F4.1,SP,(T40,I6,2X,F6.2,SS,F6.1))' 03690903 ! 373: WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03700903 ! 374: IVINSP = IVINSP + 1 03710903 ! 375: WRITE (NUVI, 70101) 03720903 ! 376: 70101 FORMAT(/1H ,16X,10HCORRECT: ,22X,31HCORRESPONDING LINES MUST03730903 ! 377: 1 MATCH ) 03740903 ! 378: WRITE (NUVI, 70102) 03750903 ! 379: 70102 FORMAT(26X,' +3.0 4.0 +12345 +25.25 5.5' 03760903 ! 380: 1 /T40,' 12345 25.25 5.5') 03770903 ! 381: CT011* TEST 11 - FORMAT ALTERED BY CHARACTER SUBSTRING SUBSTITUTION 03780903 ! 382: IVTNUM = 11 03790903 ! 383: WRITE (NUVI, 80004) IVTNUM, REMRKS 03800903 ! 384: WRITE (NUVI, 80020) 03810903 ! 385: A52VK(7:7) = 'S' 03820903 ! 386: A52VK(14:15) = 'SP' 03830903 ! 387: A52VK(26:26) = 'S' 03840903 ! 388: A52VK(45:45) = 'P' 03850903 ! 389: WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03860903 ! 390: IVINSP = IVINSP + 1 03870903 ! 391: WRITE (NUVI, 70101) 03880903 ! 392: WRITE (NUVI, 70111) 03890903 ! 393: 70111 FORMAT (26X,' 3.0 +4.0 12345 25.25 +5.5' 03900903 ! 394: 1 /T40,'+12345 +25.25 +5.5') 03910903 ! 395: C***** 03920903 ! 396: C***** TEST A COLON EDIT DESCRIPTOR FOLLOWED BY A H-EDIT 13.5.5 03930903 ! 397: C***** DESCRIPTOR TO SHOW THAT THE COLON EDIT DESCRIPTOR 03940903 ! 398: C***** TERMINATED IF THERE ARE NO MORE ITEMS IN THE INPUT/OUTPUT LIST03950903 ! 399: WRITE(NUVI, 35422) 03960903 ! 400: 35422 FORMAT(/8X,'COLON EDIT DESCRIPTOR'/) 03970903 ! 401: CT012* TEST 12 03980903 ! 402: IVTNUM = 12 03990903 ! 403: REMRKS = '2 COMPUTED LINES EXPECTED' 04000903 ! 404: WRITE (NUVI, 80004) IVTNUM, REMRKS 04010903 ! 405: WRITE (NUVI, 80020) 04020903 ! 406: A32VK = 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH' 04030903 ! 407: WRITE(NUVI, 70120) A32VK, A32VK 04040903 ! 408: 70120 FORMAT(26X, A32, :, 'IIIIJJJJ') 04050903 ! 409: IVINSP = IVINSP + 1 04060903 ! 410: WRITE (NUVI, 70101) 04070903 ! 411: WRITE (NUVI, 70121) 04080903 ! 412: 70121 FORMAT(26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ', 04090903 ! 413: 1 /26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH') 04100903 ! 414: C***** 04110903 ! 415: C***** TEST THAT FW.D, EW.DE(E) AND GW.DE(E) MAY HAVE MORE DIGITS ON 04120903 ! 416: C***** INPUT THAN THE PROCESSOR CAN HANDLE FOR D.P. AND COMPLEX 04130903 ! 417: CT013* TEST 13 - LARGE FORMAT SIZE FOR D.P. AND COMPLEX 04140903 ! 418: IVTNUM = 13 04150903 ! 419: WRITE (NUVI, 70131) IVTNUM 04160903 ! 420: 70131 FORMAT (/1H ,2X,I3,4X,7HINSPECT,32X, 04170903 ! 421: 1 'TEST SUCCESSFUL IF PROCESSOR IS '/1H ,48X, 04180903 ! 422: 2 'ABLE TO READ INPUT CARDS 10-14 '/1H ,48X, 04190903 ! 423: 3 'UNDER F, E, AND G FORMATS WHICH '/1H ,48X, 04200903 ! 424: 4 'HAVE MORE DIGITS THAN THE '/1H ,48X, 04210903 ! 425: 5 'PROCESSOR CAN HANDLE FOR D. P. '/1H ,48X, 04220903 ! 426: 6 'AND COMPLEX') 04230903 ! 427: IVINSP = IVINSP + 1 04240903 ! 428: C***** CARDS 10-14 04250903 ! 429: READ(IRVI, 70130) B4D(1,1,1,1), AVD, AVC, A2C(2,2), BVC, 04260903 ! 430: 1 (B4D(1,1,IVI,1),IVI=1,2), A1D(1), A2C(1,2), CVC 04270903 ! 431: 70130 FORMAT(2F28.14, /2(E14.7E2, G14.14E1), /G14.0E3, E14.14E3, 04280903 ! 432: 1 E28.0E1, /2G28.14E2, /2(F14.0, F14.14) ) 04290903 ! 433: C***** 04300903 ! 434: CBB** ********************** BBCSUM0 **********************************04310903 ! 435: C**** WRITE OUT TEST SUMMARY 04320903 ! 436: C**** 04330903 ! 437: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04340903 ! 438: WRITE (I02, 90004) 04350903 ! 439: WRITE (I02, 90014) 04360903 ! 440: WRITE (I02, 90004) 04370903 ! 441: WRITE (I02, 90020) IVPASS 04380903 ! 442: WRITE (I02, 90022) IVFAIL 04390903 ! 443: WRITE (I02, 90024) IVDELE 04400903 ! 444: WRITE (I02, 90026) IVINSP 04410903 ! 445: WRITE (I02, 90028) IVTOTN, IVTOTL 04420903 ! 446: CBE** ********************** BBCSUM0 **********************************04430903 ! 447: CBB** ********************** BBCFOOT0 **********************************04440903 ! 448: C**** WRITE OUT REPORT FOOTINGS 04450903 ! 449: C**** 04460903 ! 450: WRITE (I02,90016) ZPROG, ZPROG 04470903 ! 451: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04480903 ! 452: WRITE (I02,90019) 04490903 ! 453: CBE** ********************** BBCFOOT0 **********************************04500903 ! 454: CBB** ********************** BBCFMT0A **********************************04510903 ! 455: C**** FORMATS FOR TEST DETAIL LINES 04520903 ! 456: C**** 04530903 ! 457: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04540903 ! 458: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04550903 ! 459: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04560903 ! 460: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04570903 ! 461: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04580903 ! 462: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04590903 ! 463: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04600903 ! 464: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04610903 ! 465: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04620903 ! 466: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04630903 ! 467: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04640903 ! 468: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04650903 ! 469: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04660903 ! 470: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04670903 ! 471: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04680903 ! 472: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04690903 ! 473: 80050 FORMAT (1H ,48X,A31) 04700903 ! 474: CBE** ********************** BBCFMT0A **********************************04710903 ! 475: CBB** ********************** BBCFMAT1 **********************************04720903 ! 476: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04730903 ! 477: C**** 04740903 ! 478: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04750903 ! 479: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04760903 ! 480: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04770903 ! 481: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04780903 ! 482: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04790903 ! 483: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04800903 ! 484: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04810903 ! 485: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04820903 ! 486: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04830903 ! 487: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04840903 ! 488: 21H(,F12.5,2H, ,F12.5,1H)) 04850903 ! 489: CBE** ********************** BBCFMAT1 **********************************04860903 ! 490: CBB** ********************** BBCFMT0B **********************************04870903 ! 491: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04880903 ! 492: C**** 04890903 ! 493: 90002 FORMAT (1H1) 04900903 ! 494: 90004 FORMAT (1H ) 04910903 ! 495: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04920903 ! 496: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04930903 ! 497: 90008 FORMAT (1H ,21X,A13,A17) 04940903 ! 498: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04950903 ! 499: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04960903 ! 500: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04970903 ! 501: 1 7X,7HREMARKS,24X) 04980903 ! 502: 90014 FORMAT (1H ,46H----------------------------------------------, 04990903 ! 503: 1 33H---------------------------------) 05000903 ! 504: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 05010903 ! 505: C**** 05020903 ! 506: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05030903 ! 507: C**** 05040903 ! 508: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 05050903 ! 509: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 05060903 ! 510: 1 A13) 05070903 ! 511: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 05080903 ! 512: C**** 05090903 ! 513: C**** FORMAT STATEMENTS FOR RUN SUMMARY 05100903 ! 514: C**** 05110903 ! 515: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 05120903 ! 516: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 05130903 ! 517: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 05140903 ! 518: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 05150903 ! 519: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 05160903 ! 520: CBE** ********************** BBCFMT0B **********************************05170903 ! 521: C***** 05180903 ! 522: C***** END OF TEST SEGMENT 354 05190903 ! 523: STOP 05200903 ! 524: END 05210903 ! 525: C***********************************************************************00010904 ! 526: C DATE***82/08/02*18.33.46 ! 527: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 528: C AUDIT FCVS78 V2.0 ! 529: C***** FORTRAN 77 00020904 ! 530: C***** FM904 SN904 - (790) 00030904 ! 531: C***** THIS SUBROUTINE IS CALLED BY FM903 00040904 ! 532: C***********************************************************************00050904 ! 533: C***** GENERAL PURPOSE ANS REFS 00060904 ! 534: C***** THIS SUBROUTINE IS CALLED BY IOFMTF (354) 00070904 ! 535: C***** IT IS USED PRIMARILY TO TEST THAT A CHARACTER 13.1.2 00080904 ! 536: C***** CONSTANT MAY BE PASSED AS A PARAMETER TO A 15.6.2.3 00090904 ! 537: C***** SUBROUTINE AND USED AS A FORMAT. 00100904 ! 538: C***** IT ALSO TESTS THAT A FORMAT MAY BE DEFINED IN A 9.4 00110904 ! 539: C***** DATA STATEMENT. 00120904 ! 540: C***** RESTRICTIONS OBSERVED 00130904 ! 541: C***** SEE SEGMENT 354 00140904 ! 542: C***** 00150904 ! 543: SUBROUTINE SN904(A0WVK, IRWVI, NUWVI) 00160904 ! 544: C***** 00170904 ! 545: C***** S P E C I F I C A T I O N S SEGMENT 790 00180904 ! 546: C***** 00190904 ! 547: CHARACTER*(*) A0WVK 00200904 ! 548: CHARACTER*130 A130VK 00210904 ! 549: INTEGER I1I(5) 00220904 ! 550: C***** 00230904 ! 551: C***** TESTS THAT 00240904 ! 552: C***** - A FORMAT SPECIFIER MAY BE PASSED AS A CHARACTER 13.1.2 00250904 ! 553: C***** CONSTANT TO A SUBROUTINE. 15.6.2.3 00260904 ! 554: C***** - A FORMAT SPECIFIER MAY BE DEFINED IN A DATA 13.1.2 00270904 ! 555: C***** STATEMENT. 9.4 00280904 ! 556: C***** - AN INPUT LIST MAY CONTAIN AN INTEGER THAT IS USED 12.8.2.3 00290904 ! 557: C***** AS A SUBSCRIPT IN AN IMPLIED DO-LIST. 00300904 ! 558: C***** - AN OUTPUT LIST MAY CONTAIN AN EXPRESSION WITH AN 12.8.2.2 00310904 ! 559: C***** INTRINISC FUNCTION. 15.3 00320904 ! 560: C***** 00330904 ! 561: DATA A130VK/'(16X,10HCOMPUTED: /26X, 3I5/16X,10HCORRECT: ,22X, 00340904 ! 562: 1''2 CORRECT ANSWERS POSSIBLE''/26X,'' 1111 3333-5555''/26X,''+111100350904 ! 563: 2+3333-5555'')'/ 00360904 ! 564: READ(IRWVI, A0WVK) IVI, (I1I(JVI),JVI=1,IVI) 00370904 ! 565: WRITE(NUWVI, A130VK) IABS(I1I(1)), MAX0(I1I(2),I1I(5)), I1I(3) 00380904 ! 566: C***** 00390904 ! 567: RETURN 00400904 ! 568: END 00410904
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.