![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM103.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 FM103.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: C COMMENT SECTION. 00010103 ! 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 00020103 ! 6: C FM103 00030103 ! 7: C 00040103 ! 8: C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER00050103 ! 9: C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060103 ! 10: C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070103 ! 11: C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS00080103 ! 12: C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE 00090103 ! 13: C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100103 ! 14: C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110103 ! 15: C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120103 ! 16: C INTEGER ARRAY FOR THE DUMP SECTION. 00130103 ! 17: C 00140103 ! 18: C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150103 ! 19: C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160103 ! 20: C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO 00170103 ! 21: C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND 00180103 ! 22: C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE 00190103 ! 23: C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS. 00200103 ! 24: C 00210103 ! 25: C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00220103 ! 26: C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00230103 ! 27: C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00240103 ! 28: C OF THE CONTINUATION LINE. 00250103 ! 29: C 00260103 ! 30: C REFERENCES 00270103 ! 31: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00280103 ! 32: C X3.9-1978 00290103 ! 33: C 00300103 ! 34: C SECTION 8, SPECIFICATION STATEMENTS 00310103 ! 35: C SECTION 9, DATA STATEMENT 00320103 ! 36: C SECTION 11.10, DO STATEMENT 00330103 ! 37: C SECTION 12, INPUT/OUTPUT STATEMENTS 00340103 ! 38: C SECTION 12.8.2, INPUT/OUTPUT LIST 00350103 ! 39: C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00360103 ! 40: C SECTION 13, FORMAT STATEMENT 00370103 ! 41: C SECTION 13.2.1, EDIT DESCRIPTORS 00380103 ! 42: C 00390103 ! 43: DIMENSION IDUMP(136) 00400103 ! 44: DIMENSION IADN11(5), IADN12(3), IADN13(3) 00410103 ! 45: CHARACTER*1 NINE,IADN11,ICON04,ICON06,IDUMP 00420103 ! 46: CHARACTER*2 IADN12 00430103 ! 47: CHARACTER*3 IADN13 00440103 ! 48: DATA NINE/'9'/ 00450103 ! 49: DATA IADN11/'A', 'B', 'C', 'D', 'E'/, IADN12 / 'HE', 'LL', 'O'/ 00460103 ! 50: 1,IADN13 / 'H', 'EL', 'LO' / 00470103 ! 51: C 00480103 ! 52: 77701 FORMAT ( 80A1 ) 00490103 ! 53: 77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O00500103 ! 54: 1F ,I3,8H RECORDS) 00510103 ! 55: 77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS) 00520103 ! 56: 77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR00530103 ! 57: 1DS) 00540103 ! 58: 77705 FORMAT ( 1X,80A1) 00550103 ! 59: 77706 FORMAT (10X,43HFILE I09 CREATED WITH 31 SEQUENTIAL RECORDS) 00560103 ! 60: 77751 FORMAT ( I3,2I2,3I3,I4,5X,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,2A2,A00570103 ! 61: 11 ) 00580103 ! 62: 77752 FORMAT ( I3,2I2,3I3,I4,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,A1,2A2,500590103 ! 63: 1X ) 00600103 ! 64: 77753 FORMAT (7X,I3,6X,I4,5X,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 ) 00610103 ! 65: 77754 FORMAT (7X,I3,6X,I4,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 ) 00620103 ! 66: C 00630103 ! 67: C 00640103 ! 68: C ********************************************************** 00650103 ! 69: C 00660103 ! 70: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00670103 ! 71: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00680103 ! 72: C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00690103 ! 73: C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00700103 ! 74: C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00710103 ! 75: C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00720103 ! 76: C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00730103 ! 77: C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00740103 ! 78: C OF EXECUTING THESE TESTS. 00750103 ! 79: C 00760103 ! 80: C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00770103 ! 81: C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00780103 ! 82: C 00790103 ! 83: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00800103 ! 84: C 00810103 ! 85: C DEPARTMENT OF THE NAVY 00820103 ! 86: C FEDERAL COBOL COMPILER TESTING SERVICE 00830103 ! 87: C WASHINGTON, D.C. 20376 00840103 ! 88: C 00850103 ! 89: C ********************************************************** 00860103 ! 90: C 00870103 ! 91: C 00880103 ! 92: C 00890103 ! 93: C INITIALIZATION SECTION 00900103 ! 94: C 00910103 ! 95: C INITIALIZE CONSTANTS 00920103 ! 96: C ************** 00930103 ! 97: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00940103 ! 98: I01 = 5 00950103 ! 99: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00960103 ! 100: I02 = 6 00970103 ! 101: C SYSTEM ENVIRONMENT SECTION 00980103 ! 102: C 00990103 ! 103: I01 = 5 01000103 ! 104: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01010103 ! 105: C (UNIT NUMBER FOR CARD READER). 01020103 ! 106: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01030103 ! 107: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01040103 ! 108: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01050103 ! 109: C 01060103 ! 110: I02 = 6 01070103 ! 111: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01080103 ! 112: C (UNIT NUMBER FOR PRINTER). 01090103 ! 113: CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01100103 ! 114: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01110103 ! 115: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01120103 ! 116: C 01130103 ! 117: IVPASS=0 01140103 ! 118: IVFAIL=0 01150103 ! 119: IVDELE=0 01160103 ! 120: ICZERO=0 01170103 ! 121: C 01180103 ! 122: C WRITE PAGE HEADERS 01190103 ! 123: WRITE (I02,90000) 01200103 ! 124: WRITE (I02,90001) 01210103 ! 125: WRITE (I02,90002) 01220103 ! 126: WRITE (I02, 90002) 01230103 ! 127: WRITE (I02,90003) 01240103 ! 128: WRITE (I02,90002) 01250103 ! 129: WRITE (I02,90004) 01260103 ! 130: WRITE (I02,90002) 01270103 ! 131: WRITE (I02,90011) 01280103 ! 132: WRITE (I02,90002) 01290103 ! 133: WRITE (I02,90002) 01300103 ! 134: WRITE (I02,90005) 01310103 ! 135: WRITE (I02,90006) 01320103 ! 136: WRITE (I02,90002) 01330103 ! 137: C 01340103 ! 138: C DEFAULT ASSIGNMENT FOR FILE 04 IS I09 = 7 01350103 ! 139: I09 = 7 01360103 ! 140: OPEN(UNIT=I09,ACCESS='SEQUENTIAL',FORM='FORMATTED') 01370103 ! 141: CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 01380103 ! 142: C 01390103 ! 143: C WRITE SECTION.... 01400103 ! 144: C 01410103 ! 145: C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I09 THAT IS 01420103 ! 146: C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF 01430103 ! 147: C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE 01440103 ! 148: C ROUTINE FM103 AND FOR PURPOSES OF IDENTIFICATION IS FILE 04. 01450103 ! 149: C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01460103 ! 150: C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE 01470103 ! 151: C SET BY ASSIGNMENT STATEMENTS. 01480103 ! 152: IPROG = 103 01490103 ! 153: IFILE = 04 01500103 ! 154: ILUN = I09 01510103 ! 155: ITOTR = 31 01520103 ! 156: IRLGN = 80 01530103 ! 157: IEOF = 0000 01540103 ! 158: ICON01 = 32767 01550103 ! 159: RCON01 = 12.34 01560103 ! 160: ICON02 = 12345 01570103 ! 161: RCON02 = .9999 01580103 ! 162: IFLIP = 1 01590103 ! 163: DO 504 IRNUM = 1, 31 01600103 ! 164: IF ( IRNUM .EQ. 31 ) IEOF = 9999 01610103 ! 165: IF ( IFLIP - 1 ) 502, 502, 503 01620103 ! 166: 502 WRITE ( I09, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01630103 ! 167: 1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12 01640103 ! 168: IFLIP = 2 01650103 ! 169: GO TO 504 01660103 ! 170: 503 WRITE ( I09, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01670103 ! 171: 1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13 01680103 ! 172: IFLIP = 1 01690103 ! 173: 504 CONTINUE 01700103 ! 174: WRITE (I02,77706) 01710103 ! 175: C 01720103 ! 176: C REWIND SECTION 01730103 ! 177: C 01740103 ! 178: REWIND I09 01750103 ! 179: C 01760103 ! 180: C READ SECTION.... 01770103 ! 181: C 01780103 ! 182: C 01790103 ! 183: IVTNUM = 55 01800103 ! 184: C 01810103 ! 185: C **** TEST 55 THRU 85 **** 01820103 ! 186: C TEST 55 THRU 85 - THESE TESTS CHECK THE RECORD NUMBER AND 01830103 ! 187: C CONTENTS OF SEVERAL OF THE DATA ITEMS WHICH REMAIN CONSTANT FOR 01840103 ! 188: C ALL OF THE RECORDS. A DIFFERENT USE OF THE X SKIP FIELD FORMAT 01850103 ! 189: C IS USED IN READING THE FILE THAN WAS USED TO WRITE THE FILE. 01860103 ! 190: C 01870103 ! 191: IFLIP = 1 01880103 ! 192: DO 556 IRNUM = 1, 31 01890103 ! 193: C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 55 - 85.01900103 ! 194: IVON01 = 0 01910103 ! 195: C READ THE FILE.... 01920103 ! 196: IF ( IFLIP - 1 ) 552, 552, 553 01930103 ! 197: 552 READ ( I09,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 01940103 ! 198: IFLIP = 2 01950103 ! 199: GO TO 554 01960103 ! 200: 553 READ ( I09,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 01970103 ! 201: IFLIP = 1 01980103 ! 202: 554 CONTINUE 01990103 ! 203: IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02000103 ! 204: C IRNO SHOULD BE THE RECORD NUMBER.... 02010103 ! 205: IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02020103 ! 206: C ICON03 SHOULD EQUAL 32767 .... 02030103 ! 207: IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02040103 ! 208: C ICON04 SHOULD EQUAL 'A' .... 02050103 ! 209: IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02060103 ! 210: C ICON05 SHOULD EQUAL 12345 .... 02070103 ! 211: IF(RCON03.GE. .99985 .OR. RCON03.LE. .99995) IVON01=IVON01+1 02080103 ! 212: C RCON03 SHOULD EQUAL .9999 .... 02090103 ! 213: IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1 02100103 ! 214: C ICON06 SHOULD EQUAL 'O' .... 02110103 ! 215: IF ( IVON01 - 6 ) 20550, 10550, 20550 02120103 ! 216: C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02130103 ! 217: C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02140103 ! 218: C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02150103 ! 219: 10550 IVPASS = IVPASS + 1 02160103 ! 220: WRITE (I02,80001) IVTNUM 02170103 ! 221: GO TO 555 02180103 ! 222: 20550 IVFAIL = IVFAIL + 1 02190103 ! 223: IVCOMP = IVON01 02200103 ! 224: IVCORR = 6 02210103 ! 225: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220103 ! 226: 555 CONTINUE 02230103 ! 227: IVTNUM = IVTNUM + 1 02240103 ! 228: C INCREMENT THE TEST NUMBER.... 02250103 ! 229: 556 CONTINUE 02260103 ! 230: IF ( ICZERO ) 30550, 861, 30550 02270103 ! 231: 30550 IVDELE = IVDELE + 1 02280103 ! 232: WRITE (I02,80003) IVTNUM 02290103 ! 233: 861 CONTINUE 02300103 ! 234: IVTNUM = 86 02310103 ! 235: C 02320103 ! 236: C **** TEST 86 **** 02330103 ! 237: C TEST 86 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE 02340103 ! 238: C 31ST RECORD.. 02350103 ! 239: C 02360103 ! 240: IF (ICZERO) 30860, 860, 30860 02370103 ! 241: 860 CONTINUE 02380103 ! 242: IVCOMP = IEND 02390103 ! 243: GO TO 40860 02400103 ! 244: 30860 IVDELE = IVDELE + 1 02410103 ! 245: WRITE (I02,80003) IVTNUM 02420103 ! 246: IF (ICZERO) 40860, 871, 40860 02430103 ! 247: 40860 IF ( IVCOMP - 9999 ) 20860, 10860, 20860 02440103 ! 248: 10860 IVPASS = IVPASS + 1 02450103 ! 249: WRITE (I02,80001) IVTNUM 02460103 ! 250: GO TO 871 02470103 ! 251: 20860 IVFAIL = IVFAIL + 1 02480103 ! 252: IVCORR = 9999 02490103 ! 253: WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02500103 ! 254: 871 CONTINUE 02510103 ! 255: C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 04 02520103 ! 256: C TO THE LINE PRINTER. 02530103 ! 257: CDB** 02540103 ! 258: C ILUN = I09 02550103 ! 259: C ITOTR = 31 02560103 ! 260: C IRLGN = 80 02570103 ! 261: C7777 REWIND ILUN 02580103 ! 262: C DO 7778 IRNUM = 1, ITOTR 02590103 ! 263: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02600103 ! 264: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02610103 ! 265: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 02620103 ! 266: C7778 CONTINUE 02630103 ! 267: C GO TO 7782 02640103 ! 268: C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02650103 ! 269: C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02660103 ! 270: C GO TO 7784 02670103 ! 271: C7781 WRITE (I02,77703) ILUN,ITOTR 02680103 ! 272: C GO TO 7784 02690103 ! 273: C7782 WRITE (I02,77704) ILUN, ITOTR 02700103 ! 274: C DO 7783 I = 1, 5 02710103 ! 275: C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02720103 ! 276: C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02730103 ! 277: C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02740103 ! 278: C7783 CONTINUE 02750103 ! 279: C7784 GO TO 99999 02760103 ! 280: CDE** 02770103 ! 281: C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02780103 ! 282: 99999 CONTINUE 02790103 ! 283: WRITE (I02,90002) 02800103 ! 284: WRITE (I02,90006) 02810103 ! 285: WRITE (I02,90002) 02820103 ! 286: WRITE (I02,90002) 02830103 ! 287: WRITE (I02,90007) 02840103 ! 288: WRITE (I02,90002) 02850103 ! 289: WRITE (I02,90008) IVFAIL 02860103 ! 290: WRITE (I02,90009) IVPASS 02870103 ! 291: WRITE (I02,90010) IVDELE 02880103 ! 292: C 02890103 ! 293: C 02900103 ! 294: C TERMINATE ROUTINE EXECUTION 02910103 ! 295: STOP 02920103 ! 296: C 02930103 ! 297: C FORMAT STATEMENTS FOR PAGE HEADERS 02940103 ! 298: 90000 FORMAT (1H1) 02950103 ! 299: 90002 FORMAT (1H ) 02960103 ! 300: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 02970103 ! 301: 90003 FORMAT (1H ,21X,11HVERSION 1.0) 02980103 ! 302: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 02990103 ! 303: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 03000103 ! 304: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 03010103 ! 305: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 03020103 ! 306: C 03030103 ! 307: C FORMAT STATEMENTS FOR RUN SUMMARIES 03040103 ! 308: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 03050103 ! 309: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 03060103 ! 310: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) 03070103 ! 311: C 03080103 ! 312: C FORMAT STATEMENTS FOR TEST RESULTS 03090103 ! 313: 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 03100103 ! 314: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 03110103 ! 315: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 03120103 ! 316: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 03130103 ! 317: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 03140103 ! 318: C 03150103 ! 319: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM103) 03160103 ! 320: END 03170103
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.