PROGRAM FM402 C C C C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS) C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/ C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI- C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC- C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES- C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT. C C THIS ROUTINE TESTS FOR PROPER EDITING BY C C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT C AND OUTPUT, C C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT C LIST ITEM IS LESS THAN THE WIDTH W, C C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W, C C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT C SPECIFICATION. C C REFERENCES - C C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 3.1, FORTRAN CHARACTER SET C SECTION 4.8, CHARACTER TYPE C SECTION 8.4.2, CHARACTER TYPE-STATEMENT C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT C SECTION 13.5.11, A EDITING C C C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (C) C DIMENSION IDUMP (80) DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46) CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1 CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50 CHARACTER CVTN01*1 DATA CATN14 /46*' '/ DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/ DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C', 2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/ DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/ C C C C INITIALIZATION SECTION. C C INITIALIZE CONSTANTS C ******************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS = 0 IVFAIL = 0 IVDELE = 0 ICZERO = 0 C C WRITE OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C C C C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A C EDITING C C 80052 FORMAT (1H ,4X,48HTESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED. 1) 80054 FORMAT (1H ,56HIMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE 1 LINE) 80056 FORMAT (1H ,52HOF THE FORM '123456 ...'. THE REFERENCE LINE IS T 1O) 80058 FORMAT (1H ,49HAID IN THE VISUAL VERIFICATION OF THE TESTS. FOR) 80062 FORMAT (1H ,50HTHE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED 1) 80064 FORMAT (1H ,54HIN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE 1CT ) 80066 FORMAT (1H ,44HCOLUMN IN BOTH VALUE AND CHARACTER POSITION.) 80072 FORMAT (1H ,26HREFERENCE LINE - ,10H1234567890,5X,10H1234 1567890) WRITE (I02,80052) WRITE (I02,80054) WRITE (I02,80056) WRITE (I02,80058) WRITE (I02,80062) WRITE (I02,80064) WRITE (I02,80066) WRITE (I02,90004) WRITE (I02,80072) C C **** FCVS PROGRAM 402 - TEST 001 **** C C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A C VARIABLE. C IVTNUM = 001 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE CVTN01 = 'A' 0012 FORMAT (1H ,4X,I5,26X,A,14X,1HA) WRITE (I02, 0012) IVTNUM, CVTN01 GO TO 0021 30010 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM 0021 CONTINUE C C **** FCVS PROGRAM 402 - TEST 002 **** C C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST C ITEM IS AN ARRAY ELEMENT. C IVTNUM = 002 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE CATN31 (1,2,1) = 'Z' 0022 FORMAT (1H ,4X,I5,26X,A,14X,1HZ) WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1) GO TO 0031 30020 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM 0031 CONTINUE C C *** FCVS PROGRAM 402 - TEST 003 **** C C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH. C IVTNUM = 003 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE CVTN11 = '/' 0032 FORMAT (1H ,4X,I5,26X,A,14X,1H/) WRITE (I02, 0032) IVTNUM, CVTN11 GO TO 0041 30030 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0041 CONTINUE C C *** FCVS PROGRAM 402 - TEST 004 *** C C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING C EDITED IS NUMERIC. C IVTNUM = 004 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE CVTN11 = '9' 0042 FORMAT (1H ,4X,I5,26X,A,14X,1H9) WRITE (I02, 0042) IVTNUM, CVTN11 GO TO 0051 30040 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0051 CONTINUE C C *** FCVS PROGRAM 402 - TEST 005 *** C C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL C CHARACTER QUOTE. C IVTNUM = 005 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE CVTN11 = '''' 0052 FORMAT (1H ,4X,I5,26X,A,14X,1H') WRITE (I02, 0052) IVTNUM, CVTN11 GO TO 0061 30050 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM C C C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH. C C 0061 CONTINUE C C **** FCVS PROGRAM 402 - TEST 006 **** C C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS C IVTNUM = 006 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE CATN12(1) = 'ABMYZ' 0062 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H ABMYZ) WRITE (I02, 0062) IVTNUM, CATN12(1) GO TO 0071 30060 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0071 CONTINUE C C **** FCVS PROGRAM 402 - TEST 007 **** C C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS C IVTNUM = 007 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE CATN12(2) = '01589' 0072 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 01589) WRITE (I02, 0072) IVTNUM, CATN12(2) GO TO 0081 30070 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0081 CONTINUE C C **** FCVS PROGRAM 402 - TEST 008 **** C C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL C CHARACTERS. C IVTNUM = 008 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE CATN12(3) = '=+-()' 0082 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H =+-()) WRITE (I02, 0082) IVTNUM, CATN12(3) GO TO 0091 30080 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0091 CONTINUE C C **** FCVS PROGRAM FM402 - TEST 009 **** C C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX C OF LETTERS, DIGITS AND SPECIAL CHARACTERS C IVTNUM = 009 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE CATN12(4) = 'A5+.Z' 0092 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H A5+.Z) WRITE (I02, 0092) IVTNUM, CATN12(4) GO TO 0101 30090 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0101 CONTINUE C C **** FCVS PROGRAM FM402 - TEST 010 **** C C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES C IVTNUM = 010 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE CATN12(5) = '1''A,4' 0102 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 1'A,4) WRITE (I02, 0102) IVTNUM, CATN12(5) GO TO 0111 30100 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM C 0111 CONTINUE C **** FCVS PROGRAM FM402 - TEST 11 **** C C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION. C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH. C IVTNUM = 011 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE 0112 FORMAT (1H ,4X,I5,17X,10A,5X,10H059=+PQUVY) WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10), 1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41), 2CATN11(42), CATN11(45) GO TO 0121 30110 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0121 CONTINUE C C **** FCVS PROGRAM FM402 - TEST 12 **** C C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER. C IVTNUM = 012 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE CVTN13 = 'YZ' CVTN11 = ')' CATN12(2) = '(12AB' 0122 FORMAT (1H ,4X,I5,17X,1H*,3A,1H*,5X,10H*(12ABYZ)*) WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11 GO TO 0131 30120 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0131 CONTINUE C C **** FCVS PROGRAM FM402 - TEST 13 *** C C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS C FROM THE INTERNAL REPRESENTATION. C IVTNUM = 013 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE CATN12(1) = 'ABMYZ' 0132 FORMAT (1H ,4X,I5,17X,A10,5X,10H ABMYZ) WRITE (I02, 0132) IVTNUM, CATN12(1) GO TO 0141 30130 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0141 CONTINUE C C **** FCVS PROGRAM FM402 - TEST 14 **** C C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL C REPRESENTATION. C IVTNUM = 014 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE CVTN12 = '12345ABCDE' 0142 FORMAT (1H ,4X,I5,17X,5H ,A5,5X,10H 12345) WRITE (I02, 0142) IVTNUM, CVTN12 GO TO 0151 30140 IVDELE = IVDELE + 1 WRITE (I02, 80000) IVTNUM 0151 CONTINUE C C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE: C C FILE IDENTIFIER - I09 (X-NUMBER 09) C RECORD SIZE - 80 CHARACTERS C ACCESS METHOD - SEQUENTIAL C RECORD TYPE - FORMATTED C DESIGNATED DEVICE - DISK C TYPE OF DATA - CHARACTER (A FORMAT) C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD C C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR. C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. C C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS C -------- ---- -- ------- --------- --------- C C IPROG (ROUTINE NAME) - 1 THRU 3 C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 C ITOTR (RECORDS IN FILE) - 6 THRU 9 C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 C IRECN (RECORD NUMBER) - 13 THRU 16 C IEOF (9999 IF LAST RECORD) - 17 THRU 20 C C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07 I09 = 07 CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090 CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 IPROG = 402 IFILE = I09 ITOTR = 143 IRLGN = 80 IRECN = 0 IEOF = 0 C C C ***** CREATE-FILE SECTION ***** C C C **** FCVS PROGRAM 402 - TEST 015 **** C C C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH. C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS). C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE. C C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE 70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A) 70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A) IRECN = 0 DO 4023 I=1,10 IRECN = IRECN + 1 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11 (J), J = 1,10) C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 11,20) C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD. IRECN = IRECN + 1 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 21,30) C CHARACTERS A THROUGH J ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 31,40) C CHARACTERS K THROUGH T ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 41,46) C CHARACTERS U THROUGH Z ARE IN THIS RECORD 4023 CONTINUE IVCOMP = IRECN IVCORR = 050 IVON01 = 50 40150 IF (IVON01 - IRECN ) 20150, 10150, 20150 C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN 30150 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10150, 0161, 20150 10150 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0161 20150 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0161 CONTINUE C C **** FCVS PROGRAM 402 - TEST 016 **** C C C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH C SPECIFIED. C C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE 70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1) 70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1) IRECN = 50 DO 4024 I=1,10 IRECN = IRECN + 1 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 1,10) C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 11,20) C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 21,30) C CHARACTERS A THROUGH J ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 31,40) C CHARACTERS K THROUGH T ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 1 (CATN11(J), J = 41,46) C CHARACTERS U THROUGH Z ARE IN THIS RECORD 4024 CONTINUE IVCOMP = IRECN - 50 IVCORR = 50 IVON01 = 100 40160 IF (IVON01 - IRECN) 20160, 10160, 20160 30160 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10160, 0171, 20160 10160 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0171 20160 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0171 CONTINUE C C **** FCVS PROGRAM 402 - TEST 017 **** C C C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS C FOLLOWING EXECUTION OF THIS TEST. C C IVTNUM = 17 IF (ICZERO) 30170, 0170, 30170 0170 CONTINUE 70007 FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 1 ) 70008 FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 1 ) IRECN = 100 DO 4025 I = 1,20 IRECN = IRECN + 1 WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD IRECN = IRECN + 1 WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF C SPECIAL CHARACTERS ARE IN THIS RECORD 4025 CONTINUE IVCOMP = IRECN - 100 IVCORR = 40 IVON01 = 140 40170 IF (IVON01 - IRECN) 20170, 10170, 20170 30170 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10170, 0181, 20170 10170 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0181 20170 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0181 CONTINUE C C **** FCVS PROGRAM 402 - TEST 018 **** C C C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR- C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD C WIDTH SPECIFICATION. C C IVTNUM = 18 IF (ICZERO) 30180, 0180, 30180 0180 CONTINUE IRECN = 141 70009 FORMAT (I3,I2,I4,I3,2I4,10X,A) WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN15 IVCOMP = IRECN - 140 IVCORR = 1 IVON01 = 141 40180 IF (IVON01 - IRECN) 20180, 10180, 20180 30180 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10180, 0191, 20180 10180 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0191 20180 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0191 CONTINUE C C **** FCVS PROGRAM 402 - TEST 019 **** C C C TEST 19 WRITES A LONG FIELD (50 CHARACTERS) C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH C SPECIFICATION. C C IVTNUM = 19 IF (ICZERO) 30190, 0190, 30190 0190 CONTINUE IRECN = 142 70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50) WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN15 IVCOMP = IRECN - 141 IVCORR = 1 IVON01 = 142 40190 IF (IVON01 - IRECN) 20190, 10190, 20190 30190 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10190, 0201, 20190 10190 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0201 20190 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0201 CONTINUE C C **** FCVS PROGRAM 402 - TEST 020 **** C C IVTNUM = 20 IF (ICZERO) 30200, 0200, 30200 0200 CONTINUE IRECN = IRECN + 1 IEOF = 9999 70011 FORMAT (I3,I2,I4,I3,2I4,59X,1H ) WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF ENDFILE I09 REWIND I09 WRITE (I02, 90004) 70012 FORMAT (53H FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS) 70013 FORMAT (39H INCORRECT NUMBER OF RECORDS IN FILE - , I5 ,08H RECO 1RDS) 70014 FORMAT (50H WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN.) IF (IRECN - 143) 4020, 4021, 4020 4020 WRITE (I02, 70013) IRECN WRITE (I02, 70014) GO TO 4022 4021 WRITE (I02, 70012) WRITE (I02, 90004) C C **** END-OF-CREATE-FILE SECTION **** C 4022 CONTINUE C C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION. C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. C C C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. C IVCOMP = 0 IVCORR = 10 0202 FORMAT (70X,10A) READ (I09, 0202) (CATN14(J), J = 1,10) DO 0203 I=1,10 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0203 CONTINUE 40200 IF (IVCOMP - 10) 20200, 10200, 20200 30200 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10200, 0211, 20200 10200 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0211 20200 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0211 CONTINUE C C **** FCVS PROGRAM 402 - TEST 021 **** C C C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF C THE READ. C C IVTNUM = 21 IF (ICZERO) 30210, 0210, 30210 0210 CONTINUE IVCOMP = 0 IVCORR = 10 0212 FORMAT (70X,10A) READ (I09, 0212) (CATN14(J), J = 11,20) DO 0213 I = 11,20 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0213 CONTINUE 40210 IF (IVCOMP - 10) 20210, 10210, 20210 30210 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10210, 0221, 20210 10210 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0221 20210 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0221 CONTINUE C C **** FCVS PROGRAM 402 - TEST 022 **** C C C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J. C C IVTNUM = 22 IF (ICZERO) 30220, 0220, 30220 0220 CONTINUE IVCOMP = 0 IVCORR = 10 0222 FORMAT (70X,10A) READ (I09, 0222) (CATN14(J), J = 21,30) DO 0223 I = 21,30 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0223 CONTINUE 40220 IF (IVCOMP - 10) 20220, 10220, 20220 30220 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10220, 0231, 20220 10220 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0231 20220 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0231 CONTINUE C C **** FCVS PROGRAM 402 - TEST 023 **** C C C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T. C C IVTNUM = 23 IF (ICZERO) 30230, 0230, 30230 0230 CONTINUE IVCOMP = 0 IVCORR = 10 0232 FORMAT (70X,10A) READ (I09, 0232) (CATN14(J), J = 31,40) DO 0233 I = 31,40 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0233 CONTINUE 40230 IF (IVCOMP - 10) 20230, 10230, 20230 30230 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10230, 0241, 20230 10230 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0241 20230 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0241 CONTINUE C C **** FCVS PROGRAM 402 - TEST 024 **** C C C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z. C C IVTNUM = 24 IF (ICZERO) 30240, 0240, 30240 0240 CONTINUE IVCOMP = 0 IVCORR = 06 0242 FORMAT (74X,6A) READ (I09, 0242) (CATN14(J), J = 41,46) DO 0243 I = 41,46 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0243 CONTINUE 40240 IF (IVCOMP - 6) 20240, 10240, 20240 30240 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10240, 0251, 20240 10240 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0251 20240 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0251 CONTINUE C C C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED. C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT C OF THE READ. C C 70020 FORMAT (12X,2I4,59X,A1) REWIND I09 DO 4026 I = 1, 150 READ (I09, 70020, END = 4027) IRECN, IEOF IF (IRECN .EQ. 55) GO TO 4027 4026 CONTINUE 4027 IF (IRECN - 55) 4028, 4029, 4028 C C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD C NUMBER 55 FOR TESTS 25 THROUGH 29. C 70021 FORMAT (64H THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT 1BE FOUND,) 70022 FORMAT (49H THEREFORE TESTS 25 THROUGH 29 ARE DELETED.) 4028 WRITE (I02, 70021) WRITE (I02, 70022) GO TO 301 4029 CONTINUE DO 4030 I = 1,46 CATN14(I) = ' ' 4030 CONTINUE C C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS. C C C **** FCVS PROGRAM 402 - TEST 025 **** C C C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. C C IVTNUM = 25 IF (ICZERO) 30250, 0250, 30250 0250 CONTINUE IVCOMP = 0 IVCORR = 10 0252 FORMAT (70X,10A1) READ (I09, 0252) (CATN14(J), J = 1, 10) DO 0253 I = 1,10 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0253 CONTINUE 40250 IF (IVCOMP - 10) 20250, 10250, 20250 30250 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10250, 0261, 20250 10250 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0261 20250 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0261 CONTINUE C C **** FCVS PROGRAM 402 - TEST 026 **** C C C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND C '. C C IVTNUM = 26 IF (ICZERO) 30260, 0260, 30260 0260 CONTINUE IVCOMP = 0 IVCORR = 10 0262 FORMAT (70X,10A1) READ (I09, 0262) (CATN14(J), J = 11, 20) DO 0263 I = 11,20 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0263 CONTINUE 40260 IF (IVCOMP -10) 20260, 10260, 20260 30260 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10260, 0271, 20260 10260 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0271 20260 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0271 CONTINUE C C **** FCVS PROGRAM 402 - TEST 027 **** C C C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J. C C IVTNUM = 27 IF (ICZERO) 30270, 0270, 30270 0270 CONTINUE IVCOMP = 0 IVCORR = 10 0272 FORMAT (70X,10A1) READ (I09, 0272) (CATN14(J), J = 21,30) DO 0273 I = 21,30 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0273 CONTINUE 40270 IF (IVCOMP - 10) 20270, 10270, 20270 30270 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10270, 0281, 20270 10270 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0281 20270 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0281 CONTINUE C C **** FCVS PROGRAM 402 - TEST 028 **** C C C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T. C C IVTNUM = 28 IF (ICZERO) 30280, 0280, 30280 0280 CONTINUE IVCOMP = 0 IVCORR = 10 0282 FORMAT (70X,10A1) READ (I09, 0282) (CATN14(J), J = 31,40) DO 0283 I = 31, 40 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0283 CONTINUE 40280 IF (IVCOMP - 10) 20280, 10280, 20280 30280 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10280, 0291, 20280 10280 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0291 20280 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0291 CONTINUE C C **** FCVS PROGRAM 402 - TEST 029 **** C C C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z. C C IVTNUM = 29 IF (ICZERO) 30290, 0290, 30290 0290 CONTINUE IVCOMP = 0 IVCORR = 6 0292 FORMAT (74X,6A1) READ (I09, 0292) (CATN14(J), J = 41,46) DO 0293 I = 41,46 IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 0293 CONTINUE 40290 IF (IVCOMP - 6) 20290, 10290, 20290 30290 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10290, 0301, 20290 10290 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0301 20290 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0301 CONTINUE C C C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES. C C 70031 FORMAT (12X,2I4,59X,A1) REWIND I09 DO 4031 I = 1,150 READ (I09, 70031, END = 4032) IRECN, IEOF IF (IRECN .EQ. 100) GO TO 4032 4031 CONTINUE 4032 IF (IRECN - 100) 4033, 4034, 4033 70032 FORMAT (64H THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT 1BE FOUND,) 70033 FORMAT (49H THEREFORE TESTS 30 THROUGH 32 ARE DELETED.) 4033 WRITE (I02, 70032) WRITE (I02, 70033) GO TO 331 4034 CONTINUE C C **** FCVS PROGRAM 402 - TEST 030 **** C C C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS C CREATED IN TEST 17 WITH THE FORMAT STATEMENT C C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 C 1 ) C C IVTNUM = 30 IF (ICZERO) 30300, 0300, 30300 0300 CONTINUE IVCOMP = 1 IVCORR = 210 CATN14(1) = ' ' CVTN13 = ' ' CATN12(3) = ' ' CVTN12 = ' ' 0302 FORMAT (20X,4A,42X,A1) READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN12 0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2 IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3 IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5 IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7 40300 IF (IVCOMP - 210) 20300, 10300, 20300 30300 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10300, 0311, 20300 10300 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0311 20300 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0311 CONTINUE C C **** FCVS PROGRAM 402 - TEST 031 **** C C C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED C IN TEST 17 WITH THE FORMAT STATEMENT C C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 C 1 ) C C C IVTNUM = 31 IF (ICZERO) 30310, 0310, 30310 0310 CONTINUE CVTN12 = '9999999999' IVCOMP = 0 IVCORR = 1 0312 FORMAT (20X,10X,A5,40X) READ (I09, 0312, END = 0313) CVTN12 0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1 40310 IF (IVCOMP - 1) 20310, 10310, 20310 30310 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10310, 0321, 20310 10310 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0321 20310 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0321 CONTINUE C C **** FCVS PROGRAM 402 - TEST 032 **** C C C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17 C WITH THE FORMAT STATEMENT C C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 C 1 ) C C C IVTNUM = 32 IF (ICZERO) 30320, 0320, 30320 0320 CONTINUE CATN12 (5) = 'AAAAA' IVCOMP = 0 IVCORR = 1 0322 FORMAT (20X,10X,A10,35X) READ (I09, 0322, END = 0323) CATN12 (5) 0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1 40320 IF (IVCOMP - 1) 20320, 10320, 20320 30320 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10320, 0331, 20320 10320 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0331 20320 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0331 CONTINUE C C C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD. C C 70034 FORMAT (12X,2I4,60X) REWIND I09 DO 4035 I = 1,150 READ (I09, 70034, END = 4036) IRECN, IEOF IF (IRECN .EQ. 140) GO TO 4036 4035 CONTINUE 4036 IF (IRECN - 140) 4037, 4038, 4037 C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR C TESTS 33 AND 34. C 70035 FORMAT (61H THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE 1FOUND,) 70036 FORMAT (45H THEREFORE TESTS 33 AND 34 ARE DELETED.) 4037 WRITE (I02, 70035) WRITE (I02, 70036) GO TO 351 4038 CONTINUE C C **** FCVS PROGRAM 402 - TEST 033 **** C C C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF C C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' C C WITHOUT THE SURROUNDING APOSTROPHES. C C C IVTNUM = 33 IF (ICZERO) 30330, 0330, 30330 0330 CONTINUE CVTN15 = ' ' IVCOMP = 0 IVCORR = 1 0332 FORMAT (20X,10X,A50) READ (I09, 0332) CVTN15 IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 012345678 19') IVCOMP = 1 40330 IF (IVCOMP -1 ) 20330, 10330, 20330 30330 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10330, 0341, 20330 10330 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0341 20330 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0341 CONTINUE C C **** FCVS PROGRAM 402 - TEST 034 **** C C C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ. C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA C C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' C C WITHOUT THE SURROUNDING APOSTROPHES. C C IVTNUM = 34 IF (ICZERO) 30340, 0340, 30340 0340 CONTINUE CVTN15 = ' ' IVCOMP = 0 IVCORR = 1 0342 FORMAT (20X,10X,A) READ (I09, 0342) CVTN15 IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 012345678 19') IVCOMP = 1 40340 IF (IVCOMP - 1) 20340, 10340, 20340 30340 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10340, 0351, 20340 10340 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0351 20340 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0351 CONTINUE C C C C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST C REPORT AND BEFORE THE TEST REPORT SUMMARY. C CDB** BEGIN FILE DUMP CODE C REWIND I09 C IRNUM = 1 C IRLGN = 80 C ILUN = I09 C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) C7702 FORMAT (1H ,I3,I2,I4,I3,2I4,60A1) C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK) C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE , C 1I3,9H RECORDS.) C DO 7771 IRNUM = 1, ITOTR C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, C 1 (IDUMP(ICH), ICH = 1,60) C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, C 1 (IDUMP(ICH), ICH = 1,60) C IF (IEOF .EQ. 9999) GO TO 7772 C7771 CONTINUE C GO TO 7775 C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 C7773 WRITE (I02, 7703) ILUN, IRNUM C GO TO 7779 C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR C GO TO 7779 C7775 DO 7776 I = 1,20 C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, C 1 (IDUMP(ICH), ICH = 1,60) C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, C 1 (IDUMP(ICH), ICH = 1,60) C IRNUM = IRNUM + 1 C IF (IEOF .EQ. 9999) GO TO 7777 C7776 CONTINUE C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR C7779 CONTINUE CDE** END OF DUMP CODE C C THERE SHOULD BE 34 TESTS IN THIS ROUTINE C C C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM402) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM402) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END