![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM910.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 FM910.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***********************************************************************00010910 ! 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***** FM910 00020910 ! 6: C***** DIRAF2 - (411) 00030910 ! 7: C***** THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911 00040910 ! 8: C***********************************************************************00050910 ! 9: C***** TESTING OF DIRECT ACCESS FILES ANS REF 00060910 ! 10: C***** UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT 12.5 00070910 ! 11: C***** ACCESS TO THE SAME FILE 00080910 ! 12: C***** NAMED FILE AND SCRATCH FILE 00090910 ! 13: C***** 00100910 ! 14: C***** USES SUBROUTINE SN911 00110910 ! 15: C***** 00120910 ! 16: CBB** ********************** BBCCOMNT **********************************00130910 ! 17: C**** 00140910 ! 18: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150910 ! 19: C**** VERSION 2.0 00160910 ! 20: C**** 00170910 ! 21: C**** 00180910 ! 22: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190910 ! 23: C**** GENERAL SERVICES ADMINISTRATION 00200910 ! 24: C**** FEDERAL SOFTWARE TESTING CENTER 00210910 ! 25: C**** 5203 LEESBURG PIKE, SUITE 1100 00220910 ! 26: C**** FALLS CHURCH, VA. 22041 00230910 ! 27: C**** 00240910 ! 28: C**** (703) 756-6153 00250910 ! 29: C**** 00260910 ! 30: CBE** ********************** BBCCOMNT **********************************00270910 ! 31: C***** 00280910 ! 32: C***** S P E C I F I C A T I O N S SEGMENT 910 00290910 ! 33: DIMENSION L1I(10), N1I(15), F1S(10), H1S(15) 00300910 ! 34: CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15) 00310910 ! 35: LOGICAL AVB, BVB, C1B(10), E1B(15) 00320910 ! 36: DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15) 00330910 ! 37: COMPLEX AVC, BVC, C1C(10), D1C(15) 00340910 ! 38: C***** 00350910 ! 39: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00360910 ! 40: CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00370910 ! 41: CHARACTER*15 CDIR 00380910 ! 42: C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100 00390910 ! 43: C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00400910 ! 44: CBB** ********************** BBCINITA **********************************00410910 ! 45: C**** SPECIFICATION STATEMENTS 00420910 ! 46: C**** 00430910 ! 47: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00440910 ! 48: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00450910 ! 49: CBE** ********************** BBCINITA **********************************00460910 ! 50: CBB** ********************** BBCINITB **********************************00470910 ! 51: C**** INITIALIZE SECTION 00480910 ! 52: DATA ZVERS, ZVERSD, ZDATE 00490910 ! 53: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00500910 ! 54: DATA ZCOMPL, ZNAME, ZTAPE 00510910 ! 55: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00520910 ! 56: DATA ZPROJ, ZTAPED, ZPROG 00530910 ! 57: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00540910 ! 58: DATA REMRKS /' '/ 00550910 ! 59: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00560910 ! 60: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00570910 ! 61: C**** 00580910 ! 62: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00590910 ! 63: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00600910 ! 64: CZ03 ZPROG = 'PROGRAM NAME' 00610910 ! 65: ZDATE = '07-Nov-85 ' *RP ! 66: ZCOMPL = 'CCI 5.2 ' *RP ! 67: ZPROJ = 'TC-85- -410' *RP ! 68: ZNAME = ' ' *RP ! 69: ZTAPE = ' ' *RP ! 70: ZTAPED = '850703 ' *RP ! 71: C 00680910 ! 72: IVPASS = 0 00690910 ! 73: IVFAIL = 0 00700910 ! 74: IVDELE = 0 00710910 ! 75: IVINSP = 0 00720910 ! 76: IVTOTL = 0 00730910 ! 77: IVTOTN = 0 00740910 ! 78: ICZERO = 0 00750910 ! 79: C 00760910 ! 80: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00770910 ! 81: I01 = 05 00780910 ! 82: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00790910 ! 83: I02 = 06 00800910 ! 84: C 00810910 ! 85: I01 = 5 00820910 ! 86: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00830910 ! 87: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00840910 ! 88: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00850910 ! 89: C 00860910 ! 90: I02 = 6 00870910 ! 91: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00880910 ! 92: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00890910 ! 93: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00900910 ! 94: C 00910910 ! 95: CBE** ********************** BBCINITB **********************************00920910 ! 96: C***** 00930910 ! 97: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00940910 ! 98: C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00950910 ! 99: C***** 00960910 ! 100: C I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00970910 ! 101: I10 = 24 00980910 ! 102: OPEN(UNIT=I10,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 00990910 ! 103: C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 01000910 ! 104: C***** 01010910 ! 105: C I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE. 01020910 ! 106: I11 = 25 01030910 ! 107: OPEN(UNIT=I11,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 01040910 ! 108: C SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25. 01050910 ! 109: C***** 01060910 ! 110: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01070910 ! 111: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01080910 ! 112: C***** UNFORMATTED FILE. 01090910 ! 113: C***** 01100910 ! 114: C CDIR CONTAINS THE FILE NAME FOR UNIT I10. 01110910 ! 115: CDIR = ' DIRFILE' 01120910 ! 116: C 01130910 ! 117: CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 01140910 ! 118: C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01150910 ! 119: C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'. 01160910 ! 120: C***** FILE NUMBER AND NAME ASSIGNMENT 01170910 ! 121: NUVI = I02 01180910 ! 122: IMVI = I10 01190910 ! 123: KMVI = I11 01200910 ! 124: IVTOTL = 6 01210910 ! 125: ZPROG = 'FM910' 01220910 ! 126: CBB** ********************** BBCHED0A **********************************01230910 ! 127: C**** 01240910 ! 128: C**** WRITE REPORT TITLE 01250910 ! 129: C**** 01260910 ! 130: WRITE (I02, 90002) 01270910 ! 131: WRITE (I02, 90006) 01280910 ! 132: WRITE (I02, 90007) 01290910 ! 133: WRITE (I02, 90008) ZVERS, ZVERSD 01300910 ! 134: WRITE (I02, 90009) ZPROG, ZPROG 01310910 ! 135: WRITE (I02, 90010) ZDATE, ZCOMPL 01320910 ! 136: CBE** ********************** BBCHED0A **********************************01330910 ! 137: C***** 01340910 ! 138: C***** HEADER FOR SEGMENT 910 01350910 ! 139: WRITE(NUVI,41100) 01360910 ! 140: 41100 FORMAT(1H ,/46H DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE// 01370910 ! 141: 1 41H WITH OPTION TO OPEN AS A SEQUENTIAL FILE// 01380910 ! 142: 2 16H ANS REF. - 12.5) 01390910 ! 143: CBB** ********************** BBCHED0B **********************************01400910 ! 144: C**** WRITE DETAIL REPORT HEADERS 01410910 ! 145: C**** 01420910 ! 146: WRITE (I02,90004) 01430910 ! 147: WRITE (I02,90004) 01440910 ! 148: WRITE (I02,90013) 01450910 ! 149: WRITE (I02,90014) 01460910 ! 150: WRITE (I02,90015) IVTOTL 01470910 ! 151: CBE** ********************** BBCHED0B **********************************01480910 ! 152: C***** INITIALIZE DATA 01490910 ! 153: CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K) 01500910 ! 154: MMVI = 0 01510910 ! 155: C***** 01520910 ! 156: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132, 01530910 ! 157: 1 STATUS='NEW') 01540910 ! 158: C***** WRITE DIRECT FILE IN SEQUENTIAL ORDER 01550910 ! 159: DO 41101 IVI = 1,10 01560910 ! 160: AVS = F1S (IVI) 01570910 ! 161: A4VK = A41K (IVI) 01580910 ! 162: AVB = C1B (IVI) 01590910 ! 163: AVD = D1D (IVI) 01600910 ! 164: AVC = C1C (IVI) 01610910 ! 165: WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC 01620910 ! 166: 41101 CONTINUE 01630910 ! 167: C***** CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL 01640910 ! 168: INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK) 01650910 ! 169: CLOSE(UNIT=IMVI) 01660910 ! 170: IF(D4VK .EQ. 'YES ') GOTO 41103 01670910 ! 171: WRITE(NUVI,41102) 01680910 ! 172: 41102 FORMAT(1H ,48X,31HTESTS 2 THRU 6 ARE EXPECTED TO / 01690910 ! 173: 1 1H ,48X,31HEXECUTE / 01700910 ! 174: 2 1H ,48X,31HTEST 1 IS OPTIONAL AND IS NOT / 01710910 ! 175: 3 1H ,48X,31HEXECUTED IF DIRECT ACCESS / 01720910 ! 176: 4 1H ,48X,31HFILE CANNOT BE REOPENED AS / 01730910 ! 177: 5 1H ,48X,31HA SEQUENTIAL FILE ) 01740910 ! 178: GOTO 41119 01750910 ! 179: CT001* TEST 1 READ IT SEQUENTIALY 01760910 ! 180: 41103 IVTNUM = 1 01770910 ! 181: IVCOMP = 0 01780910 ! 182: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD', 01790910 ! 183: 1 FORM='UNFORMATTED') 01800910 ! 184: REWIND(UNIT=IMVI) 01810910 ! 185: DO 41104 IVI = 1, 10 01820910 ! 186: READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC 01830910 ! 187: IF (IVI .NE. KVI) GOTO 20010 01840910 ! 188: IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010 01850910 ! 189: IF (B4VK .NE. A41K(IVI)) GOTO 20010 01860910 ! 190: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 01870910 ! 191: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 01880910 ! 192: IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010 01890910 ! 193: IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 01900910 ! 194: 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 01910910 ! 195: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010 01920910 ! 196: GO TO 41104 01930910 ! 197: 20010 IVCOMP = IVCOMP + 1 01940910 ! 198: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01950910 ! 199: WRITE (NUVI, 70010) IVTNUM, IVI 01960910 ! 200: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 01970910 ! 201: 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 01980910 ! 202: 1 C1C(IVI) 01990910 ! 203: 70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2) 02000910 ! 204: 70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02010910 ! 205: 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H)/02020910 ! 206: 1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02030910 ! 207: 1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H))02040910 ! 208: 41104 CONTINUE 02050910 ! 209: IF (IVCOMP - 0) 0011, 10010, 0011 02060910 ! 210: 10010 IVPASS = IVPASS + 1 02070910 ! 211: WRITE (NUVI, 80002) IVTNUM 02080910 ! 212: 0011 CONTINUE 02090910 ! 213: C***** 02100910 ! 214: 41118 CLOSE(UNIT=IMVI) 02110910 ! 215: CT002* TEST 2 REOPEN AS DIRECT FILE, 02120910 ! 216: C***** AND READ IN SEQUENTIAL ORDER 02130910 ! 217: 41119 IVTNUM = 2 02140910 ! 218: IVCOMP = 0 02150910 ! 219: C***** 02160910 ! 220: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02170910 ! 221: 1 RECL=132) 02180910 ! 222: DO 41120 IVI = 1, 10 02190910 ! 223: READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC 02200910 ! 224: IF (IVI .NE. KVI) GOTO 20020 02210910 ! 225: IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020 02220910 ! 226: IF (B4VK .NE. A41K(IVI)) GOTO 20020 02230910 ! 227: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 02240910 ! 228: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20020 02250910 ! 229: IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020 02260910 ! 230: IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 02270910 ! 231: 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 02280910 ! 232: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020 02290910 ! 233: GO TO 41120 02300910 ! 234: 20020 IVCOMP = IVCOMP + 1 02310910 ! 235: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02320910 ! 236: WRITE (NUVI, 70010) IVTNUM, IVI 02330910 ! 237: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 02340910 ! 238: 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 02350910 ! 239: 1 C1C(IVI) 02360910 ! 240: 41120 CONTINUE 02370910 ! 241: IF (IVCOMP - 0) 0021, 10020, 0021 02380910 ! 242: 10020 IVPASS = IVPASS + 1 02390910 ! 243: WRITE (NUVI, 80002) IVTNUM 02400910 ! 244: 0021 CONTINUE 02410910 ! 245: C***** 02420910 ! 246: 41121 CLOSE(UNIT=IMVI) 02430910 ! 247: CT003* TEST 3 READ IT AS DIRECT 02440910 ! 248: C***** FILE IN NONSEQUENTIAL ORDER 02450910 ! 249: IVTNUM = 3 02460910 ! 250: IVCOMP = 0 02470910 ! 251: C***** 02480910 ! 252: OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02490910 ! 253: 1 RECL=132) 02500910 ! 254: DO 41122 IVI = 1, 10 02510910 ! 255: JVI = L1I(IVI) 02520910 ! 256: READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC 02530910 ! 257: IF (KVI .NE. JVI) GOTO 20030 02540910 ! 258: IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030 02550910 ! 259: IF (B4VK .NE. A41K(JVI)) GOTO 20030 02560910 ! 260: IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 02570910 ! 261: 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20030 02580910 ! 262: IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030 02590910 ! 263: IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT. 02600910 ! 264: 1 REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI))) 02610910 ! 265: 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030 02620910 ! 266: GO TO 41122 02630910 ! 267: 20030 IVCOMP = IVCOMP + 1 02640910 ! 268: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02650910 ! 269: WRITE (NUVI, 70010) IVTNUM, JVI 02660910 ! 270: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 02670910 ! 271: 1 F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI), 02680910 ! 272: 1 C1C(JVI) 02690910 ! 273: 41122 CONTINUE 02700910 ! 274: IF (IVCOMP - 0) 0031, 10030, 0031 02710910 ! 275: 10030 IVPASS = IVPASS + 1 02720910 ! 276: WRITE (NUVI, 80002) IVTNUM 02730910 ! 277: 0031 CONTINUE 02740910 ! 278: C***** 02750910 ! 279: 41123 OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH') 02760910 ! 280: C***** 02770910 ! 281: CT004* TEST 4 CHECK RECL AND NEXTREC ON SCRATCH FILE 02780910 ! 282: IVTNUM = 4 02790910 ! 283: INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 02800910 ! 284: IF (IVI .NE. 80) GOTO 20040 02810910 ! 285: IF (KVI .NE. 1) GOTO 20040 02820910 ! 286: 10040 IVPASS = IVPASS + 1 02830910 ! 287: WRITE (NUVI, 80002) IVTNUM 02840910 ! 288: GO TO 0041 02850910 ! 289: 20040 IVFAIL = IVFAIL + 1 02860910 ! 290: WRITE (NUVI, 70030) IVTNUM 02870910 ! 291: WRITE (NUVI, 70040) IVI, KVI 02880910 ! 292: 70030 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 02890910 ! 293: 70040 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 02900910 ! 294: 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 1) 02910910 ! 295: 0041 CONTINUE 02920910 ! 296: C***** 02930910 ! 297: C***** WRITE DIRECT ACCESS 02940910 ! 298: C***** SCRATCH FILE IN NONSEQUENTIAL ORDER 02950910 ! 299: DO 41126 IVI = 1,15 02960910 ! 300: JVI = N1I (IVI) 02970910 ! 301: AVS = H1S (JVI) 02980910 ! 302: A4VK = C41K (JVI) 02990910 ! 303: AVB = E1B (JVI) 03000910 ! 304: AVC = D1C(JVI) 03010910 ! 305: AVD = B1D(JVI) 03020910 ! 306: WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS 03030910 ! 307: 41126 CONTINUE 03040910 ! 308: CT005* TEST 5 CHECK DIRECT ACCESS SCRATCH FILE 03050910 ! 309: C***** BY READING IT IN NONSEQUENTIAL ORDER 03060910 ! 310: IVTNUM = 5 03070910 ! 311: IVCOMP = 0 03080910 ! 312: MMVI = -1 03090910 ! 313: DO 41127 IVI = 15,1,-1 03100910 ! 314: JVI = N1I (IVI) 03110910 ! 315: READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS 03120910 ! 316: IF (KVI .NE. JVI) GOTO 20050 03130910 ! 317: IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050 03140910 ! 318: IF (B4VK .NE. C41K(JVI)) GOTO 20050 03150910 ! 319: IF ((BVB .AND. .NOT. E1B(JVI)) .OR. 03160910 ! 320: 1 (.NOT. BVB .AND. E1B(JVI))) GOTO 20050 03170910 ! 321: IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050 03180910 ! 322: IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT. 03190910 ! 323: 1 REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI))) 03200910 ! 324: 2 .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050 03210910 ! 325: GO TO 41127 03220910 ! 326: 20050 IVCOMP = IVCOMP + 1 03230910 ! 327: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 03240910 ! 328: WRITE (NUVI, 70010) IVTNUM, JVI 03250910 ! 329: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 03260910 ! 330: 1 H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI), 03270910 ! 331: 1 D1C(JVI) 03280910 ! 332: 41127 CONTINUE 03290910 ! 333: IF (IVCOMP - 0) 0051, 10050, 0051 03300910 ! 334: 10050 IVPASS = IVPASS + 1 03310910 ! 335: WRITE (NUVI, 80002) IVTNUM 03320910 ! 336: 0051 CONTINUE 03330910 ! 337: C***** 03340910 ! 338: CT006* TEST 6 CHECK RECL AND NEXTREC AFTER READING 03350910 ! 339: IVTNUM = 6 03360910 ! 340: INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 03370910 ! 341: IF (IVI .NE. 80) GOTO 20060 03380910 ! 342: IF (KVI .NE. 6) GOTO 20060 03390910 ! 343: 10060 IVPASS = IVPASS + 1 03400910 ! 344: WRITE (NUVI, 80002) IVTNUM 03410910 ! 345: GO TO 0061 03420910 ! 346: 20060 IVFAIL = IVFAIL + 1 03430910 ! 347: WRITE (NUVI, 70050) IVTNUM 03440910 ! 348: WRITE (NUVI, 70060) IVI, KVI 03450910 ! 349: 70050 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC) 03460910 ! 350: 70060 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/ 03470910 ! 351: 1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 6) 03480910 ! 352: 0061 CONTINUE 03490910 ! 353: C***** 03500910 ! 354: CLOSE (UNIT=IMVI,STATUS='DELETE') 03510*TI ! 355: C***** 03520910 ! 356: C**** 04070910 ! 357: CBB** ********************** BBCSUM0 **********************************04080910 ! 358: C**** WRITE OUT TEST SUMMARY 04090910 ! 359: C**** 04100910 ! 360: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04110910 ! 361: WRITE (I02, 90004) 04120910 ! 362: WRITE (I02, 90014) 04130910 ! 363: WRITE (I02, 90004) 04140910 ! 364: WRITE (I02, 90020) IVPASS 04150910 ! 365: WRITE (I02, 90022) IVFAIL 04160910 ! 366: WRITE (I02, 90024) IVDELE 04170910 ! 367: WRITE (I02, 90026) IVINSP 04180910 ! 368: WRITE (I02, 90028) IVTOTN, IVTOTL 04190910 ! 369: CBE** ********************** BBCSUM0 **********************************04200910 ! 370: CBB** ********************** BBCFOOT0 **********************************04210910 ! 371: C**** WRITE OUT REPORT FOOTINGS 04220910 ! 372: C**** 04230910 ! 373: WRITE (I02,90016) ZPROG, ZPROG 04240910 ! 374: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04250910 ! 375: WRITE (I02,90019) 04260910 ! 376: CBE** ********************** BBCFOOT0 **********************************04270910 ! 377: CBB** ********************** BBCFMT0A **********************************04280910 ! 378: C**** FORMATS FOR TEST DETAIL LINES 04290910 ! 379: C**** 04300910 ! 380: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 04310910 ! 381: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 04320910 ! 382: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 04330910 ! 383: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 04340910 ! 384: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 04350910 ! 385: 1I6,/,1H ,15X,10HCORRECT= ,I6) 04360910 ! 386: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04370910 ! 387: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 04380910 ! 388: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04390910 ! 389: 1A21,/,1H ,16X,10HCORRECT= ,A21) 04400910 ! 390: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 04410910 ! 391: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 04420910 ! 392: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 04430910 ! 393: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 04440910 ! 394: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 04450910 ! 395: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 04460910 ! 396: 80050 FORMAT (1H ,48X,A31) 04470910 ! 397: CBE** ********************** BBCFMT0A **********************************04480910 ! 398: CBB** ********************** BBCFMAT1 **********************************04490910 ! 399: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04500910 ! 400: C**** 04510910 ! 401: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04520910 ! 402: 1D17.10,/,1H ,16X,10HCORRECT= ,D17.10) 04530910 ! 403: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31) 04540910 ! 404: 80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31) 04550910 ! 405: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04560910 ! 406: 80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31) 04570910 ! 407: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04580910 ! 408: 80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31) 04590910 ! 409: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 04600910 ! 410: 11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= , 04610910 ! 411: 21H(,F12.5,2H, ,F12.5,1H)) 04620910 ! 412: CBE** ********************** BBCFMAT1 **********************************04630910 ! 413: CBB** ********************** BBCFMT0B **********************************04640910 ! 414: C**** FORMAT STATEMENTS FOR PAGE HEADERS 04650910 ! 415: C**** 04660910 ! 416: 90002 FORMAT (1H1) 04670910 ! 417: 90004 FORMAT (1H ) 04680910 ! 418: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 04690910 ! 419: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 04700910 ! 420: 90008 FORMAT (1H ,21X,A13,A17) 04710910 ! 421: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 04720910 ! 422: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 04730910 ! 423: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 04740910 ! 424: 1 7X,7HREMARKS,24X) 04750910 ! 425: 90014 FORMAT (1H ,46H----------------------------------------------, 04760910 ! 426: 1 33H---------------------------------) 04770910 ! 427: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 04780910 ! 428: C**** 04790910 ! 429: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04800910 ! 430: C**** 04810910 ! 431: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 04820910 ! 432: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 04830910 ! 433: 1 A13) 04840910 ! 434: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 04850910 ! 435: C**** 04860910 ! 436: C**** FORMAT STATEMENTS FOR RUN SUMMARY 04870910 ! 437: C**** 04880910 ! 438: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 04890910 ! 439: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 04900910 ! 440: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 04910910 ! 441: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 04920910 ! 442: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 04930910 ! 443: CBE** ********************** BBCFMT0B **********************************04940910 ! 444: C***** 04950910 ! 445: C***** END OF TEST SEGMENT 910 04960910 ! 446: STOP 04970910 ! 447: END 04980910 ! 448: C********************************************************************** 00010911 ! 449: C DATE***82/08/02*18.33.46 ! 450: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 451: C AUDIT FCVS78 V2.0 ! 452: C***** FM911 00020911 ! 453: C***** 00030911 ! 454: C***** SN911 EAQ - (806) 00040911 ! 455: C***** THIS SUBROUTINE IS CALLED BY FM910 00050911 ! 456: C********************************************************************** 00060911 ! 457: SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D, 00070911 ! 458: 1 BW1D,CW1C, DW1C, A4W1K, C4W1K) 00080911 ! 459: C***** 00090911 ! 460: C***** SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES 00100911 ! 461: C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110911 ! 462: C***** 00120911 ! 463: DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15) 00130911 ! 464: REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15) 00140911 ! 465: LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15) 00150911 ! 466: DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15) 00160911 ! 467: COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15) 00170911 ! 468: CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15) 00180911 ! 469: C***** 00190911 ! 470: DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/ 00200911 ! 471: DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/ 00210911 ! 472: DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ 00220911 ! 473: DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1, 00230911 ! 474: 1 3.4, 5.60, 34.9, 3.48, 23.8/ 00240911 ! 475: DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'00250911 ! 476: 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ 00260911 ! 477: DATA C4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'00270911 ! 478: 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL', 'KDFJ', 'ABCD'00280911 ! 479: 2 , 'ASDF', 'GHJK', 'QWER'/ 00290911 ! 480: DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 00300911 ! 481: 1 .FALSE., .TRUE., .TRUE., .FALSE./ 00310911 ! 482: DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00320911 ! 483: 1 .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE., 00330911 ! 484: 2 .FALSE., .TRUE., .FALSE./ 00340911 ! 485: DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1, 00350911 ! 486: 1 2.34D1, 398.0D0, 3.49D-1, 0.99D1/ 00360911 ! 487: DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1, 00370911 ! 488: 1 34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3, 00380911 ! 489: 2 389.098D1, 483.98D0, 3456.0D-4/ 00390911 ! 490: DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00400911 ! 491: 1 (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00410911 ! 492: 2 (2.56, 2.1), (3.4, 4.5)/ 00420911 ! 493: DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00430911 ! 494: 1 (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9), 00440911 ! 495: 2 (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00450911 ! 496: 3 (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/ 00460911 ! 497: 00470911 ! 498: C***** 00480911 ! 499: DO 1 IVI = 1, 10 00490911 ! 500: LW1I(IVI) = LT1I(IVI) 00500911 ! 501: FW1S(IVI) = FT1S(IVI) 00510911 ! 502: CW1B(IVI) = CT1B(IVI) 00520911 ! 503: DW1D(IVI) = DT1D(IVI) 00530911 ! 504: CW1C(IVI) = CT1C(IVI) 00540911 ! 505: A4W1K(IVI) = A4T1K(IVI) 00550911 ! 506: 1 CONTINUE 00560911 ! 507: C***** 00570911 ! 508: DO 2 IVI = 1, 15 00580911 ! 509: NW1I(IVI) = NT1I(IVI) 00590911 ! 510: HW1S(IVI) = HT1S(IVI) 00600911 ! 511: EW1B(IVI) = ET1B(IVI) 00610911 ! 512: BW1D(IVI) = BT1D(IVI) 00620911 ! 513: DW1C(IVI) = DT1C(IVI) 00630911 ! 514: C4W1K(IVI) = C4T1K(IVI) 00640911 ! 515: 2 CONTINUE 00650911 ! 516: C***** 00660911 ! 517: RETURN 00670911 ! 518: END 00680911
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.