![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM402.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 FM402.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: PROGRAM FM402 00010402 ! 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 00020402 ! 6: C 00030402 ! 7: C 00040402 ! 8: C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS)00050402 ! 9: C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT 00060402 ! 10: C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/ 00070402 ! 11: C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI- 00080402 ! 12: C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC- 00090402 ! 13: C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES- 00100402 ! 14: C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF 00110402 ! 15: C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST 00120402 ! 16: C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING00130402 ! 17: C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF 00140402 ! 18: C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL 00150402 ! 19: C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER 00160402 ! 20: C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT 00170402 ! 21: C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT. 00180402 ! 22: C 00190402 ! 23: C THIS ROUTINE TESTS FOR PROPER EDITING BY 00200402 ! 24: C 00210402 ! 25: C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT00220402 ! 26: C AND OUTPUT, 00230402 ! 27: C 00240402 ! 28: C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00250402 ! 29: C LIST ITEM IS LESS THAN THE WIDTH W, 00260402 ! 30: C 00270402 ! 31: C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00280402 ! 32: C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W, 00290402 ! 33: C 00300402 ! 34: C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT 00310402 ! 35: C SPECIFICATION. 00320402 ! 36: C 00330402 ! 37: C REFERENCES - 00340402 ! 38: C 00350402 ! 39: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360402 ! 40: C X3.9-1978 00370402 ! 41: C 00380402 ! 42: C SECTION 3.1, FORTRAN CHARACTER SET 00390402 ! 43: C SECTION 4.8, CHARACTER TYPE 00400402 ! 44: C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00410402 ! 45: C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00420402 ! 46: C SECTION 13.5.11, A EDITING 00430402 ! 47: C 00440402 ! 48: C 00450402 ! 49: C 00460402 ! 50: C 00470402 ! 51: C ******************************************************************00480402 ! 52: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00490402 ! 53: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00500402 ! 54: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00510402 ! 55: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00520402 ! 56: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00530402 ! 57: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00540402 ! 58: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00550402 ! 59: C THE RESULT OF EXECUTING THESE TESTS. 00560402 ! 60: C 00570402 ! 61: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00580402 ! 62: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00590402 ! 63: C 00600402 ! 64: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00610402 ! 65: C DEPARTMENT OF THE NAVY 00620402 ! 66: C FEDERAL COBOL COMPILER TESTING SERVICE 00630402 ! 67: C WASHINGTON, D.C. 20376 00640402 ! 68: C 00650402 ! 69: C ******************************************************************00660402 ! 70: C 00670402 ! 71: C 00680402 ! 72: IMPLICIT LOGICAL (L) 00690402 ! 73: IMPLICIT CHARACTER*14 (C) 00700402 ! 74: C 00710402 ! 75: DIMENSION IDUMP (80) 00720402 ! 76: DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46) 00730402 ! 77: CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1 00740402 ! 78: CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50 00750402 ! 79: CHARACTER CVTN01*1 00760402 ! 80: 00770402 ! 81: DATA CATN14 /46*' '/ 00780402 ! 82: DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/00790402 ! 83: DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00800402 ! 84: 1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C', 00810402 ! 85: 2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 00820402 ! 86: 3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/ 00830402 ! 87: DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/ 00840402 ! 88: 00850402 ! 89: C 00860402 ! 90: C 00870402 ! 91: C 00880402 ! 92: C INITIALIZATION SECTION. 00890402 ! 93: C 00900402 ! 94: C INITIALIZE CONSTANTS 00910402 ! 95: C ******************** 00920402 ! 96: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00930402 ! 97: I01 = 5 00940402 ! 98: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00950402 ! 99: I02 = 6 00960402 ! 100: C SYSTEM ENVIRONMENT SECTION 00970402 ! 101: C 00980402 ! 102: I01 = 5 00990402 ! 103: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000402 ! 104: C (UNIT NUMBER FOR CARD READER). 01010402 ! 105: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01020402 ! 106: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030402 ! 107: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040402 ! 108: C 01050402 ! 109: I02 = 6 01060402 ! 110: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070402 ! 111: C (UNIT NUMBER FOR PRINTER). 01080402 ! 112: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01090402 ! 113: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100402 ! 114: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110402 ! 115: C 01120402 ! 116: IVPASS = 0 01130402 ! 117: IVFAIL = 0 01140402 ! 118: IVDELE = 0 01150402 ! 119: ICZERO = 0 01160402 ! 120: C 01170402 ! 121: C WRITE OUT PAGE HEADERS 01180402 ! 122: C 01190402 ! 123: WRITE (I02,90002) 01200402 ! 124: WRITE (I02,90006) 01210402 ! 125: WRITE (I02,90008) 01220402 ! 126: WRITE (I02,90004) 01230402 ! 127: WRITE (I02,90010) 01240402 ! 128: WRITE (I02,90004) 01250402 ! 129: WRITE (I02,90016) 01260402 ! 130: WRITE (I02,90001) 01270402 ! 131: WRITE (I02,90004) 01280402 ! 132: WRITE (I02,90012) 01290402 ! 133: WRITE (I02,90014) 01300402 ! 134: WRITE (I02,90004) 01310402 ! 135: C 01320402 ! 136: C 01330402 ! 137: C 01340402 ! 138: C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER 01350402 ! 139: C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS 01360402 ! 140: C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE 01370402 ! 141: C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD 01380402 ! 142: C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR 01390402 ! 143: C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A 01400402 ! 144: C EDITING 01410402 ! 145: C 01420402 ! 146: C 01430402 ! 147: 80052 FORMAT (1H ,4X,48HTESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED.01440402 ! 148: 1) 01450402 ! 149: 80054 FORMAT (1H ,56HIMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE01460402 ! 150: 1 LINE) 01470402 ! 151: 80056 FORMAT (1H ,52HOF THE FORM '123456 ...'. THE REFERENCE LINE IS T01480402 ! 152: 1O) 01490402 ! 153: 80058 FORMAT (1H ,49HAID IN THE VISUAL VERIFICATION OF THE TESTS. FOR) 01500402 ! 154: 80062 FORMAT (1H ,50HTHE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED 01510402 ! 155: 1) 01520402 ! 156: 80064 FORMAT (1H ,54HIN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE01530402 ! 157: 1CT ) 01540402 ! 158: 80066 FORMAT (1H ,44HCOLUMN IN BOTH VALUE AND CHARACTER POSITION.) 01550402 ! 159: 80072 FORMAT (1H ,26HREFERENCE LINE - ,10H1234567890,5X,10H123401560402 ! 160: 1567890) 01570402 ! 161: WRITE (I02,80052) 01580402 ! 162: WRITE (I02,80054) 01590402 ! 163: WRITE (I02,80056) 01600402 ! 164: WRITE (I02,80058) 01610402 ! 165: WRITE (I02,80062) 01620402 ! 166: WRITE (I02,80064) 01630402 ! 167: WRITE (I02,80066) 01640402 ! 168: WRITE (I02,90004) 01650402 ! 169: WRITE (I02,80072) 01660402 ! 170: C 01670402 ! 171: C **** FCVS PROGRAM 402 - TEST 001 **** 01680402 ! 172: C 01690402 ! 173: C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 01700402 ! 174: C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE 01710402 ! 175: C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A 01720402 ! 176: C VARIABLE. 01730402 ! 177: C 01740402 ! 178: IVTNUM = 001 01750402 ! 179: IF (ICZERO) 30010, 0010, 30010 01760402 ! 180: 0010 CONTINUE 01770402 ! 181: CVTN01 = 'A' 01780402 ! 182: 0012 FORMAT (1H ,4X,I5,26X,A,14X,1HA) 01790402 ! 183: WRITE (I02, 0012) IVTNUM, CVTN01 01800402 ! 184: GO TO 0021 01810402 ! 185: 30010 IVDELE = IVDELE + 1 01820402 ! 186: WRITE (I02,80000) IVTNUM 01830402 ! 187: 0021 CONTINUE 01840402 ! 188: C 01850402 ! 189: C **** FCVS PROGRAM 402 - TEST 002 **** 01860402 ! 190: C 01870402 ! 191: C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST 01880402 ! 192: C ITEM IS AN ARRAY ELEMENT. 01890402 ! 193: C 01900402 ! 194: IVTNUM = 002 01910402 ! 195: IF (ICZERO) 30020, 0020, 30020 01920402 ! 196: 0020 CONTINUE 01930402 ! 197: CATN31 (1,2,1) = 'Z' 01940402 ! 198: 0022 FORMAT (1H ,4X,I5,26X,A,14X,1HZ) 01950402 ! 199: WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1) 01960402 ! 200: GO TO 0031 01970402 ! 201: 30020 IVDELE = IVDELE + 1 01980402 ! 202: WRITE (I02,80000) IVTNUM 01990402 ! 203: 0031 CONTINUE 02000402 ! 204: C 02010402 ! 205: C *** FCVS PROGRAM 402 - TEST 003 **** 02020402 ! 206: C 02030402 ! 207: C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE 02040402 ! 208: C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE 02050402 ! 209: C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED 02060402 ! 210: C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH. 02070402 ! 211: C 02080402 ! 212: IVTNUM = 003 02090402 ! 213: IF (ICZERO) 30030, 0030, 30030 02100402 ! 214: 0030 CONTINUE 02110402 ! 215: CVTN11 = '/' 02120402 ! 216: 0032 FORMAT (1H ,4X,I5,26X,A,14X,1H/) 02130402 ! 217: WRITE (I02, 0032) IVTNUM, CVTN11 02140402 ! 218: GO TO 0041 02150402 ! 219: 30030 IVDELE = IVDELE + 1 02160402 ! 220: WRITE (I02, 80000) IVTNUM 02170402 ! 221: 0041 CONTINUE 02180402 ! 222: C 02190402 ! 223: C *** FCVS PROGRAM 402 - TEST 004 *** 02200402 ! 224: C 02210402 ! 225: C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING 02220402 ! 226: C EDITED IS NUMERIC. 02230402 ! 227: C 02240402 ! 228: IVTNUM = 004 02250402 ! 229: IF (ICZERO) 30040, 0040, 30040 02260402 ! 230: 0040 CONTINUE 02270402 ! 231: CVTN11 = '9' 02280402 ! 232: 0042 FORMAT (1H ,4X,I5,26X,A,14X,1H9) 02290402 ! 233: WRITE (I02, 0042) IVTNUM, CVTN11 02300402 ! 234: GO TO 0051 02310402 ! 235: 30040 IVDELE = IVDELE + 1 02320402 ! 236: WRITE (I02, 80000) IVTNUM 02330402 ! 237: 0051 CONTINUE 02340402 ! 238: C 02350402 ! 239: C *** FCVS PROGRAM 402 - TEST 005 *** 02360402 ! 240: C 02370402 ! 241: C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL02380402 ! 242: C CHARACTER QUOTE. 02390402 ! 243: C 02400402 ! 244: IVTNUM = 005 02410402 ! 245: IF (ICZERO) 30050, 0050, 30050 02420402 ! 246: 0050 CONTINUE 02430402 ! 247: CVTN11 = '''' 02440402 ! 248: 0052 FORMAT (1H ,4X,I5,26X,A,14X,1H') 02450402 ! 249: WRITE (I02, 0052) IVTNUM, CVTN11 02460402 ! 250: GO TO 0061 02470402 ! 251: 30050 IVDELE = IVDELE + 1 02480402 ! 252: WRITE (I02, 80000) IVTNUM 02490402 ! 253: C 02500402 ! 254: C 02510402 ! 255: C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR 02520402 ! 256: C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE 02530402 ! 257: C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH. 02540402 ! 258: C 02550402 ! 259: C 02560402 ! 260: 0061 CONTINUE 02570402 ! 261: C 02580402 ! 262: C **** FCVS PROGRAM 402 - TEST 006 **** 02590402 ! 263: C 02600402 ! 264: C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS 02610402 ! 265: C 02620402 ! 266: IVTNUM = 006 02630402 ! 267: IF (ICZERO) 30060, 0060, 30060 02640402 ! 268: 0060 CONTINUE 02650402 ! 269: CATN12(1) = 'ABMYZ' 02660402 ! 270: 0062 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H ABMYZ) 02670402 ! 271: WRITE (I02, 0062) IVTNUM, CATN12(1) 02680402 ! 272: GO TO 0071 02690402 ! 273: 30060 IVDELE = IVDELE + 1 02700402 ! 274: WRITE (I02, 80000) IVTNUM 02710402 ! 275: 0071 CONTINUE 02720402 ! 276: C 02730402 ! 277: C **** FCVS PROGRAM 402 - TEST 007 **** 02740402 ! 278: C 02750402 ! 279: C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS 02760402 ! 280: C 02770402 ! 281: IVTNUM = 007 02780402 ! 282: IF (ICZERO) 30070, 0070, 30070 02790402 ! 283: 0070 CONTINUE 02800402 ! 284: CATN12(2) = '01589' 02810402 ! 285: 0072 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 01589) 02820402 ! 286: WRITE (I02, 0072) IVTNUM, CATN12(2) 02830402 ! 287: GO TO 0081 02840402 ! 288: 30070 IVDELE = IVDELE + 1 02850402 ! 289: WRITE (I02, 80000) IVTNUM 02860402 ! 290: 0081 CONTINUE 02870402 ! 291: C 02880402 ! 292: C **** FCVS PROGRAM 402 - TEST 008 **** 02890402 ! 293: C 02900402 ! 294: C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL 02910402 ! 295: C CHARACTERS. 02920402 ! 296: C 02930402 ! 297: IVTNUM = 008 02940402 ! 298: IF (ICZERO) 30080, 0080, 30080 02950402 ! 299: 0080 CONTINUE 02960402 ! 300: CATN12(3) = '=+-()' 02970402 ! 301: 0082 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H =+-()) 02980402 ! 302: WRITE (I02, 0082) IVTNUM, CATN12(3) 02990402 ! 303: GO TO 0091 03000402 ! 304: 30080 IVDELE = IVDELE + 1 03010402 ! 305: WRITE (I02, 80000) IVTNUM 03020402 ! 306: 0091 CONTINUE 03030402 ! 307: C 03040402 ! 308: C **** FCVS PROGRAM FM402 - TEST 009 **** 03050402 ! 309: C 03060402 ! 310: C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03070402 ! 311: C OF LETTERS, DIGITS AND SPECIAL CHARACTERS 03080402 ! 312: C 03090402 ! 313: IVTNUM = 009 03100402 ! 314: IF (ICZERO) 30090, 0090, 30090 03110402 ! 315: 0090 CONTINUE 03120402 ! 316: CATN12(4) = 'A5+.Z' 03130402 ! 317: 0092 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H A5+.Z) 03140402 ! 318: WRITE (I02, 0092) IVTNUM, CATN12(4) 03150402 ! 319: GO TO 0101 03160402 ! 320: 30090 IVDELE = IVDELE + 1 03170402 ! 321: WRITE (I02, 80000) IVTNUM 03180402 ! 322: 0101 CONTINUE 03190402 ! 323: C 03200402 ! 324: C **** FCVS PROGRAM FM402 - TEST 010 **** 03210402 ! 325: C 03220402 ! 326: C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03230402 ! 327: C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES 03240402 ! 328: C 03250402 ! 329: IVTNUM = 010 03260402 ! 330: IF (ICZERO) 30100, 0100, 30100 03270402 ! 331: 0100 CONTINUE 03280402 ! 332: CATN12(5) = '1''A,4' 03290402 ! 333: 0102 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 1'A,4) 03300402 ! 334: WRITE (I02, 0102) IVTNUM, CATN12(5) 03310402 ! 335: GO TO 0111 03320402 ! 336: 30100 IVDELE = IVDELE + 1 03330402 ! 337: WRITE (I02, 80000) IVTNUM 03340402 ! 338: C 03350402 ! 339: 0111 CONTINUE 03360402 ! 340: C **** FCVS PROGRAM FM402 - TEST 11 **** 03370402 ! 341: C 03380402 ! 342: C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL 03390402 ! 343: C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION. 03400402 ! 344: C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH. 03410402 ! 345: C 03420402 ! 346: IVTNUM = 011 03430402 ! 347: IF (ICZERO) 30110, 0110, 30110 03440402 ! 348: 0110 CONTINUE 03450402 ! 349: 0112 FORMAT (1H ,4X,I5,17X,10A,5X,10H059=+PQUVY) 03460402 ! 350: WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10), 03470402 ! 351: 1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41), 03480402 ! 352: 2CATN11(42), CATN11(45) 03490402 ! 353: GO TO 0121 03500402 ! 354: 30110 IVDELE = IVDELE + 1 03510402 ! 355: WRITE (I02, 80000) IVTNUM 03520402 ! 356: 0121 CONTINUE 03530402 ! 357: C 03540402 ! 358: C **** FCVS PROGRAM FM402 - TEST 12 **** 03550402 ! 359: C 03560402 ! 360: C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED 03570402 ! 361: C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH 03580402 ! 362: C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM 03590402 ! 363: C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND 03600402 ! 364: C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER. 03610402 ! 365: C 03620402 ! 366: IVTNUM = 012 03630402 ! 367: IF (ICZERO) 30120, 0120, 30120 03640402 ! 368: 0120 CONTINUE 03650402 ! 369: CVTN13 = 'YZ' 03660402 ! 370: CVTN11 = ')' 03670402 ! 371: CATN12(2) = '(12AB' 03680402 ! 372: 0122 FORMAT (1H ,4X,I5,17X,1H*,3A,1H*,5X,10H*(12ABYZ)*) 03690402 ! 373: WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11 03700402 ! 374: GO TO 0131 03710402 ! 375: 30120 IVDELE = IVDELE + 1 03720402 ! 376: WRITE (I02, 80000) IVTNUM 03730402 ! 377: 0131 CONTINUE 03740402 ! 378: C 03750402 ! 379: C **** FCVS PROGRAM FM402 - TEST 13 *** 03760402 ! 380: C 03770402 ! 381: C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03780402 ! 382: C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03790402 ! 383: C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE 03800402 ! 384: C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS 03810402 ! 385: C FROM THE INTERNAL REPRESENTATION. 03820402 ! 386: C 03830402 ! 387: IVTNUM = 013 03840402 ! 388: IF (ICZERO) 30130, 0130, 30130 03850402 ! 389: 0130 CONTINUE 03860402 ! 390: CATN12(1) = 'ABMYZ' 03870402 ! 391: 0132 FORMAT (1H ,4X,I5,17X,A10,5X,10H ABMYZ) 03880402 ! 392: WRITE (I02, 0132) IVTNUM, CATN12(1) 03890402 ! 393: GO TO 0141 03900402 ! 394: 30130 IVDELE = IVDELE + 1 03910402 ! 395: WRITE (I02, 80000) IVTNUM 03920402 ! 396: 0141 CONTINUE 03930402 ! 397: C 03940402 ! 398: C **** FCVS PROGRAM FM402 - TEST 14 **** 03950402 ! 399: C 03960402 ! 400: C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03970402 ! 401: C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03980402 ! 402: C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT03990402 ! 403: C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL 04000402 ! 404: C REPRESENTATION. 04010402 ! 405: C 04020402 ! 406: IVTNUM = 014 04030402 ! 407: IF (ICZERO) 30140, 0140, 30140 04040402 ! 408: 0140 CONTINUE 04050402 ! 409: CVTN12 = '12345ABCDE' 04060402 ! 410: 0142 FORMAT (1H ,4X,I5,17X,5H ,A5,5X,10H 12345) 04070402 ! 411: WRITE (I02, 0142) IVTNUM, CVTN12 04080402 ! 412: GO TO 0151 04090402 ! 413: 30140 IVDELE = IVDELE + 1 04100402 ! 414: WRITE (I02, 80000) IVTNUM 04110402 ! 415: 0151 CONTINUE 04120402 ! 416: C 04130402 ! 417: C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE 04140402 ! 418: C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE 04150402 ! 419: C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN 04160402 ! 420: C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE: 04170402 ! 421: C 04180402 ! 422: C FILE IDENTIFIER - I09 (X-NUMBER 09) 04190402 ! 423: C RECORD SIZE - 80 CHARACTERS 04200402 ! 424: C ACCESS METHOD - SEQUENTIAL 04210402 ! 425: C RECORD TYPE - FORMATTED 04220402 ! 426: C DESIGNATED DEVICE - DISK 04230402 ! 427: C TYPE OF DATA - CHARACTER (A FORMAT) 04240402 ! 428: C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD 04250402 ! 429: C 04260402 ! 430: C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY 04270402 ! 431: C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD 04280402 ! 432: C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR. 04290402 ! 433: C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. 04300402 ! 434: C 04310402 ! 435: C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS 04320402 ! 436: C -------- ---- -- ------- --------- --------- 04330402 ! 437: C 04340402 ! 438: C IPROG (ROUTINE NAME) - 1 THRU 3 04350402 ! 439: C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 04360402 ! 440: C ITOTR (RECORDS IN FILE) - 6 THRU 9 04370402 ! 441: C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 04380402 ! 442: C IRECN (RECORD NUMBER) - 13 THRU 16 04390402 ! 443: C IEOF (9999 IF LAST RECORD) - 17 THRU 20 04400402 ! 444: C 04410402 ! 445: C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07 04420402 ! 446: I09 = 07 04430402 ! 447: OPEN(UNIT=I09,ACCESS='SEQUENTIAL',FORM='FORMATTED') 04440402 ! 448: CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 04450402 ! 449: IPROG = 402 04460402 ! 450: IFILE = I09 04470402 ! 451: ITOTR = 143 04480402 ! 452: IRLGN = 80 04490402 ! 453: IRECN = 0 04500402 ! 454: IEOF = 0 04510402 ! 455: C 04520402 ! 456: C 04530402 ! 457: C ***** CREATE-FILE SECTION ***** 04540402 ! 458: C 04550402 ! 459: C 04560402 ! 460: C **** FCVS PROGRAM 402 - TEST 015 **** 04570402 ! 461: C 04580402 ! 462: C 04590402 ! 463: C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE04600402 ! 464: C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE 04610402 ! 465: C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM 04620402 ! 466: C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH. 04630402 ! 467: C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE 04640402 ! 468: C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL04650402 ! 469: C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS). 04660402 ! 470: C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE. 04670402 ! 471: C 04680402 ! 472: C 04690402 ! 473: IVTNUM = 15 04700402 ! 474: IF (ICZERO) 30150, 0150, 30150 04710402 ! 475: 0150 CONTINUE 04720402 ! 476: 70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A) 04730402 ! 477: 70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A) 04740402 ! 478: IRECN = 0 04750402 ! 479: DO 4023 I=1,10 04760402 ! 480: IRECN = IRECN + 1 04770402 ! 481: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04780402 ! 482: 1 (CATN11 (J), J = 1,10) 04790402 ! 483: C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 04800402 ! 484: IRECN = IRECN + 1 04810402 ! 485: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04820402 ! 486: 1 (CATN11(J), J = 11,20) 04830402 ! 487: C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD. 04840402 ! 488: IRECN = IRECN + 1 04850402 ! 489: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04860402 ! 490: 1 (CATN11(J), J = 21,30) 04870402 ! 491: C CHARACTERS A THROUGH J ARE IN THIS RECORD 04880402 ! 492: IRECN = IRECN + 1 04890402 ! 493: WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04900402 ! 494: 1 (CATN11(J), J = 31,40) 04910402 ! 495: C CHARACTERS K THROUGH T ARE IN THIS RECORD 04920402 ! 496: IRECN = IRECN + 1 04930402 ! 497: WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04940402 ! 498: 1 (CATN11(J), J = 41,46) 04950402 ! 499: C CHARACTERS U THROUGH Z ARE IN THIS RECORD 04960402 ! 500: 4023 CONTINUE 04970402 ! 501: IVCOMP = IRECN 04980402 ! 502: IVCORR = 050 04990402 ! 503: IVON01 = 50 05000402 ! 504: 40150 IF (IVON01 - IRECN ) 20150, 10150, 20150 05010402 ! 505: C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN 05020402 ! 506: 30150 IVDELE = IVDELE + 1 05030402 ! 507: WRITE (I02,80000) IVTNUM 05040402 ! 508: IF (ICZERO) 10150, 0161, 20150 05050402 ! 509: 10150 IVPASS = IVPASS + 1 05060402 ! 510: WRITE (I02,80002) IVTNUM 05070402 ! 511: GO TO 0161 05080402 ! 512: 20150 IVFAIL = IVFAIL + 1 05090402 ! 513: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05100402 ! 514: 0161 CONTINUE 05110402 ! 515: C 05120402 ! 516: C **** FCVS PROGRAM 402 - TEST 016 **** 05130402 ! 517: C 05140402 ! 518: C 05150402 ! 519: C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS 05160402 ! 520: C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH05170402 ! 521: C SPECIFIED. 05180402 ! 522: C 05190402 ! 523: C 05200402 ! 524: IVTNUM = 16 05210402 ! 525: IF (ICZERO) 30160, 0160, 30160 05220402 ! 526: 0160 CONTINUE 05230402 ! 527: 70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1) 05240402 ! 528: 70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1) 05250402 ! 529: IRECN = 50 05260402 ! 530: DO 4024 I=1,10 05270402 ! 531: IRECN = IRECN + 1 05280402 ! 532: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290402 ! 533: 1 (CATN11(J), J = 1,10) 05300402 ! 534: C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 05310402 ! 535: IRECN = IRECN + 1 05320402 ! 536: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05330402 ! 537: 1 (CATN11(J), J = 11,20) 05340402 ! 538: C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD 05350402 ! 539: IRECN = IRECN + 1 05360402 ! 540: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05370402 ! 541: 1 (CATN11(J), J = 21,30) 05380402 ! 542: C CHARACTERS A THROUGH J ARE IN THIS RECORD 05390402 ! 543: IRECN = IRECN + 1 05400402 ! 544: WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05410402 ! 545: 1 (CATN11(J), J = 31,40) 05420402 ! 546: C CHARACTERS K THROUGH T ARE IN THIS RECORD 05430402 ! 547: IRECN = IRECN + 1 05440402 ! 548: WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05450402 ! 549: 1 (CATN11(J), J = 41,46) 05460402 ! 550: C CHARACTERS U THROUGH Z ARE IN THIS RECORD 05470402 ! 551: 4024 CONTINUE 05480402 ! 552: IVCOMP = IRECN - 50 05490402 ! 553: IVCORR = 50 05500402 ! 554: IVON01 = 100 05510402 ! 555: 40160 IF (IVON01 - IRECN) 20160, 10160, 20160 05520402 ! 556: 30160 IVDELE = IVDELE + 1 05530402 ! 557: WRITE (I02,80000) IVTNUM 05540402 ! 558: IF (ICZERO) 10160, 0171, 20160 05550402 ! 559: 10160 IVPASS = IVPASS + 1 05560402 ! 560: WRITE (I02,80002) IVTNUM 05570402 ! 561: GO TO 0171 05580402 ! 562: 20160 IVFAIL = IVFAIL + 1 05590402 ! 563: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05600402 ! 564: 0171 CONTINUE 05610402 ! 565: C 05620402 ! 566: C **** FCVS PROGRAM 402 - TEST 017 **** 05630402 ! 567: C 05640402 ! 568: C 05650402 ! 569: C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS 05660402 ! 570: C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS 05670402 ! 571: C FOLLOWING EXECUTION OF THIS TEST. 05680402 ! 572: C 05690402 ! 573: C 05700402 ! 574: IVTNUM = 17 05710402 ! 575: IF (ICZERO) 30170, 0170, 30170 05720402 ! 576: 0170 CONTINUE 05730402 ! 577: 70007 FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 05740402 ! 578: 1 ) 05750402 ! 579: 70008 FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 05760402 ! 580: 1 ) 05770402 ! 581: IRECN = 100 05780402 ! 582: DO 4025 I = 1,20 05790402 ! 583: IRECN = IRECN + 1 05800402 ! 584: WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05810402 ! 585: C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD 05820402 ! 586: IRECN = IRECN + 1 05830402 ! 587: WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05840402 ! 588: C SPECIAL CHARACTERS ARE IN THIS RECORD 05850402 ! 589: 4025 CONTINUE 05860402 ! 590: IVCOMP = IRECN - 100 05870402 ! 591: IVCORR = 40 05880402 ! 592: IVON01 = 140 05890402 ! 593: 40170 IF (IVON01 - IRECN) 20170, 10170, 20170 05900402 ! 594: 30170 IVDELE = IVDELE + 1 05910402 ! 595: WRITE (I02,80000) IVTNUM 05920402 ! 596: IF (ICZERO) 10170, 0181, 20170 05930402 ! 597: 10170 IVPASS = IVPASS + 1 05940402 ! 598: WRITE (I02,80002) IVTNUM 05950402 ! 599: GO TO 0181 05960402 ! 600: 20170 IVFAIL = IVFAIL + 1 05970402 ! 601: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980402 ! 602: 0181 CONTINUE 05990402 ! 603: C 06000402 ! 604: C **** FCVS PROGRAM 402 - TEST 018 **** 06010402 ! 605: C 06020402 ! 606: C 06030402 ! 607: C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR- 06040402 ! 608: C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD 06050402 ! 609: C WIDTH SPECIFICATION. 06060402 ! 610: C 06070402 ! 611: C 06080402 ! 612: IVTNUM = 18 06090402 ! 613: IF (ICZERO) 30180, 0180, 30180 06100402 ! 614: 0180 CONTINUE 06110402 ! 615: IRECN = 141 06120402 ! 616: 70009 FORMAT (I3,I2,I4,I3,2I4,10X,A) 06130402 ! 617: WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506140402 ! 618: IVCOMP = IRECN - 140 06150402 ! 619: IVCORR = 1 06160402 ! 620: IVON01 = 141 06170402 ! 621: 40180 IF (IVON01 - IRECN) 20180, 10180, 20180 06180402 ! 622: 30180 IVDELE = IVDELE + 1 06190402 ! 623: WRITE (I02,80000) IVTNUM 06200402 ! 624: IF (ICZERO) 10180, 0191, 20180 06210402 ! 625: 10180 IVPASS = IVPASS + 1 06220402 ! 626: WRITE (I02,80002) IVTNUM 06230402 ! 627: GO TO 0191 06240402 ! 628: 20180 IVFAIL = IVFAIL + 1 06250402 ! 629: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06260402 ! 630: 0191 CONTINUE 06270402 ! 631: C 06280402 ! 632: C **** FCVS PROGRAM 402 - TEST 019 **** 06290402 ! 633: C 06300402 ! 634: C 06310402 ! 635: C TEST 19 WRITES A LONG FIELD (50 CHARACTERS) 06320402 ! 636: C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH 06330402 ! 637: C SPECIFICATION. 06340402 ! 638: C 06350402 ! 639: C 06360402 ! 640: IVTNUM = 19 06370402 ! 641: IF (ICZERO) 30190, 0190, 30190 06380402 ! 642: 0190 CONTINUE 06390402 ! 643: IRECN = 142 06400402 ! 644: 70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50) 06410402 ! 645: WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506420402 ! 646: IVCOMP = IRECN - 141 06430402 ! 647: IVCORR = 1 06440402 ! 648: IVON01 = 142 06450402 ! 649: 40190 IF (IVON01 - IRECN) 20190, 10190, 20190 06460402 ! 650: 30190 IVDELE = IVDELE + 1 06470402 ! 651: WRITE (I02,80000) IVTNUM 06480402 ! 652: IF (ICZERO) 10190, 0201, 20190 06490402 ! 653: 10190 IVPASS = IVPASS + 1 06500402 ! 654: WRITE (I02,80002) IVTNUM 06510402 ! 655: GO TO 0201 06520402 ! 656: 20190 IVFAIL = IVFAIL + 1 06530402 ! 657: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06540402 ! 658: 0201 CONTINUE 06550402 ! 659: C 06560402 ! 660: C **** FCVS PROGRAM 402 - TEST 020 **** 06570402 ! 661: C 06580402 ! 662: C 06590402 ! 663: IVTNUM = 20 06600402 ! 664: IF (ICZERO) 30200, 0200, 30200 06610402 ! 665: 0200 CONTINUE 06620402 ! 666: IRECN = IRECN + 1 06630402 ! 667: IEOF = 9999 06640402 ! 668: 70011 FORMAT (I3,I2,I4,I3,2I4,59X,1H ) 06650402 ! 669: WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 06660402 ! 670: ENDFILE I09 06670402 ! 671: REWIND I09 06680402 ! 672: WRITE (I02, 90004) 06690402 ! 673: 70012 FORMAT (53H FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS) 06700402 ! 674: 70013 FORMAT (39H INCORRECT NUMBER OF RECORDS IN FILE - , I5 ,08H RECO06710402 ! 675: 1RDS) 06720402 ! 676: 70014 FORMAT (50H WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN.) 06730402 ! 677: IF (IRECN - 143) 4020, 4021, 4020 06740402 ! 678: 4020 WRITE (I02, 70013) IRECN 06750402 ! 679: WRITE (I02, 70014) 06760402 ! 680: GO TO 4022 06770402 ! 681: 4021 WRITE (I02, 70012) 06780402 ! 682: WRITE (I02, 90004) 06790402 ! 683: C 06800402 ! 684: C **** END-OF-CREATE-FILE SECTION **** 06810402 ! 685: C 06820402 ! 686: 4022 CONTINUE 06830402 ! 687: C 06840402 ! 688: C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE 06850402 ! 689: C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION. 06860402 ! 690: C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE 06870402 ! 691: C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE 06880402 ! 692: C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS 06890402 ! 693: C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06900402 ! 694: C 06910402 ! 695: C 06920402 ! 696: C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE 06930402 ! 697: C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE 06940402 ! 698: C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06950402 ! 699: C 06960402 ! 700: IVCOMP = 0 06970402 ! 701: IVCORR = 10 06980402 ! 702: 0202 FORMAT (70X,10A) 06990402 ! 703: READ (I09, 0202) (CATN14(J), J = 1,10) 07000402 ! 704: DO 0203 I=1,10 07010402 ! 705: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07020402 ! 706: 0203 CONTINUE 07030402 ! 707: 40200 IF (IVCOMP - 10) 20200, 10200, 20200 07040402 ! 708: 30200 IVDELE = IVDELE + 1 07050402 ! 709: WRITE (I02,80000) IVTNUM 07060402 ! 710: IF (ICZERO) 10200, 0211, 20200 07070402 ! 711: 10200 IVPASS = IVPASS + 1 07080402 ! 712: WRITE (I02,80002) IVTNUM 07090402 ! 713: GO TO 0211 07100402 ! 714: 20200 IVFAIL = IVFAIL + 1 07110402 ! 715: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07120402 ! 716: 0211 CONTINUE 07130402 ! 717: C 07140402 ! 718: C **** FCVS PROGRAM 402 - TEST 021 **** 07150402 ! 719: C 07160402 ! 720: C 07170402 ! 721: C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND07180402 ! 722: C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR 07190402 ! 723: C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF 07200402 ! 724: C THE READ. 07210402 ! 725: C 07220402 ! 726: C 07230402 ! 727: IVTNUM = 21 07240402 ! 728: IF (ICZERO) 30210, 0210, 30210 07250402 ! 729: 0210 CONTINUE 07260402 ! 730: IVCOMP = 0 07270402 ! 731: IVCORR = 10 07280402 ! 732: 0212 FORMAT (70X,10A) 07290402 ! 733: READ (I09, 0212) (CATN14(J), J = 11,20) 07300402 ! 734: DO 0213 I = 11,20 07310402 ! 735: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07320402 ! 736: 0213 CONTINUE 07330402 ! 737: 40210 IF (IVCOMP - 10) 20210, 10210, 20210 07340402 ! 738: 30210 IVDELE = IVDELE + 1 07350402 ! 739: WRITE (I02,80000) IVTNUM 07360402 ! 740: IF (ICZERO) 10210, 0221, 20210 07370402 ! 741: 10210 IVPASS = IVPASS + 1 07380402 ! 742: WRITE (I02,80002) IVTNUM 07390402 ! 743: GO TO 0221 07400402 ! 744: 20210 IVFAIL = IVFAIL + 1 07410402 ! 745: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07420402 ! 746: 0221 CONTINUE 07430402 ! 747: C 07440402 ! 748: C **** FCVS PROGRAM 402 - TEST 022 **** 07450402 ! 749: C 07460402 ! 750: C 07470402 ! 751: C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J. 07480402 ! 752: C 07490402 ! 753: C 07500402 ! 754: IVTNUM = 22 07510402 ! 755: IF (ICZERO) 30220, 0220, 30220 07520402 ! 756: 0220 CONTINUE 07530402 ! 757: IVCOMP = 0 07540402 ! 758: IVCORR = 10 07550402 ! 759: 0222 FORMAT (70X,10A) 07560402 ! 760: READ (I09, 0222) (CATN14(J), J = 21,30) 07570402 ! 761: DO 0223 I = 21,30 07580402 ! 762: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07590402 ! 763: 0223 CONTINUE 07600402 ! 764: 40220 IF (IVCOMP - 10) 20220, 10220, 20220 07610402 ! 765: 30220 IVDELE = IVDELE + 1 07620402 ! 766: WRITE (I02,80000) IVTNUM 07630402 ! 767: IF (ICZERO) 10220, 0231, 20220 07640402 ! 768: 10220 IVPASS = IVPASS + 1 07650402 ! 769: WRITE (I02,80002) IVTNUM 07660402 ! 770: GO TO 0231 07670402 ! 771: 20220 IVFAIL = IVFAIL + 1 07680402 ! 772: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07690402 ! 773: 0231 CONTINUE 07700402 ! 774: C 07710402 ! 775: C **** FCVS PROGRAM 402 - TEST 023 **** 07720402 ! 776: C 07730402 ! 777: C 07740402 ! 778: C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T. 07750402 ! 779: C 07760402 ! 780: C 07770402 ! 781: IVTNUM = 23 07780402 ! 782: IF (ICZERO) 30230, 0230, 30230 07790402 ! 783: 0230 CONTINUE 07800402 ! 784: IVCOMP = 0 07810402 ! 785: IVCORR = 10 07820402 ! 786: 0232 FORMAT (70X,10A) 07830402 ! 787: READ (I09, 0232) (CATN14(J), J = 31,40) 07840402 ! 788: DO 0233 I = 31,40 07850402 ! 789: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07860402 ! 790: 0233 CONTINUE 07870402 ! 791: 40230 IF (IVCOMP - 10) 20230, 10230, 20230 07880402 ! 792: 30230 IVDELE = IVDELE + 1 07890402 ! 793: WRITE (I02,80000) IVTNUM 07900402 ! 794: IF (ICZERO) 10230, 0241, 20230 07910402 ! 795: 10230 IVPASS = IVPASS + 1 07920402 ! 796: WRITE (I02,80002) IVTNUM 07930402 ! 797: GO TO 0241 07940402 ! 798: 20230 IVFAIL = IVFAIL + 1 07950402 ! 799: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07960402 ! 800: 0241 CONTINUE 07970402 ! 801: C 07980402 ! 802: C **** FCVS PROGRAM 402 - TEST 024 **** 07990402 ! 803: C 08000402 ! 804: C 08010402 ! 805: C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z. 08020402 ! 806: C 08030402 ! 807: C 08040402 ! 808: IVTNUM = 24 08050402 ! 809: IF (ICZERO) 30240, 0240, 30240 08060402 ! 810: 0240 CONTINUE 08070402 ! 811: IVCOMP = 0 08080402 ! 812: IVCORR = 06 08090402 ! 813: 0242 FORMAT (74X,6A) 08100402 ! 814: READ (I09, 0242) (CATN14(J), J = 41,46) 08110402 ! 815: DO 0243 I = 41,46 08120402 ! 816: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08130402 ! 817: 0243 CONTINUE 08140402 ! 818: 40240 IF (IVCOMP - 6) 20240, 10240, 20240 08150402 ! 819: 30240 IVDELE = IVDELE + 1 08160402 ! 820: WRITE (I02,80000) IVTNUM 08170402 ! 821: IF (ICZERO) 10240, 0251, 20240 08180402 ! 822: 10240 IVPASS = IVPASS + 1 08190402 ! 823: WRITE (I02,80002) IVTNUM 08200402 ! 824: GO TO 0251 08210402 ! 825: 20240 IVFAIL = IVFAIL + 1 08220402 ! 826: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08230402 ! 827: 0251 CONTINUE 08240402 ! 828: C 08250402 ! 829: C 08260402 ! 830: C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING 08270402 ! 831: C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED. 08280402 ! 832: C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER 08290402 ! 833: C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT 08300402 ! 834: C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND 08310402 ! 835: C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT 08320402 ! 836: C OF THE READ. 08330402 ! 837: C 08340402 ! 838: C 08350402 ! 839: 70020 FORMAT (12X,2I4,59X,A1) 08360402 ! 840: REWIND I09 08370402 ! 841: DO 4026 I = 1, 150 08380402 ! 842: READ (I09, 70020, END = 4027) IRECN, IEOF 08390402 ! 843: IF (IRECN .EQ. 55) GO TO 4027 08400402 ! 844: 4026 CONTINUE 08410402 ! 845: 4027 IF (IRECN - 55) 4028, 4029, 4028 08420402 ! 846: C 08430402 ! 847: C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD 08440402 ! 848: C NUMBER 55 FOR TESTS 25 THROUGH 29. 08450402 ! 849: C 08460402 ! 850: 70021 FORMAT (64H THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT 08470402 ! 851: 1BE FOUND,) 08480402 ! 852: 70022 FORMAT (49H THEREFORE TESTS 25 THROUGH 29 ARE DELETED.) 08490402 ! 853: 4028 WRITE (I02, 70021) 08500402 ! 854: WRITE (I02, 70022) 08510402 ! 855: GO TO 301 08520402 ! 856: 4029 CONTINUE 08530402 ! 857: DO 4030 I = 1,46 08540402 ! 858: CATN14(I) = ' ' 08550402 ! 859: 4030 CONTINUE 08560402 ! 860: C 08570402 ! 861: C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS. 08580402 ! 862: C 08590402 ! 863: C 08600402 ! 864: C **** FCVS PROGRAM 402 - TEST 025 **** 08610402 ! 865: C 08620402 ! 866: C 08630402 ! 867: C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. 08640402 ! 868: C 08650402 ! 869: C 08660402 ! 870: IVTNUM = 25 08670402 ! 871: IF (ICZERO) 30250, 0250, 30250 08680402 ! 872: 0250 CONTINUE 08690402 ! 873: IVCOMP = 0 08700402 ! 874: IVCORR = 10 08710402 ! 875: 0252 FORMAT (70X,10A1) 08720402 ! 876: READ (I09, 0252) (CATN14(J), J = 1, 10) 08730402 ! 877: DO 0253 I = 1,10 08740402 ! 878: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08750402 ! 879: 0253 CONTINUE 08760402 ! 880: 40250 IF (IVCOMP - 10) 20250, 10250, 20250 08770402 ! 881: 30250 IVDELE = IVDELE + 1 08780402 ! 882: WRITE (I02,80000) IVTNUM 08790402 ! 883: IF (ICZERO) 10250, 0261, 20250 08800402 ! 884: 10250 IVPASS = IVPASS + 1 08810402 ! 885: WRITE (I02,80002) IVTNUM 08820402 ! 886: GO TO 0261 08830402 ! 887: 20250 IVFAIL = IVFAIL + 1 08840402 ! 888: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08850402 ! 889: 0261 CONTINUE 08860402 ! 890: C 08870402 ! 891: C **** FCVS PROGRAM 402 - TEST 026 **** 08880402 ! 892: C 08890402 ! 893: C 08900402 ! 894: C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND08910402 ! 895: C '. 08920402 ! 896: C 08930402 ! 897: C 08940402 ! 898: IVTNUM = 26 08950402 ! 899: IF (ICZERO) 30260, 0260, 30260 08960402 ! 900: 0260 CONTINUE 08970402 ! 901: IVCOMP = 0 08980402 ! 902: IVCORR = 10 08990402 ! 903: 0262 FORMAT (70X,10A1) 09000402 ! 904: READ (I09, 0262) (CATN14(J), J = 11, 20) 09010402 ! 905: DO 0263 I = 11,20 09020402 ! 906: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09030402 ! 907: 0263 CONTINUE 09040402 ! 908: 40260 IF (IVCOMP -10) 20260, 10260, 20260 09050402 ! 909: 30260 IVDELE = IVDELE + 1 09060402 ! 910: WRITE (I02,80000) IVTNUM 09070402 ! 911: IF (ICZERO) 10260, 0271, 20260 09080402 ! 912: 10260 IVPASS = IVPASS + 1 09090402 ! 913: WRITE (I02,80002) IVTNUM 09100402 ! 914: GO TO 0271 09110402 ! 915: 20260 IVFAIL = IVFAIL + 1 09120402 ! 916: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09130402 ! 917: 0271 CONTINUE 09140402 ! 918: C 09150402 ! 919: C **** FCVS PROGRAM 402 - TEST 027 **** 09160402 ! 920: C 09170402 ! 921: C 09180402 ! 922: C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J. 09190402 ! 923: C 09200402 ! 924: C 09210402 ! 925: IVTNUM = 27 09220402 ! 926: IF (ICZERO) 30270, 0270, 30270 09230402 ! 927: 0270 CONTINUE 09240402 ! 928: IVCOMP = 0 09250402 ! 929: IVCORR = 10 09260402 ! 930: 0272 FORMAT (70X,10A1) 09270402 ! 931: READ (I09, 0272) (CATN14(J), J = 21,30) 09280402 ! 932: DO 0273 I = 21,30 09290402 ! 933: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09300402 ! 934: 0273 CONTINUE 09310402 ! 935: 40270 IF (IVCOMP - 10) 20270, 10270, 20270 09320402 ! 936: 30270 IVDELE = IVDELE + 1 09330402 ! 937: WRITE (I02,80000) IVTNUM 09340402 ! 938: IF (ICZERO) 10270, 0281, 20270 09350402 ! 939: 10270 IVPASS = IVPASS + 1 09360402 ! 940: WRITE (I02,80002) IVTNUM 09370402 ! 941: GO TO 0281 09380402 ! 942: 20270 IVFAIL = IVFAIL + 1 09390402 ! 943: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400402 ! 944: 0281 CONTINUE 09410402 ! 945: C 09420402 ! 946: C **** FCVS PROGRAM 402 - TEST 028 **** 09430402 ! 947: C 09440402 ! 948: C 09450402 ! 949: C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T. 09460402 ! 950: C 09470402 ! 951: C 09480402 ! 952: IVTNUM = 28 09490402 ! 953: IF (ICZERO) 30280, 0280, 30280 09500402 ! 954: 0280 CONTINUE 09510402 ! 955: IVCOMP = 0 09520402 ! 956: IVCORR = 10 09530402 ! 957: 0282 FORMAT (70X,10A1) 09540402 ! 958: READ (I09, 0282) (CATN14(J), J = 31,40) 09550402 ! 959: DO 0283 I = 31, 40 09560402 ! 960: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09570402 ! 961: 0283 CONTINUE 09580402 ! 962: 40280 IF (IVCOMP - 10) 20280, 10280, 20280 09590402 ! 963: 30280 IVDELE = IVDELE + 1 09600402 ! 964: WRITE (I02,80000) IVTNUM 09610402 ! 965: IF (ICZERO) 10280, 0291, 20280 09620402 ! 966: 10280 IVPASS = IVPASS + 1 09630402 ! 967: WRITE (I02,80002) IVTNUM 09640402 ! 968: GO TO 0291 09650402 ! 969: 20280 IVFAIL = IVFAIL + 1 09660402 ! 970: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09670402 ! 971: 0291 CONTINUE 09680402 ! 972: C 09690402 ! 973: C **** FCVS PROGRAM 402 - TEST 029 **** 09700402 ! 974: C 09710402 ! 975: C 09720402 ! 976: C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z. 09730402 ! 977: C 09740402 ! 978: C 09750402 ! 979: IVTNUM = 29 09760402 ! 980: IF (ICZERO) 30290, 0290, 30290 09770402 ! 981: 0290 CONTINUE 09780402 ! 982: IVCOMP = 0 09790402 ! 983: IVCORR = 6 09800402 ! 984: 0292 FORMAT (74X,6A1) 09810402 ! 985: READ (I09, 0292) (CATN14(J), J = 41,46) 09820402 ! 986: DO 0293 I = 41,46 09830402 ! 987: IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09840402 ! 988: 0293 CONTINUE 09850402 ! 989: 40290 IF (IVCOMP - 6) 20290, 10290, 20290 09860402 ! 990: 30290 IVDELE = IVDELE + 1 09870402 ! 991: WRITE (I02,80000) IVTNUM 09880402 ! 992: IF (ICZERO) 10290, 0301, 20290 09890402 ! 993: 10290 IVPASS = IVPASS + 1 09900402 ! 994: WRITE (I02,80002) IVTNUM 09910402 ! 995: GO TO 0301 09920402 ! 996: 20290 IVFAIL = IVFAIL + 1 09930402 ! 997: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09940402 ! 998: 0301 CONTINUE 09950402 ! 999: C 09960402 ! 1000: C 09970402 ! 1001: C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE09980402 ! 1002: C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD 09990402 ! 1003: C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES. 10000402 ! 1004: C 10010402 ! 1005: C 10020402 ! 1006: 70031 FORMAT (12X,2I4,59X,A1) 10030402 ! 1007: REWIND I09 10040402 ! 1008: DO 4031 I = 1,150 10050402 ! 1009: READ (I09, 70031, END = 4032) IRECN, IEOF 10060402 ! 1010: IF (IRECN .EQ. 100) GO TO 4032 10070402 ! 1011: 4031 CONTINUE 10080402 ! 1012: 4032 IF (IRECN - 100) 4033, 4034, 4033 10090402 ! 1013: 70032 FORMAT (64H THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT 10100402 ! 1014: 1BE FOUND,) 10110402 ! 1015: 70033 FORMAT (49H THEREFORE TESTS 30 THROUGH 32 ARE DELETED.) 10120402 ! 1016: 4033 WRITE (I02, 70032) 10130402 ! 1017: WRITE (I02, 70033) 10140402 ! 1018: GO TO 331 10150402 ! 1019: 4034 CONTINUE 10160402 ! 1020: C 10170402 ! 1021: C **** FCVS PROGRAM 402 - TEST 030 **** 10180402 ! 1022: C 10190402 ! 1023: C 10200402 ! 1024: C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT 10210402 ! 1025: C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL 10220402 ! 1026: C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE 10230402 ! 1027: C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS 10240402 ! 1028: C CREATED IN TEST 17 WITH THE FORMAT STATEMENT 10250402 ! 1029: C 10260402 ! 1030: C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 10270402 ! 1031: C 1 ) 10280402 ! 1032: C 10290402 ! 1033: C 10300402 ! 1034: IVTNUM = 30 10310402 ! 1035: IF (ICZERO) 30300, 0300, 30300 10320402 ! 1036: 0300 CONTINUE 10330402 ! 1037: IVCOMP = 1 10340402 ! 1038: IVCORR = 210 10350402 ! 1039: CATN14(1) = ' ' 10360402 ! 1040: CVTN13 = ' ' 10370402 ! 1041: CATN12(3) = ' ' 10380402 ! 1042: CVTN12 = ' ' 10390402 ! 1043: 0302 FORMAT (20X,4A,42X,A1) 10400402 ! 1044: READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN1210410402 ! 1045: 0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2 10420402 ! 1046: IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3 10430402 ! 1047: IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5 10440402 ! 1048: IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7 10450402 ! 1049: 40300 IF (IVCOMP - 210) 20300, 10300, 20300 10460402 ! 1050: 30300 IVDELE = IVDELE + 1 10470402 ! 1051: WRITE (I02,80000) IVTNUM 10480402 ! 1052: IF (ICZERO) 10300, 0311, 20300 10490402 ! 1053: 10300 IVPASS = IVPASS + 1 10500402 ! 1054: WRITE (I02,80002) IVTNUM 10510402 ! 1055: GO TO 0311 10520402 ! 1056: 20300 IVFAIL = IVFAIL + 1 10530402 ! 1057: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10540402 ! 1058: 0311 CONTINUE 10550402 ! 1059: C 10560402 ! 1060: C **** FCVS PROGRAM 402 - TEST 031 **** 10570402 ! 1061: C 10580402 ! 1062: C 10590402 ! 1063: C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN10600402 ! 1064: C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL 10610402 ! 1065: C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD 10620402 ! 1066: C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL 10630402 ! 1067: C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED 10640402 ! 1068: C IN TEST 17 WITH THE FORMAT STATEMENT 10650402 ! 1069: C 10660402 ! 1070: C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 10670402 ! 1071: C 1 ) 10680402 ! 1072: C 10690402 ! 1073: C 10700402 ! 1074: C 10710402 ! 1075: IVTNUM = 31 10720402 ! 1076: IF (ICZERO) 30310, 0310, 30310 10730402 ! 1077: 0310 CONTINUE 10740402 ! 1078: CVTN12 = '9999999999' 10750402 ! 1079: IVCOMP = 0 10760402 ! 1080: IVCORR = 1 10770402 ! 1081: 0312 FORMAT (20X,10X,A5,40X) 10780402 ! 1082: READ (I09, 0312, END = 0313) CVTN12 10790402 ! 1083: 0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1 10800402 ! 1084: 40310 IF (IVCOMP - 1) 20310, 10310, 20310 10810402 ! 1085: 30310 IVDELE = IVDELE + 1 10820402 ! 1086: WRITE (I02,80000) IVTNUM 10830402 ! 1087: IF (ICZERO) 10310, 0321, 20310 10840402 ! 1088: 10310 IVPASS = IVPASS + 1 10850402 ! 1089: WRITE (I02,80002) IVTNUM 10860402 ! 1090: GO TO 0321 10870402 ! 1091: 20310 IVFAIL = IVFAIL + 1 10880402 ! 1092: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10890402 ! 1093: 0321 CONTINUE 10900402 ! 1094: C 10910402 ! 1095: C **** FCVS PROGRAM 402 - TEST 032 **** 10920402 ! 1096: C 10930402 ! 1097: C 10940402 ! 1098: C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT 10950402 ! 1099: C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE 10960402 ! 1100: C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST 10970402 ! 1101: C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER 10980402 ! 1102: C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17 10990402 ! 1103: C WITH THE FORMAT STATEMENT 11000402 ! 1104: C 11010402 ! 1105: C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 11020402 ! 1106: C 1 ) 11030402 ! 1107: C 11040402 ! 1108: C 11050402 ! 1109: C 11060402 ! 1110: IVTNUM = 32 11070402 ! 1111: IF (ICZERO) 30320, 0320, 30320 11080402 ! 1112: 0320 CONTINUE 11090402 ! 1113: CATN12 (5) = 'AAAAA' 11100402 ! 1114: IVCOMP = 0 11110402 ! 1115: IVCORR = 1 11120402 ! 1116: 0322 FORMAT (20X,10X,A10,35X) 11130402 ! 1117: READ (I09, 0322, END = 0323) CATN12 (5) 11140402 ! 1118: 0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1 11150402 ! 1119: 40320 IF (IVCOMP - 1) 20320, 10320, 20320 11160402 ! 1120: 30320 IVDELE = IVDELE + 1 11170402 ! 1121: WRITE (I02,80000) IVTNUM 11180402 ! 1122: IF (ICZERO) 10320, 0331, 20320 11190402 ! 1123: 10320 IVPASS = IVPASS + 1 11200402 ! 1124: WRITE (I02,80002) IVTNUM 11210402 ! 1125: GO TO 0331 11220402 ! 1126: 20320 IVFAIL = IVFAIL + 1 11230402 ! 1127: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11240402 ! 1128: 0331 CONTINUE 11250402 ! 1129: C 11260402 ! 1130: C 11270402 ! 1131: C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND 11280402 ! 1132: C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ 11290402 ! 1133: C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD. 11300402 ! 1134: C 11310402 ! 1135: C 11320402 ! 1136: 70034 FORMAT (12X,2I4,60X) 11330402 ! 1137: REWIND I09 11340402 ! 1138: DO 4035 I = 1,150 11350402 ! 1139: READ (I09, 70034, END = 4036) IRECN, IEOF 11360402 ! 1140: IF (IRECN .EQ. 140) GO TO 4036 11370402 ! 1141: 4035 CONTINUE 11380402 ! 1142: 4036 IF (IRECN - 140) 4037, 4038, 4037 11390402 ! 1143: C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR 11400402 ! 1144: C TESTS 33 AND 34. 11410402 ! 1145: C 11420402 ! 1146: 70035 FORMAT (61H THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE 11430402 ! 1147: 1FOUND,) 11440402 ! 1148: 70036 FORMAT (45H THEREFORE TESTS 33 AND 34 ARE DELETED.) 11450402 ! 1149: 4037 WRITE (I02, 70035) 11460402 ! 1150: WRITE (I02, 70036) 11470402 ! 1151: GO TO 351 11480402 ! 1152: 4038 CONTINUE 11490402 ! 1153: C 11500402 ! 1154: C **** FCVS PROGRAM 402 - TEST 033 **** 11510402 ! 1155: C 11520402 ! 1156: C 11530402 ! 1157: C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A 11540402 ! 1158: C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS 11550402 ! 1159: C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF 11560402 ! 1160: C 11570402 ! 1161: C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11580402 ! 1162: C 11590402 ! 1163: C WITHOUT THE SURROUNDING APOSTROPHES. 11600402 ! 1164: C 11610402 ! 1165: C 11620402 ! 1166: C 11630402 ! 1167: IVTNUM = 33 11640402 ! 1168: IF (ICZERO) 30330, 0330, 30330 11650402 ! 1169: 0330 CONTINUE 11660402 ! 1170: CVTN15 = ' ' 11670402 ! 1171: IVCOMP = 0 11680402 ! 1172: IVCORR = 1 11690402 ! 1173: 0332 FORMAT (20X,10X,A50) 11700402 ! 1174: READ (I09, 0332) CVTN15 11710402 ! 1175: IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567811720402 ! 1176: 19') IVCOMP = 1 11730402 ! 1177: 40330 IF (IVCOMP -1 ) 20330, 10330, 20330 11740402 ! 1178: 30330 IVDELE = IVDELE + 1 11750402 ! 1179: WRITE (I02,80000) IVTNUM 11760402 ! 1180: IF (ICZERO) 10330, 0341, 20330 11770402 ! 1181: 10330 IVPASS = IVPASS + 1 11780402 ! 1182: WRITE (I02,80002) IVTNUM 11790402 ! 1183: GO TO 0341 11800402 ! 1184: 20330 IVFAIL = IVFAIL + 1 11810402 ! 1185: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11820402 ! 1186: 0341 CONTINUE 11830402 ! 1187: C 11840402 ! 1188: C **** FCVS PROGRAM 402 - TEST 034 **** 11850402 ! 1189: C 11860402 ! 1190: C 11870402 ! 1191: C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR 11880402 ! 1192: C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ. 11890402 ! 1193: C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA 11900402 ! 1194: C 11910402 ! 1195: C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11920402 ! 1196: C 11930402 ! 1197: C WITHOUT THE SURROUNDING APOSTROPHES. 11940402 ! 1198: C 11950402 ! 1199: C 11960402 ! 1200: IVTNUM = 34 11970402 ! 1201: IF (ICZERO) 30340, 0340, 30340 11980402 ! 1202: 0340 CONTINUE 11990402 ! 1203: CVTN15 = ' ' 12000402 ! 1204: IVCOMP = 0 12010402 ! 1205: IVCORR = 1 12020402 ! 1206: 0342 FORMAT (20X,10X,A) 12030402 ! 1207: READ (I09, 0342) CVTN15 12040402 ! 1208: IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567812050402 ! 1209: 19') IVCOMP = 1 12060402 ! 1210: 40340 IF (IVCOMP - 1) 20340, 10340, 20340 12070402 ! 1211: 30340 IVDELE = IVDELE + 1 12080402 ! 1212: WRITE (I02,80000) IVTNUM 12090402 ! 1213: IF (ICZERO) 10340, 0351, 20340 12100402 ! 1214: 10340 IVPASS = IVPASS + 1 12110402 ! 1215: WRITE (I02,80002) IVTNUM 12120402 ! 1216: GO TO 0351 12130402 ! 1217: 20340 IVFAIL = IVFAIL + 1 12140402 ! 1218: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12150402 ! 1219: 0351 CONTINUE 12160402 ! 1220: C 12170402 ! 1221: C 12180402 ! 1222: C 12190402 ! 1223: C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 12200402 ! 1224: C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 12210402 ! 1225: C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 12220402 ! 1226: C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED12230402 ! 1227: C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 12240402 ! 1228: C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 12250402 ! 1229: C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 12260402 ! 1230: C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 12270402 ! 1231: C REPORT AND BEFORE THE TEST REPORT SUMMARY. 12280402 ! 1232: C 12290402 ! 1233: CDB** BEGIN FILE DUMP CODE 12300402 ! 1234: C REWIND I09 12310402 ! 1235: C IRNUM = 1 12320402 ! 1236: C IRLGN = 80 12330402 ! 1237: C ILUN = I09 12340402 ! 1238: C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) 12350402 ! 1239: C7702 FORMAT (1H ,I3,I2,I4,I3,2I4,60A1) 12360402 ! 1240: C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK) 12370402 ! 1241: C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE , 12380402 ! 1242: C 1I3,9H RECORDS.) 12390402 ! 1243: C DO 7771 IRNUM = 1, ITOTR 12400402 ! 1244: C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12410402 ! 1245: C 1 (IDUMP(ICH), ICH = 1,60) 12420402 ! 1246: C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12430402 ! 1247: C 1 (IDUMP(ICH), ICH = 1,60) 12440402 ! 1248: C IF (IEOF .EQ. 9999) GO TO 7772 12450402 ! 1249: C7771 CONTINUE 12460402 ! 1250: C GO TO 7775 12470402 ! 1251: C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 12480402 ! 1252: C7773 WRITE (I02, 7703) ILUN, IRNUM 12490402 ! 1253: C GO TO 7779 12500402 ! 1254: C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12510402 ! 1255: C GO TO 7779 12520402 ! 1256: C7775 DO 7776 I = 1,20 12530402 ! 1257: C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12540402 ! 1258: C 1 (IDUMP(ICH), ICH = 1,60) 12550402 ! 1259: C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12560402 ! 1260: C 1 (IDUMP(ICH), ICH = 1,60) 12570402 ! 1261: C IRNUM = IRNUM + 1 12580402 ! 1262: C IF (IEOF .EQ. 9999) GO TO 7777 12590402 ! 1263: C7776 CONTINUE 12600402 ! 1264: C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12610402 ! 1265: C7779 CONTINUE 12620402 ! 1266: CDE** END OF DUMP CODE 12630402 ! 1267: C 12640402 ! 1268: C THERE SHOULD BE 34 TESTS IN THIS ROUTINE 12650402 ! 1269: C 12660402 ! 1270: C 12670402 ! 1271: C 12680402 ! 1272: C 12690402 ! 1273: C WRITE OUT TEST SUMMARY 12700402 ! 1274: C 12710402 ! 1275: WRITE (I02,90004) 12720402 ! 1276: WRITE (I02,90014) 12730402 ! 1277: WRITE (I02,90004) 12740402 ! 1278: WRITE (I02,90000) 12750402 ! 1279: WRITE (I02,90004) 12760402 ! 1280: WRITE (I02,90020) IVFAIL 12770402 ! 1281: WRITE (I02,90022) IVPASS 12780402 ! 1282: WRITE (I02,90024) IVDELE 12790402 ! 1283: STOP 12800402 ! 1284: 90001 FORMAT (1H ,24X,5HFM402) 12810402 ! 1285: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM402) 12820402 ! 1286: C 12830402 ! 1287: C FORMATS FOR TEST DETAIL LINES 12840402 ! 1288: C 12850402 ! 1289: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 12860402 ! 1290: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 12870402 ! 1291: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 12880402 ! 1292: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 12890402 ! 1293: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 12900402 ! 1294: C 12910402 ! 1295: C FORMAT STATEMENTS FOR PAGE HEADERS 12920402 ! 1296: C 12930402 ! 1297: 90002 FORMAT (1H1) 12940402 ! 1298: 90004 FORMAT (1H ) 12950402 ! 1299: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 12960402 ! 1300: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 12970402 ! 1301: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 12980402 ! 1302: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 12990402 ! 1303: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 13000402 ! 1304: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 13010402 ! 1305: C 13020402 ! 1306: C FORMAT STATEMENTS FOR RUN SUMMARY 13030402 ! 1307: C 13040402 ! 1308: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 13050402 ! 1309: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 13060402 ! 1310: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 13070402 ! 1311: END 13080402
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.