PROGRAM FM402 00010402 C 00020402 C 00030402 C 00040402 C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS)00050402 C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT 00060402 C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/ 00070402 C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI- 00080402 C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC- 00090402 C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES- 00100402 C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF 00110402 C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST 00120402 C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING00130402 C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF 00140402 C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL 00150402 C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER 00160402 C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT 00170402 C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT. 00180402 C 00190402 C THIS ROUTINE TESTS FOR PROPER EDITING BY 00200402 C 00210402 C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT00220402 C AND OUTPUT, 00230402 C 00240402 C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00250402 C LIST ITEM IS LESS THAN THE WIDTH W, 00260402 C 00270402 C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00280402 C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W, 00290402 C 00300402 C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT 00310402 C SPECIFICATION. 00320402 C 00330402 C REFERENCES - 00340402 C 00350402 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360402 C X3.9-1978 00370402 C 00380402 C SECTION 3.1, FORTRAN CHARACTER SET 00390402 C SECTION 4.8, CHARACTER TYPE 00400402 C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00410402 C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00420402 C SECTION 13.5.11, A EDITING 00430402 C 00440402 C 00450402 C 00460402 C 00470402 C ******************************************************************00480402 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00490402 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00500402 C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00510402 C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00520402 C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00530402 C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00540402 C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00550402 C THE RESULT OF EXECUTING THESE TESTS. 00560402 C 00570402 C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00580402 C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00590402 C 00600402 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00610402 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00620402 C SOFTWARE STANDARDS VALIDATION GROUP 00630402 C BUILDING 225 RM A266 00640402 C GAITHERSBURG, MD 20899 00650402 C ******************************************************************00660402 C 00670402 C 00680402 IMPLICIT LOGICAL (L) 00690402 IMPLICIT CHARACTER*14 (C) 00700402 C 00710402 DIMENSION IDUMP (80) 00720402 DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46) 00730402 CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1 00740402 CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50 00750402 CHARACTER CVTN01*1 00760402 00770402 DATA CATN14 /46*' '/ 00780402 DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/00790402 DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00800402 1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C', 00810402 2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 00820402 3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/ 00830402 DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/ 00840402 00850402 C 00860402 C 00870402 C 00880402 C INITIALIZATION SECTION. 00890402 C 00900402 C INITIALIZE CONSTANTS 00910402 C ******************** 00920402 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00930402 I01 = 5 00940402 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00950402 I02 = 6 00960402 C SYSTEM ENVIRONMENT SECTION 00970402 C 00980402 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00990402 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000402 C (UNIT NUMBER FOR CARD READER). 01010402 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01020402 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030402 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040402 C 01050402 CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01060402 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070402 C (UNIT NUMBER FOR PRINTER). 01080402 CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01090402 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100402 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110402 C 01120402 IVPASS = 0 01130402 IVFAIL = 0 01140402 IVDELE = 0 01150402 ICZERO = 0 01160402 C 01170402 C WRITE OUT PAGE HEADERS 01180402 C 01190402 WRITE (I02,90002) 01200402 WRITE (I02,90006) 01210402 WRITE (I02,90008) 01220402 WRITE (I02,90004) 01230402 WRITE (I02,90010) 01240402 WRITE (I02,90004) 01250402 WRITE (I02,90016) 01260402 WRITE (I02,90001) 01270402 WRITE (I02,90004) 01280402 WRITE (I02,90012) 01290402 WRITE (I02,90014) 01300402 WRITE (I02,90004) 01310402 C 01320402 C 01330402 C 01340402 C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER 01350402 C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS 01360402 C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE 01370402 C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD 01380402 C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR 01390402 C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A 01400402 C EDITING 01410402 C 01420402 C 01430402 80052 FORMAT (" ",4X, "TESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED.01440402 1") 01450402 80054 FORMAT (" ", "IMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE01460402 1 LINE") 01470402 80056 FORMAT (" ", "OF THE FORM '123456 ...'. THE REFERENCE LINE IS T01480402 1O") 01490402 80058 FORMAT (" ","AID IN THE VISUAL VERIFICATION OF THE TESTS. FOR" ) 01500402 80062 FORMAT (" ","THE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED" 01510402 1) 01520402 80064 FORMAT (" ", "IN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE01530402 1CT ") 01540402 80066 FORMAT (" ","COLUMN IN BOTH VALUE AND CHARACTER POSITION." ) 01550402 80072 FORMAT (" ","REFERENCE LINE - " ,"1234567890" ,5X, "123401560402 1567890") 01570402 WRITE (I02,80052) 01580402 WRITE (I02,80054) 01590402 WRITE (I02,80056) 01600402 WRITE (I02,80058) 01610402 WRITE (I02,80062) 01620402 WRITE (I02,80064) 01630402 WRITE (I02,80066) 01640402 WRITE (I02,90004) 01650402 WRITE (I02,80072) 01660402 C 01670402 C **** FCVS PROGRAM 402 - TEST 001 **** 01680402 C 01690402 C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 01700402 C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE 01710402 C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A 01720402 C VARIABLE. 01730402 C 01740402 IVTNUM = 001 01750402 IF (ICZERO) 30010, 0010, 30010 01760402 0010 CONTINUE 01770402 CVTN01 = 'A' 01780402 0012 FORMAT (" ",4X,I5,26X,A,14X,"A") 01790402 WRITE (I02, 0012) IVTNUM, CVTN01 01800402 GO TO 0021 01810402 30010 IVDELE = IVDELE + 1 01820402 WRITE (I02,80000) IVTNUM 01830402 0021 CONTINUE 01840402 C 01850402 C **** FCVS PROGRAM 402 - TEST 002 **** 01860402 C 01870402 C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST 01880402 C ITEM IS AN ARRAY ELEMENT. 01890402 C 01900402 IVTNUM = 002 01910402 IF (ICZERO) 30020, 0020, 30020 01920402 0020 CONTINUE 01930402 CATN31 (1,2,1) = 'Z' 01940402 0022 FORMAT (" ",4X,I5,26X,A,14X,"Z") 01950402 WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1) 01960402 GO TO 0031 01970402 30020 IVDELE = IVDELE + 1 01980402 WRITE (I02,80000) IVTNUM 01990402 0031 CONTINUE 02000402 C 02010402 C *** FCVS PROGRAM 402 - TEST 003 **** 02020402 C 02030402 C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE 02040402 C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE 02050402 C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED 02060402 C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH. 02070402 C 02080402 IVTNUM = 003 02090402 IF (ICZERO) 30030, 0030, 30030 02100402 0030 CONTINUE 02110402 CVTN11 = '/' 02120402 0032 FORMAT (" ",4X,I5,26X,A,14X,"/") 02130402 WRITE (I02, 0032) IVTNUM, CVTN11 02140402 GO TO 0041 02150402 30030 IVDELE = IVDELE + 1 02160402 WRITE (I02, 80000) IVTNUM 02170402 0041 CONTINUE 02180402 C 02190402 C *** FCVS PROGRAM 402 - TEST 004 *** 02200402 C 02210402 C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING 02220402 C EDITED IS NUMERIC. 02230402 C 02240402 IVTNUM = 004 02250402 IF (ICZERO) 30040, 0040, 30040 02260402 0040 CONTINUE 02270402 CVTN11 = '9' 02280402 0042 FORMAT (" ",4X,I5,26X,A,14X,"9") 02290402 WRITE (I02, 0042) IVTNUM, CVTN11 02300402 GO TO 0051 02310402 30040 IVDELE = IVDELE + 1 02320402 WRITE (I02, 80000) IVTNUM 02330402 0051 CONTINUE 02340402 C 02350402 C *** FCVS PROGRAM 402 - TEST 005 *** 02360402 C 02370402 C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL02380402 C CHARACTER QUOTE. 02390402 C 02400402 IVTNUM = 005 02410402 IF (ICZERO) 30050, 0050, 30050 02420402 0050 CONTINUE 02430402 CVTN11 = '''' 02440402 0052 FORMAT (" ",4X,I5,26X,A,14X,"'") 02450402 WRITE (I02, 0052) IVTNUM, CVTN11 02460402 GO TO 0061 02470402 30050 IVDELE = IVDELE + 1 02480402 WRITE (I02, 80000) IVTNUM 02490402 C 02500402 C 02510402 C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR 02520402 C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE 02530402 C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH. 02540402 C 02550402 C 02560402 0061 CONTINUE 02570402 C 02580402 C **** FCVS PROGRAM 402 - TEST 006 **** 02590402 C 02600402 C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS 02610402 C 02620402 IVTNUM = 006 02630402 IF (ICZERO) 30060, 0060, 30060 02640402 0060 CONTINUE 02650402 CATN12(1) = 'ABMYZ' 02660402 0062 FORMAT(" ",4X,I5,17X," ",A,5X," ABMYZ" ) 02670402 WRITE (I02, 0062) IVTNUM, CATN12(1) 02680402 GO TO 0071 02690402 30060 IVDELE = IVDELE + 1 02700402 WRITE (I02, 80000) IVTNUM 02710402 0071 CONTINUE 02720402 C 02730402 C **** FCVS PROGRAM 402 - TEST 007 **** 02740402 C 02750402 C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS 02760402 C 02770402 IVTNUM = 007 02780402 IF (ICZERO) 30070, 0070, 30070 02790402 0070 CONTINUE 02800402 CATN12(2) = '01589' 02810402 0072 FORMAT(" ",4X,I5,17X," ",A,5X," 01589" ) 02820402 WRITE (I02, 0072) IVTNUM, CATN12(2) 02830402 GO TO 0081 02840402 30070 IVDELE = IVDELE + 1 02850402 WRITE (I02, 80000) IVTNUM 02860402 0081 CONTINUE 02870402 C 02880402 C **** FCVS PROGRAM 402 - TEST 008 **** 02890402 C 02900402 C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL 02910402 C CHARACTERS. 02920402 C 02930402 IVTNUM = 008 02940402 IF (ICZERO) 30080, 0080, 30080 02950402 0080 CONTINUE 02960402 CATN12(3) = '=+-()' 02970402 0082 FORMAT(" ",4X,I5,17X," ",A,5X," =+-()" ) 02980402 WRITE (I02, 0082) IVTNUM, CATN12(3) 02990402 GO TO 0091 03000402 30080 IVDELE = IVDELE + 1 03010402 WRITE (I02, 80000) IVTNUM 03020402 0091 CONTINUE 03030402 C 03040402 C **** FCVS PROGRAM FM402 - TEST 009 **** 03050402 C 03060402 C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03070402 C OF LETTERS, DIGITS AND SPECIAL CHARACTERS 03080402 C 03090402 IVTNUM = 009 03100402 IF (ICZERO) 30090, 0090, 30090 03110402 0090 CONTINUE 03120402 CATN12(4) = 'A5+.Z' 03130402 0092 FORMAT(" ",4X,I5,17X," ",A,5X," A5+.Z" ) 03140402 WRITE (I02, 0092) IVTNUM, CATN12(4) 03150402 GO TO 0101 03160402 30090 IVDELE = IVDELE + 1 03170402 WRITE (I02, 80000) IVTNUM 03180402 0101 CONTINUE 03190402 C 03200402 C **** FCVS PROGRAM FM402 - TEST 010 **** 03210402 C 03220402 C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03230402 C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES 03240402 C 03250402 IVTNUM = 010 03260402 IF (ICZERO) 30100, 0100, 30100 03270402 0100 CONTINUE 03280402 CATN12(5) = '1''A,4' 03290402 0102 FORMAT(" ",4X,I5,17X," ",A,5X," 1'A,4" ) 03300402 WRITE (I02, 0102) IVTNUM, CATN12(5) 03310402 GO TO 0111 03320402 30100 IVDELE = IVDELE + 1 03330402 WRITE (I02, 80000) IVTNUM 03340402 C 03350402 0111 CONTINUE 03360402 C **** FCVS PROGRAM FM402 - TEST 11 **** 03370402 C 03380402 C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL 03390402 C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION. 03400402 C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH. 03410402 C 03420402 IVTNUM = 011 03430402 IF (ICZERO) 30110, 0110, 30110 03440402 0110 CONTINUE 03450402 0112 FORMAT (" ",4X,I5,17X,10A,5X,"059=+PQUVY" ) 03460402 WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10), 03470402 1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41), 03480402 2CATN11(42), CATN11(45) 03490402 GO TO 0121 03500402 30110 IVDELE = IVDELE + 1 03510402 WRITE (I02, 80000) IVTNUM 03520402 0121 CONTINUE 03530402 C 03540402 C **** FCVS PROGRAM FM402 - TEST 12 **** 03550402 C 03560402 C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED 03570402 C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH 03580402 C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM 03590402 C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND 03600402 C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER. 03610402 C 03620402 IVTNUM = 012 03630402 IF (ICZERO) 30120, 0120, 30120 03640402 0120 CONTINUE 03650402 CVTN13 = 'YZ' 03660402 CVTN11 = ')' 03670402 CATN12(2) = '(12AB' 03680402 0122 FORMAT (" ",4X,I5,17X,"*",3A,"*",5X,"*(12ABYZ)*" ) 03690402 WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11 03700402 GO TO 0131 03710402 30120 IVDELE = IVDELE + 1 03720402 WRITE (I02, 80000) IVTNUM 03730402 0131 CONTINUE 03740402 C 03750402 C **** FCVS PROGRAM FM402 - TEST 13 *** 03760402 C 03770402 C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03780402 C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03790402 C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE 03800402 C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS 03810402 C FROM THE INTERNAL REPRESENTATION. 03820402 C 03830402 IVTNUM = 013 03840402 IF (ICZERO) 30130, 0130, 30130 03850402 0130 CONTINUE 03860402 CATN12(1) = 'ABMYZ' 03870402 0132 FORMAT (" ",4X,I5,17X,A10,5X," ABMYZ" ) 03880402 WRITE (I02, 0132) IVTNUM, CATN12(1) 03890402 GO TO 0141 03900402 30130 IVDELE = IVDELE + 1 03910402 WRITE (I02, 80000) IVTNUM 03920402 0141 CONTINUE 03930402 C 03940402 C **** FCVS PROGRAM FM402 - TEST 14 **** 03950402 C 03960402 C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03970402 C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03980402 C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT03990402 C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL 04000402 C REPRESENTATION. 04010402 C 04020402 IVTNUM = 014 04030402 IF (ICZERO) 30140, 0140, 30140 04040402 0140 CONTINUE 04050402 CVTN12 = '12345ABCDE' 04060402 0142 FORMAT (" ",4X,I5,17X," ",A5,5X," 12345" ) 04070402 WRITE (I02, 0142) IVTNUM, CVTN12 04080402 GO TO 0151 04090402 30140 IVDELE = IVDELE + 1 04100402 WRITE (I02, 80000) IVTNUM 04110402 0151 CONTINUE 04120402 C 04130402 C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE 04140402 C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE 04150402 C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN 04160402 C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE: 04170402 C 04180402 C FILE IDENTIFIER - I09 (X-NUMBER 09) 04190402 C RECORD SIZE - 80 CHARACTERS 04200402 C ACCESS METHOD - SEQUENTIAL 04210402 C RECORD TYPE - FORMATTED 04220402 C DESIGNATED DEVICE - DISK 04230402 C TYPE OF DATA - CHARACTER (A FORMAT) 04240402 C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD 04250402 C 04260402 C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY 04270402 C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD 04280402 C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR. 04290402 C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. 04300402 C 04310402 C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS 04320402 C -------- ---- -- ------- --------- --------- 04330402 C 04340402 C IPROG (ROUTINE NAME) - 1 THRU 3 04350402 C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 04360402 C ITOTR (RECORDS IN FILE) - 6 THRU 9 04370402 C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 04380402 C IRECN (RECORD NUMBER) - 13 THRU 16 04390402 C IEOF (9999 IF LAST RECORD) - 17 THRU 20 04400402 C 04410402 C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07 04420402 I09 = 07 04430402 CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090 04440402 CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 04450402 IPROG = 402 04460402 IFILE = I09 04470402 ITOTR = 143 04480402 IRLGN = 80 04490402 IRECN = 0 04500402 IEOF = 0 04510402 C 04520402 C 04530402 C ***** CREATE-FILE SECTION ***** 04540402 C 04550402 C 04560402 C **** FCVS PROGRAM 402 - TEST 015 **** 04570402 C 04580402 C 04590402 C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE04600402 C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE 04610402 C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM 04620402 C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH. 04630402 C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE 04640402 C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL04650402 C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS). 04660402 C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE. 04670402 C 04680402 C 04690402 IVTNUM = 15 04700402 IF (ICZERO) 30150, 0150, 30150 04710402 0150 CONTINUE 04720402 70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A) 04730402 70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A) 04740402 IRECN = 0 04750402 DO 4023 I=1,10 04760402 IRECN = IRECN + 1 04770402 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04780402 1 (CATN11 (J), J = 1,10) 04790402 C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 04800402 IRECN = IRECN + 1 04810402 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04820402 1 (CATN11(J), J = 11,20) 04830402 C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD. 04840402 IRECN = IRECN + 1 04850402 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04860402 1 (CATN11(J), J = 21,30) 04870402 C CHARACTERS A THROUGH J ARE IN THIS RECORD 04880402 IRECN = IRECN + 1 04890402 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04900402 1 (CATN11(J), J = 31,40) 04910402 C CHARACTERS K THROUGH T ARE IN THIS RECORD 04920402 IRECN = IRECN + 1 04930402 WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04940402 1 (CATN11(J), J = 41,46) 04950402 C CHARACTERS U THROUGH Z ARE IN THIS RECORD 04960402 4023 CONTINUE 04970402 IVCOMP = IRECN 04980402 IVCORR = 050 04990402 IVON01 = 50 05000402 40150 IF (IVON01 - IRECN ) 20150, 10150, 20150 05010402 C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN 05020402 30150 IVDELE = IVDELE + 1 05030402 WRITE (I02,80000) IVTNUM 05040402 IF (ICZERO) 10150, 0161, 20150 05050402 10150 IVPASS = IVPASS + 1 05060402 WRITE (I02,80002) IVTNUM 05070402 GO TO 0161 05080402 20150 IVFAIL = IVFAIL + 1 05090402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05100402 0161 CONTINUE 05110402 C 05120402 C **** FCVS PROGRAM 402 - TEST 016 **** 05130402 C 05140402 C 05150402 C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS 05160402 C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH05170402 C SPECIFIED. 05180402 C 05190402 C 05200402 IVTNUM = 16 05210402 IF (ICZERO) 30160, 0160, 30160 05220402 0160 CONTINUE 05230402 70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1) 05240402 70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1) 05250402 IRECN = 50 05260402 DO 4024 I=1,10 05270402 IRECN = IRECN + 1 05280402 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290402 1 (CATN11(J), J = 1,10) 05300402 C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 05310402 IRECN = IRECN + 1 05320402 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05330402 1 (CATN11(J), J = 11,20) 05340402 C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD 05350402 IRECN = IRECN + 1 05360402 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05370402 1 (CATN11(J), J = 21,30) 05380402 C CHARACTERS A THROUGH J ARE IN THIS RECORD 05390402 IRECN = IRECN + 1 05400402 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05410402 1 (CATN11(J), J = 31,40) 05420402 C CHARACTERS K THROUGH T ARE IN THIS RECORD 05430402 IRECN = IRECN + 1 05440402 WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05450402 1 (CATN11(J), J = 41,46) 05460402 C CHARACTERS U THROUGH Z ARE IN THIS RECORD 05470402 4024 CONTINUE 05480402 IVCOMP = IRECN - 50 05490402 IVCORR = 50 05500402 IVON01 = 100 05510402 40160 IF (IVON01 - IRECN) 20160, 10160, 20160 05520402 30160 IVDELE = IVDELE + 1 05530402 WRITE (I02,80000) IVTNUM 05540402 IF (ICZERO) 10160, 0171, 20160 05550402 10160 IVPASS = IVPASS + 1 05560402 WRITE (I02,80002) IVTNUM 05570402 GO TO 0171 05580402 20160 IVFAIL = IVFAIL + 1 05590402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05600402 0171 CONTINUE 05610402 C 05620402 C **** FCVS PROGRAM 402 - TEST 017 **** 05630402 C 05640402 C 05650402 C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS 05660402 C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS 05670402 C FOLLOWING EXECUTION OF THIS TEST. 05680402 C 05690402 C 05700402 IVTNUM = 17 05710402 IF (ICZERO) 30170, 0170, 30170 05720402 0170 CONTINUE 05730402 70007 FORMAT (I3,I2,I4,I3,2I4, "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 05740402 1 ") 05750402 70008 FORMAT (I3,I2,I4,I3,2I4, "=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 05760402 1 ") 05770402 IRECN = 100 05780402 DO 4025 I = 1,20 05790402 IRECN = IRECN + 1 05800402 WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05810402 C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD 05820402 IRECN = IRECN + 1 05830402 WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05840402 C SPECIAL CHARACTERS ARE IN THIS RECORD 05850402 4025 CONTINUE 05860402 IVCOMP = IRECN - 100 05870402 IVCORR = 40 05880402 IVON01 = 140 05890402 40170 IF (IVON01 - IRECN) 20170, 10170, 20170 05900402 30170 IVDELE = IVDELE + 1 05910402 WRITE (I02,80000) IVTNUM 05920402 IF (ICZERO) 10170, 0181, 20170 05930402 10170 IVPASS = IVPASS + 1 05940402 WRITE (I02,80002) IVTNUM 05950402 GO TO 0181 05960402 20170 IVFAIL = IVFAIL + 1 05970402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980402 0181 CONTINUE 05990402 C 06000402 C **** FCVS PROGRAM 402 - TEST 018 **** 06010402 C 06020402 C 06030402 C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR- 06040402 C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD 06050402 C WIDTH SPECIFICATION. 06060402 C 06070402 C 06080402 IVTNUM = 18 06090402 IF (ICZERO) 30180, 0180, 30180 06100402 0180 CONTINUE 06110402 IRECN = 141 06120402 70009 FORMAT (I3,I2,I4,I3,2I4,10X,A) 06130402 WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506140402 IVCOMP = IRECN - 140 06150402 IVCORR = 1 06160402 IVON01 = 141 06170402 40180 IF (IVON01 - IRECN) 20180, 10180, 20180 06180402 30180 IVDELE = IVDELE + 1 06190402 WRITE (I02,80000) IVTNUM 06200402 IF (ICZERO) 10180, 0191, 20180 06210402 10180 IVPASS = IVPASS + 1 06220402 WRITE (I02,80002) IVTNUM 06230402 GO TO 0191 06240402 20180 IVFAIL = IVFAIL + 1 06250402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06260402 0191 CONTINUE 06270402 C 06280402 C **** FCVS PROGRAM 402 - TEST 019 **** 06290402 C 06300402 C 06310402 C TEST 19 WRITES A LONG FIELD (50 CHARACTERS) 06320402 C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH 06330402 C SPECIFICATION. 06340402 C 06350402 C 06360402 IVTNUM = 19 06370402 IF (ICZERO) 30190, 0190, 30190 06380402 0190 CONTINUE 06390402 IRECN = 142 06400402 70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50) 06410402 WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506420402 IVCOMP = IRECN - 141 06430402 IVCORR = 1 06440402 IVON01 = 142 06450402 40190 IF (IVON01 - IRECN) 20190, 10190, 20190 06460402 30190 IVDELE = IVDELE + 1 06470402 WRITE (I02,80000) IVTNUM 06480402 IF (ICZERO) 10190, 0201, 20190 06490402 10190 IVPASS = IVPASS + 1 06500402 WRITE (I02,80002) IVTNUM 06510402 GO TO 0201 06520402 20190 IVFAIL = IVFAIL + 1 06530402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06540402 0201 CONTINUE 06550402 C 06560402 C **** FCVS PROGRAM 402 - TEST 020 **** 06570402 C 06580402 C 06590402 IVTNUM = 20 06600402 IF (ICZERO) 30200, 0200, 30200 06610402 0200 CONTINUE 06620402 IRECN = IRECN + 1 06630402 IEOF = 9999 06640402 70011 FORMAT (I3,I2,I4,I3,2I4,59X," ") 06650402 WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 06660402 ENDFILE I09 06670402 REWIND I09 06680402 WRITE (I02, 90004) 06690402 70012 FORMAT (" FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS" ) 06700402 70013 FORMAT (" INCORRECT NUMBER OF RECORDS IN FILE - " , I5 , " RECO06710402 1RDS") 06720402 70014 FORMAT (" WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN." ) 06730402 IF (IRECN - 143) 4020, 4021, 4020 06740402 4020 WRITE (I02, 70013) IRECN 06750402 WRITE (I02, 70014) 06760402 GO TO 4022 06770402 4021 WRITE (I02, 70012) 06780402 WRITE (I02, 90004) 06790402 C 06800402 C **** END-OF-CREATE-FILE SECTION **** 06810402 C 06820402 4022 CONTINUE 06830402 C 06840402 C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE 06850402 C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION. 06860402 C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE 06870402 C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE 06880402 C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS 06890402 C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06900402 C 06910402 C 06920402 C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE 06930402 C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE 06940402 C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06950402 C 06960402 IVCOMP = 0 06970402 IVCORR = 10 06980402 0202 FORMAT (70X,10A) 06990402 READ (I09, 0202) (CATN14(J), J = 1,10) 07000402 DO 0203 I=1,10 07010402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07020402 0203 CONTINUE 07030402 40200 IF (IVCOMP - 10) 20200, 10200, 20200 07040402 30200 IVDELE = IVDELE + 1 07050402 WRITE (I02,80000) IVTNUM 07060402 IF (ICZERO) 10200, 0211, 20200 07070402 10200 IVPASS = IVPASS + 1 07080402 WRITE (I02,80002) IVTNUM 07090402 GO TO 0211 07100402 20200 IVFAIL = IVFAIL + 1 07110402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07120402 0211 CONTINUE 07130402 C 07140402 C **** FCVS PROGRAM 402 - TEST 021 **** 07150402 C 07160402 C 07170402 C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND07180402 C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR 07190402 C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF 07200402 C THE READ. 07210402 C 07220402 C 07230402 IVTNUM = 21 07240402 IF (ICZERO) 30210, 0210, 30210 07250402 0210 CONTINUE 07260402 IVCOMP = 0 07270402 IVCORR = 10 07280402 0212 FORMAT (70X,10A) 07290402 READ (I09, 0212) (CATN14(J), J = 11,20) 07300402 DO 0213 I = 11,20 07310402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07320402 0213 CONTINUE 07330402 40210 IF (IVCOMP - 10) 20210, 10210, 20210 07340402 30210 IVDELE = IVDELE + 1 07350402 WRITE (I02,80000) IVTNUM 07360402 IF (ICZERO) 10210, 0221, 20210 07370402 10210 IVPASS = IVPASS + 1 07380402 WRITE (I02,80002) IVTNUM 07390402 GO TO 0221 07400402 20210 IVFAIL = IVFAIL + 1 07410402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07420402 0221 CONTINUE 07430402 C 07440402 C **** FCVS PROGRAM 402 - TEST 022 **** 07450402 C 07460402 C 07470402 C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J. 07480402 C 07490402 C 07500402 IVTNUM = 22 07510402 IF (ICZERO) 30220, 0220, 30220 07520402 0220 CONTINUE 07530402 IVCOMP = 0 07540402 IVCORR = 10 07550402 0222 FORMAT (70X,10A) 07560402 READ (I09, 0222) (CATN14(J), J = 21,30) 07570402 DO 0223 I = 21,30 07580402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07590402 0223 CONTINUE 07600402 40220 IF (IVCOMP - 10) 20220, 10220, 20220 07610402 30220 IVDELE = IVDELE + 1 07620402 WRITE (I02,80000) IVTNUM 07630402 IF (ICZERO) 10220, 0231, 20220 07640402 10220 IVPASS = IVPASS + 1 07650402 WRITE (I02,80002) IVTNUM 07660402 GO TO 0231 07670402 20220 IVFAIL = IVFAIL + 1 07680402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07690402 0231 CONTINUE 07700402 C 07710402 C **** FCVS PROGRAM 402 - TEST 023 **** 07720402 C 07730402 C 07740402 C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T. 07750402 C 07760402 C 07770402 IVTNUM = 23 07780402 IF (ICZERO) 30230, 0230, 30230 07790402 0230 CONTINUE 07800402 IVCOMP = 0 07810402 IVCORR = 10 07820402 0232 FORMAT (70X,10A) 07830402 READ (I09, 0232) (CATN14(J), J = 31,40) 07840402 DO 0233 I = 31,40 07850402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07860402 0233 CONTINUE 07870402 40230 IF (IVCOMP - 10) 20230, 10230, 20230 07880402 30230 IVDELE = IVDELE + 1 07890402 WRITE (I02,80000) IVTNUM 07900402 IF (ICZERO) 10230, 0241, 20230 07910402 10230 IVPASS = IVPASS + 1 07920402 WRITE (I02,80002) IVTNUM 07930402 GO TO 0241 07940402 20230 IVFAIL = IVFAIL + 1 07950402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07960402 0241 CONTINUE 07970402 C 07980402 C **** FCVS PROGRAM 402 - TEST 024 **** 07990402 C 08000402 C 08010402 C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z. 08020402 C 08030402 C 08040402 IVTNUM = 24 08050402 IF (ICZERO) 30240, 0240, 30240 08060402 0240 CONTINUE 08070402 IVCOMP = 0 08080402 IVCORR = 06 08090402 0242 FORMAT (74X,6A) 08100402 READ (I09, 0242) (CATN14(J), J = 41,46) 08110402 DO 0243 I = 41,46 08120402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08130402 0243 CONTINUE 08140402 40240 IF (IVCOMP - 6) 20240, 10240, 20240 08150402 30240 IVDELE = IVDELE + 1 08160402 WRITE (I02,80000) IVTNUM 08170402 IF (ICZERO) 10240, 0251, 20240 08180402 10240 IVPASS = IVPASS + 1 08190402 WRITE (I02,80002) IVTNUM 08200402 GO TO 0251 08210402 20240 IVFAIL = IVFAIL + 1 08220402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08230402 0251 CONTINUE 08240402 C 08250402 C 08260402 C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING 08270402 C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED. 08280402 C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER 08290402 C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT 08300402 C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND 08310402 C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT 08320402 C OF THE READ. 08330402 C 08340402 C 08350402 70020 FORMAT (12X,2I4,59X,A1) 08360402 REWIND I09 08370402 DO 4026 I = 1, 150 08380402 READ (I09, 70020, END = 4027) IRECN, IEOF 08390402 IF (IRECN .EQ. 55) GO TO 4027 08400402 4026 CONTINUE 08410402 4027 IF (IRECN - 55) 4028, 4029, 4028 08420402 C 08430402 C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD 08440402 C NUMBER 55 FOR TESTS 25 THROUGH 29. 08450402 C 08460402 70021 FORMAT ( " THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT 08470402 1BE FOUND,") 08480402 70022 FORMAT (" THEREFORE TESTS 25 THROUGH 29 ARE DELETED." ) 08490402 4028 WRITE (I02, 70021) 08500402 WRITE (I02, 70022) 08510402 GO TO 301 08520402 4029 CONTINUE 08530402 DO 4030 I = 1,46 08540402 CATN14(I) = ' ' 08550402 4030 CONTINUE 08560402 C 08570402 C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS. 08580402 C 08590402 C 08600402 C **** FCVS PROGRAM 402 - TEST 025 **** 08610402 C 08620402 C 08630402 C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. 08640402 C 08650402 C 08660402 IVTNUM = 25 08670402 IF (ICZERO) 30250, 0250, 30250 08680402 0250 CONTINUE 08690402 IVCOMP = 0 08700402 IVCORR = 10 08710402 0252 FORMAT (70X,10A1) 08720402 READ (I09, 0252) (CATN14(J), J = 1, 10) 08730402 DO 0253 I = 1,10 08740402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08750402 0253 CONTINUE 08760402 40250 IF (IVCOMP - 10) 20250, 10250, 20250 08770402 30250 IVDELE = IVDELE + 1 08780402 WRITE (I02,80000) IVTNUM 08790402 IF (ICZERO) 10250, 0261, 20250 08800402 10250 IVPASS = IVPASS + 1 08810402 WRITE (I02,80002) IVTNUM 08820402 GO TO 0261 08830402 20250 IVFAIL = IVFAIL + 1 08840402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08850402 0261 CONTINUE 08860402 C 08870402 C **** FCVS PROGRAM 402 - TEST 026 **** 08880402 C 08890402 C 08900402 C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND08910402 C '. 08920402 C 08930402 C 08940402 IVTNUM = 26 08950402 IF (ICZERO) 30260, 0260, 30260 08960402 0260 CONTINUE 08970402 IVCOMP = 0 08980402 IVCORR = 10 08990402 0262 FORMAT (70X,10A1) 09000402 READ (I09, 0262) (CATN14(J), J = 11, 20) 09010402 DO 0263 I = 11,20 09020402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09030402 0263 CONTINUE 09040402 40260 IF (IVCOMP -10) 20260, 10260, 20260 09050402 30260 IVDELE = IVDELE + 1 09060402 WRITE (I02,80000) IVTNUM 09070402 IF (ICZERO) 10260, 0271, 20260 09080402 10260 IVPASS = IVPASS + 1 09090402 WRITE (I02,80002) IVTNUM 09100402 GO TO 0271 09110402 20260 IVFAIL = IVFAIL + 1 09120402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09130402 0271 CONTINUE 09140402 C 09150402 C **** FCVS PROGRAM 402 - TEST 027 **** 09160402 C 09170402 C 09180402 C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J. 09190402 C 09200402 C 09210402 IVTNUM = 27 09220402 IF (ICZERO) 30270, 0270, 30270 09230402 0270 CONTINUE 09240402 IVCOMP = 0 09250402 IVCORR = 10 09260402 0272 FORMAT (70X,10A1) 09270402 READ (I09, 0272) (CATN14(J), J = 21,30) 09280402 DO 0273 I = 21,30 09290402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09300402 0273 CONTINUE 09310402 40270 IF (IVCOMP - 10) 20270, 10270, 20270 09320402 30270 IVDELE = IVDELE + 1 09330402 WRITE (I02,80000) IVTNUM 09340402 IF (ICZERO) 10270, 0281, 20270 09350402 10270 IVPASS = IVPASS + 1 09360402 WRITE (I02,80002) IVTNUM 09370402 GO TO 0281 09380402 20270 IVFAIL = IVFAIL + 1 09390402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400402 0281 CONTINUE 09410402 C 09420402 C **** FCVS PROGRAM 402 - TEST 028 **** 09430402 C 09440402 C 09450402 C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T. 09460402 C 09470402 C 09480402 IVTNUM = 28 09490402 IF (ICZERO) 30280, 0280, 30280 09500402 0280 CONTINUE 09510402 IVCOMP = 0 09520402 IVCORR = 10 09530402 0282 FORMAT (70X,10A1) 09540402 READ (I09, 0282) (CATN14(J), J = 31,40) 09550402 DO 0283 I = 31, 40 09560402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09570402 0283 CONTINUE 09580402 40280 IF (IVCOMP - 10) 20280, 10280, 20280 09590402 30280 IVDELE = IVDELE + 1 09600402 WRITE (I02,80000) IVTNUM 09610402 IF (ICZERO) 10280, 0291, 20280 09620402 10280 IVPASS = IVPASS + 1 09630402 WRITE (I02,80002) IVTNUM 09640402 GO TO 0291 09650402 20280 IVFAIL = IVFAIL + 1 09660402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09670402 0291 CONTINUE 09680402 C 09690402 C **** FCVS PROGRAM 402 - TEST 029 **** 09700402 C 09710402 C 09720402 C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z. 09730402 C 09740402 C 09750402 IVTNUM = 29 09760402 IF (ICZERO) 30290, 0290, 30290 09770402 0290 CONTINUE 09780402 IVCOMP = 0 09790402 IVCORR = 6 09800402 0292 FORMAT (74X,6A1) 09810402 READ (I09, 0292) (CATN14(J), J = 41,46) 09820402 DO 0293 I = 41,46 09830402 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09840402 0293 CONTINUE 09850402 40290 IF (IVCOMP - 6) 20290, 10290, 20290 09860402 30290 IVDELE = IVDELE + 1 09870402 WRITE (I02,80000) IVTNUM 09880402 IF (ICZERO) 10290, 0301, 20290 09890402 10290 IVPASS = IVPASS + 1 09900402 WRITE (I02,80002) IVTNUM 09910402 GO TO 0301 09920402 20290 IVFAIL = IVFAIL + 1 09930402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09940402 0301 CONTINUE 09950402 C 09960402 C 09970402 C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE09980402 C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD 09990402 C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES. 10000402 C 10010402 C 10020402 70031 FORMAT (12X,2I4,59X,A1) 10030402 REWIND I09 10040402 DO 4031 I = 1,150 10050402 READ (I09, 70031, END = 4032) IRECN, IEOF 10060402 IF (IRECN .EQ. 100) GO TO 4032 10070402 4031 CONTINUE 10080402 4032 IF (IRECN - 100) 4033, 4034, 4033 10090402 70032 FORMAT ( " THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT 10100402 1BE FOUND,") 10110402 70033 FORMAT (" THEREFORE TESTS 30 THROUGH 32 ARE DELETED." ) 10120402 4033 WRITE (I02, 70032) 10130402 WRITE (I02, 70033) 10140402 GO TO 331 10150402 4034 CONTINUE 10160402 C 10170402 C **** FCVS PROGRAM 402 - TEST 030 **** 10180402 C 10190402 C 10200402 C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT 10210402 C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL 10220402 C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE 10230402 C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS 10240402 C CREATED IN TEST 17 WITH THE FORMAT STATEMENT 10250402 C 10260402 C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 10270402 C 1 ) 10280402 C 10290402 C 10300402 IVTNUM = 30 10310402 IF (ICZERO) 30300, 0300, 30300 10320402 0300 CONTINUE 10330402 IVCOMP = 1 10340402 IVCORR = 210 10350402 CATN14(1) = ' ' 10360402 CVTN13 = ' ' 10370402 CATN12(3) = ' ' 10380402 CVTN12 = ' ' 10390402 0302 FORMAT (20X,4A,42X,A1) 10400402 READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN1210410402 0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2 10420402 IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3 10430402 IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5 10440402 IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7 10450402 40300 IF (IVCOMP - 210) 20300, 10300, 20300 10460402 30300 IVDELE = IVDELE + 1 10470402 WRITE (I02,80000) IVTNUM 10480402 IF (ICZERO) 10300, 0311, 20300 10490402 10300 IVPASS = IVPASS + 1 10500402 WRITE (I02,80002) IVTNUM 10510402 GO TO 0311 10520402 20300 IVFAIL = IVFAIL + 1 10530402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10540402 0311 CONTINUE 10550402 C 10560402 C **** FCVS PROGRAM 402 - TEST 031 **** 10570402 C 10580402 C 10590402 C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN10600402 C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL 10610402 C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD 10620402 C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL 10630402 C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED 10640402 C IN TEST 17 WITH THE FORMAT STATEMENT 10650402 C 10660402 C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 10670402 C 1 ) 10680402 C 10690402 C 10700402 C 10710402 IVTNUM = 31 10720402 IF (ICZERO) 30310, 0310, 30310 10730402 0310 CONTINUE 10740402 CVTN12 = '9999999999' 10750402 IVCOMP = 0 10760402 IVCORR = 1 10770402 0312 FORMAT (20X,10X,A5,40X) 10780402 READ (I09, 0312, END = 0313) CVTN12 10790402 0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1 10800402 40310 IF (IVCOMP - 1) 20310, 10310, 20310 10810402 30310 IVDELE = IVDELE + 1 10820402 WRITE (I02,80000) IVTNUM 10830402 IF (ICZERO) 10310, 0321, 20310 10840402 10310 IVPASS = IVPASS + 1 10850402 WRITE (I02,80002) IVTNUM 10860402 GO TO 0321 10870402 20310 IVFAIL = IVFAIL + 1 10880402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10890402 0321 CONTINUE 10900402 C 10910402 C **** FCVS PROGRAM 402 - TEST 032 **** 10920402 C 10930402 C 10940402 C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT 10950402 C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE 10960402 C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST 10970402 C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER 10980402 C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17 10990402 C WITH THE FORMAT STATEMENT 11000402 C 11010402 C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 11020402 C 1 ) 11030402 C 11040402 C 11050402 C 11060402 IVTNUM = 32 11070402 IF (ICZERO) 30320, 0320, 30320 11080402 0320 CONTINUE 11090402 CATN12 (5) = 'AAAAA' 11100402 IVCOMP = 0 11110402 IVCORR = 1 11120402 0322 FORMAT (20X,10X,A10,35X) 11130402 READ (I09, 0322, END = 0323) CATN12 (5) 11140402 0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1 11150402 40320 IF (IVCOMP - 1) 20320, 10320, 20320 11160402 30320 IVDELE = IVDELE + 1 11170402 WRITE (I02,80000) IVTNUM 11180402 IF (ICZERO) 10320, 0331, 20320 11190402 10320 IVPASS = IVPASS + 1 11200402 WRITE (I02,80002) IVTNUM 11210402 GO TO 0331 11220402 20320 IVFAIL = IVFAIL + 1 11230402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11240402 0331 CONTINUE 11250402 C 11260402 C 11270402 C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND 11280402 C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ 11290402 C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD. 11300402 C 11310402 C 11320402 70034 FORMAT (12X,2I4,60X) 11330402 REWIND I09 11340402 DO 4035 I = 1,150 11350402 READ (I09, 70034, END = 4036) IRECN, IEOF 11360402 IF (IRECN .EQ. 140) GO TO 4036 11370402 4035 CONTINUE 11380402 4036 IF (IRECN - 140) 4037, 4038, 4037 11390402 C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR 11400402 C TESTS 33 AND 34. 11410402 C 11420402 70035 FORMAT ( " THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE 11430402 1FOUND,") 11440402 70036 FORMAT (" THEREFORE TESTS 33 AND 34 ARE DELETED." ) 11450402 4037 WRITE (I02, 70035) 11460402 WRITE (I02, 70036) 11470402 GO TO 351 11480402 4038 CONTINUE 11490402 C 11500402 C **** FCVS PROGRAM 402 - TEST 033 **** 11510402 C 11520402 C 11530402 C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A 11540402 C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS 11550402 C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF 11560402 C 11570402 C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11580402 C 11590402 C WITHOUT THE SURROUNDING APOSTROPHES. 11600402 C 11610402 C 11620402 C 11630402 IVTNUM = 33 11640402 IF (ICZERO) 30330, 0330, 30330 11650402 0330 CONTINUE 11660402 CVTN15 = ' ' 11670402 IVCOMP = 0 11680402 IVCORR = 1 11690402 0332 FORMAT (20X,10X,A50) 11700402 READ (I09, 0332) CVTN15 11710402 IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567811720402 19') IVCOMP = 1 11730402 40330 IF (IVCOMP -1 ) 20330, 10330, 20330 11740402 30330 IVDELE = IVDELE + 1 11750402 WRITE (I02,80000) IVTNUM 11760402 IF (ICZERO) 10330, 0341, 20330 11770402 10330 IVPASS = IVPASS + 1 11780402 WRITE (I02,80002) IVTNUM 11790402 GO TO 0341 11800402 20330 IVFAIL = IVFAIL + 1 11810402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11820402 0341 CONTINUE 11830402 C 11840402 C **** FCVS PROGRAM 402 - TEST 034 **** 11850402 C 11860402 C 11870402 C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR 11880402 C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ. 11890402 C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA 11900402 C 11910402 C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11920402 C 11930402 C WITHOUT THE SURROUNDING APOSTROPHES. 11940402 C 11950402 C 11960402 IVTNUM = 34 11970402 IF (ICZERO) 30340, 0340, 30340 11980402 0340 CONTINUE 11990402 CVTN15 = ' ' 12000402 IVCOMP = 0 12010402 IVCORR = 1 12020402 0342 FORMAT (20X,10X,A) 12030402 READ (I09, 0342) CVTN15 12040402 IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567812050402 19') IVCOMP = 1 12060402 40340 IF (IVCOMP - 1) 20340, 10340, 20340 12070402 30340 IVDELE = IVDELE + 1 12080402 WRITE (I02,80000) IVTNUM 12090402 IF (ICZERO) 10340, 0351, 20340 12100402 10340 IVPASS = IVPASS + 1 12110402 WRITE (I02,80002) IVTNUM 12120402 GO TO 0351 12130402 20340 IVFAIL = IVFAIL + 1 12140402 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12150402 0351 CONTINUE 12160402 C 12170402 C 12180402 C 12190402 C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 12200402 C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 12210402 C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 12220402 C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED12230402 C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 12240402 C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 12250402 C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 12260402 C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 12270402 C REPORT AND BEFORE THE TEST REPORT SUMMARY. 12280402 C 12290402 CDB** BEGIN FILE DUMP CODE 12300402 C REWIND I09 12310402 C IRNUM = 1 12320402 C IRLGN = 80 12330402 C ILUN = I09 12340402 C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) 12350402 C7702 FORMAT (" ",I3,I2,I4,I3,2I4,60A1) 12360402 C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 12370402 C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " , 12380402 C 1I3,9H RECORDS.) 12390402 C DO 7771 IRNUM = 1, ITOTR 12400402 C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12410402 C 1 (IDUMP(ICH), ICH = 1,60) 12420402 C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12430402 C 1 (IDUMP(ICH), ICH = 1,60) 12440402 C IF (IEOF .EQ. 9999) GO TO 7772 12450402 C7771 CONTINUE 12460402 C GO TO 7775 12470402 C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 12480402 C7773 WRITE (I02, 7703) ILUN, IRNUM 12490402 C GO TO 7779 12500402 C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12510402 C GO TO 7779 12520402 C7775 DO 7776 I = 1,20 12530402 C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12540402 C 1 (IDUMP(ICH), ICH = 1,60) 12550402 C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12560402 C 1 (IDUMP(ICH), ICH = 1,60) 12570402 C IRNUM = IRNUM + 1 12580402 C IF (IEOF .EQ. 9999) GO TO 7777 12590402 C7776 CONTINUE 12600402 C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12610402 C7779 CONTINUE 12620402 CDE** END OF DUMP CODE 12630402 C 12640402 C THERE SHOULD BE 34 TESTS IN THIS ROUTINE 12650402 C 12660402 C 12670402 C 12680402 C 12690402 C WRITE OUT TEST SUMMARY 12700402 C 12710402 WRITE (I02,90004) 12720402 WRITE (I02,90014) 12730402 WRITE (I02,90004) 12740402 WRITE (I02,90000) 12750402 WRITE (I02,90004) 12760402 WRITE (I02,90020) IVFAIL 12770402 WRITE (I02,90022) IVPASS 12780402 WRITE (I02,90024) IVDELE 12790402 STOP 12800402 90001 FORMAT (" ",24X,"FM402") 12810402 90000 FORMAT (" ",20X,"END OF PROGRAM FM402" ) 12820402 C 12830402 C FORMATS FOR TEST DETAIL LINES 12840402 C 12850402 80000 FORMAT (" ",4X,I5,6X,"DELETED") 12860402 80002 FORMAT (" ",4X,I5,7X,"PASS") 12870402 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 12880402 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 12890402 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 12900402 C 12910402 C FORMAT STATEMENTS FOR PAGE HEADERS 12920402 C 12930402 90002 FORMAT ("1") 12940402 90004 FORMAT (" ") 12950402 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 12960402 90008 FORMAT (" ",21X,"VERSION 2.1" ) 12970402 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 12980402 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 12990402 90014 FORMAT (" ",5X,"----------------------------------------------" ) 13000402 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 13010402 C 13020402 C FORMAT STATEMENTS FOR RUN SUMMARY 13030402 C 13040402 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 13050402 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 13060402 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 13070402 END 13080402