![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM407.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 FM407.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***********************************************************************00010407 ! 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***** FORTRAN 77 00020407 ! 6: C***** FM407 00030407 ! 7: C***** DIRAF1 - (410) 00040407 ! 8: C***** THIS PROGRAM CALLS SUBROUTINE SN408 00050407 ! 9: C***********************************************************************00060407 ! 10: C***** TESTING OF DIRECT ACCESS FILES SUBSET REF00070407 ! 11: C***** UNFORMATED RECORDS ONLY 12.10.1 00080407 ! 12: C***** 00090407 ! 13: C***** 00100407 ! 14: CBB** ********************** BBCCOMNT **********************************00110407 ! 15: C**** 00120407 ! 16: C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130407 ! 17: C**** VERSION 2.0 00140407 ! 18: C**** 00150407 ! 19: C**** 00160407 ! 20: C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170407 ! 21: C**** GENERAL SERVICES ADMINISTRATION 00180407 ! 22: C**** FEDERAL SOFTWARE TESTING CENTER 00190407 ! 23: C**** 5203 LEESBURG PIKE, SUITE 1100 00200407 ! 24: C**** FALLS CHURCH, VA. 22041 00210407 ! 25: C**** 00220407 ! 26: C**** (703) 756-6153 00230407 ! 27: C**** 00240407 ! 28: CBE** ********************** BBCCOMNT **********************************00250407 ! 29: C***** 00260407 ! 30: C***** S P E C I F I C A T I O N S SEGMENT 410 00270407 ! 31: DIMENSION L1I(10), K1I(10), M1I(10), F1S(10), G1S(10) 00280407 ! 32: CHARACTER*4 A4VK, B4VK, A41K(10), B41K(10) 00290407 ! 33: LOGICAL AVB, BVB, C1B(10), D1B(10) 00300407 ! 34: C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00310407 ! 35: CBB** ********************** BBCINITA **********************************00320407 ! 36: C**** SPECIFICATION STATEMENTS 00330407 ! 37: C**** 00340407 ! 38: CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350407 ! 39: 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360407 ! 40: CBE** ********************** BBCINITA **********************************00370407 ! 41: CBB** ********************** BBCINITB **********************************00380407 ! 42: C**** INITIALIZE SECTION 00390407 ! 43: DATA ZVERS, ZVERSD, ZDATE 00400407 ! 44: 1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/ 00410407 ! 45: DATA ZCOMPL, ZNAME, ZTAPE 00420407 ! 46: 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430407 ! 47: DATA ZPROJ, ZTAPED, ZPROG 00440407 ! 48: 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450407 ! 49: DATA REMRKS /' '/ 00460407 ! 50: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470407 ! 51: C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480407 ! 52: C**** 00490407 ! 53: CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500407 ! 54: CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510407 ! 55: CZ03 ZPROG = 'PROGRAM NAME' 00520407 ! 56: ZDATE = '07-Nov-85 ' *RP ! 57: ZCOMPL = 'CCI 5.2 ' *RP ! 58: ZPROJ = 'TC-85- -410' *RP ! 59: ZNAME = ' ' *RP ! 60: ZTAPE = ' ' *RP ! 61: ZTAPED = '850703 ' *RP ! 62: C 00590407 ! 63: IVPASS = 0 00600407 ! 64: IVFAIL = 0 00610407 ! 65: IVDELE = 0 00620407 ! 66: IVINSP = 0 00630407 ! 67: IVTOTL = 0 00640407 ! 68: IVTOTN = 0 00650407 ! 69: ICZERO = 0 00660407 ! 70: C 00670407 ! 71: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680407 ! 72: I01 = 05 00690407 ! 73: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700407 ! 74: I02 = 06 00710407 ! 75: C 00720407 ! 76: I01 = 5 00730407 ! 77: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740407 ! 78: CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750407 ! 79: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760407 ! 80: C 00770407 ! 81: I02 = 6 00780407 ! 82: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790407 ! 83: CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800407 ! 84: C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810407 ! 85: C 00820407 ! 86: CBE** ********************** BBCINITB **********************************00830407 ! 87: C***** 00840407 ! 88: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00850407 ! 89: C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00860407 ! 90: C***** DIRECT, UNFORMATTED FILE. 00870407 ! 91: C***** 00880407 ! 92: C I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 00890407 ! 93: I10 = 24 00900407 ! 94: OPEN(UNIT=I10,ACCESS='DIRECT',FORM='UNFORMATTED',RECL=80) 00910407 ! 95: C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 00920407 ! 96: C***** 00930407 ! 97: C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00940407 ! 98: C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00950407 ! 99: C***** UNFORMATTED FILE. 00960407 ! 100: C***** 00970407 ! 101: C***** 00980407 ! 102: NUVI = I02 00990407 ! 103: IVTOTL = 4 01000407 ! 104: ZPROG = 'FM407' 01010407 ! 105: CBB** ********************** BBCHED0A **********************************01020407 ! 106: C**** 01030407 ! 107: C**** WRITE REPORT TITLE 01040407 ! 108: C**** 01050407 ! 109: WRITE (I02, 90002) 01060407 ! 110: WRITE (I02, 90006) 01070407 ! 111: WRITE (I02, 90007) 01080407 ! 112: WRITE (I02, 90008) ZVERS, ZVERSD 01090407 ! 113: WRITE (I02, 90009) ZPROG, ZPROG 01100407 ! 114: WRITE (I02, 90010) ZDATE, ZCOMPL 01110407 ! 115: CBE** ********************** BBCHED0A **********************************01120407 ! 116: C***** FILE NUMBER ASSIGNMENT 01130407 ! 117: IUVI = I10 01140407 ! 118: C***** 01150407 ! 119: C***** HEADER FOR SEGMENT 410 01160407 ! 120: WRITE(NUVI,41000) 01170407 ! 121: 41000 FORMAT(1H ,/ 46H DIRAF1 - (410) DIRECT ACCESS UNFORMATTED FILE// 01180407 ! 122: 1 22H SUBSET REF. - 12.10.1) 01190407 ! 123: CBB** ********************** BBCHED0B **********************************01200407 ! 124: C**** WRITE DETAIL REPORT HEADERS 01210407 ! 125: C**** 01220407 ! 126: WRITE (I02,90004) 01230407 ! 127: WRITE (I02,90004) 01240407 ! 128: WRITE (I02,90013) 01250407 ! 129: WRITE (I02,90014) 01260407 ! 130: WRITE (I02,90015) IVTOTL 01270407 ! 131: CBE** ********************** BBCHED0B **********************************01280407 ! 132: C***** 01290407 ! 133: WRITE (NUVI, 41099) 01300407 ! 134: 41099 FORMAT (1H ,48X,31HEACH TEST READS 10 RECORDS AND / 01310407 ! 135: 1 1H ,48X,31HEACH RECORD IS CHECKED, I.E., / 01320407 ! 136: 2 1H ,48X,31HTHERE ARE 10 SUBTESTS MADE FOR / 01330407 ! 137: 3 1H ,48X,31HEACH TEST ) 01340407 ! 138: C***** 01350407 ! 139: CALL SN408(L1I,K1I,M1I,F1S,G1S,C1B,D1B,A41K,B41K) 01360407 ! 140: C***** 01370407 ! 141: OPEN(IUVI, ACCESS='DIRECT',RECL=132) 01380407 ! 142: C***** WRITE 10 RECORDS IN SEQUENCE, REC = 1 TO 10 01390407 ! 143: DO 41001 IVI = 1, 10 01400407 ! 144: AVS = F1S (IVI) 01410407 ! 145: A4VK = A41K (IVI) 01420407 ! 146: AVB = C1B (IVI) 01430407 ! 147: WRITE(IUVI, REC= IVI) IVI, AVS, A4VK, AVB 01440407 ! 148: 41001 CONTINUE 01450407 ! 149: CT001* TEST 1 READ RECORDS 1 TO 10 IN SEQUENCE 01460407 ! 150: IVTNUM = 1 01470407 ! 151: IVCOMP = 0 01480407 ! 152: DO 41002 IVI = 1, 10 01490407 ! 153: READ(IUVI, REC = IVI) KVI, BVS, B4VK, BVB 01500407 ! 154: IF (IVI .NE. KVI) GOTO 20010 01510407 ! 155: IF (B4VK .NE. A41K(IVI)) GOTO 20010 01520407 ! 156: IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 01530407 ! 157: 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 01540407 ! 158: IF (BVS .NE. F1S(IVI)) GO TO 20010 01550407 ! 159: GO TO 41002 01560407 ! 160: 20010 IVCOMP = IVCOMP + 1 01570407 ! 161: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01580407 ! 162: WRITE (NUVI, 70010) IVTNUM, IVI 01590407 ! 163: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, IVI, F1S(IVI), 01600407 ! 164: 1 A41K(IVI), C1B(IVI) 01610407 ! 165: 70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2) 01620407 ! 166: 70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1/ 01630407 ! 167: 1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1) 01640407 ! 168: 41002 CONTINUE 01650407 ! 169: IF (IVCOMP - 0) 0011, 10010, 0011 01660407 ! 170: 10010 IVPASS = IVPASS + 1 01670407 ! 171: WRITE (NUVI, 80002) IVTNUM 01680407 ! 172: 0011 CONTINUE 01690407 ! 173: CT002* TEST 2 READ RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01700407 ! 174: IVTNUM = 2 01710407 ! 175: IVCOMP = 0 01720407 ! 176: DO 41013 IVI = 1, 10 01730407 ! 177: JVI = L1I(IVI) 01740407 ! 178: READ(IUVI, REC = JVI) KVI, BVS, B4VK, BVB 01750407 ! 179: IF (KVI .NE. JVI) GOTO 20020 01760407 ! 180: IF (B4VK .NE. A41K(JVI)) GOTO 20020 01770407 ! 181: IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 01780407 ! 182: 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20020 01790407 ! 183: IF (BVS .NE. F1S(JVI)) GOTO 20020 01800407 ! 184: GO TO 41013 01810407 ! 185: 20020 IVCOMP = IVCOMP + 1 01820407 ! 186: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01830407 ! 187: WRITE (NUVI, 70010) IVTNUM, JVI 01840407 ! 188: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, F1S(JVI), 01850407 ! 189: 1 A41K(JVI), C1B(JVI) 01860407 ! 190: 41013 CONTINUE 01870407 ! 191: IF (IVCOMP - 0) 0021, 10020, 0021 01880407 ! 192: 10020 IVPASS = IVPASS + 1 01890407 ! 193: WRITE (NUVI, 80002) IVTNUM 01900407 ! 194: 0021 CONTINUE 01910407 ! 195: C***** WRITE RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01920407 ! 196: 41014 DO 41015 IVI = 1, 10 01930407 ! 197: JVI = K1I (IVI) 01940407 ! 198: AVS = G1S (JVI) 01950407 ! 199: A4VK = B41K (JVI) 01960407 ! 200: AVB = D1B (JVI) 01970407 ! 201: WRITE(IUVI, REC= JVI) AVB, A4VK, JVI, AVS 01980407 ! 202: 41015 CONTINUE 01990407 ! 203: CT003* TEST 3 READ RECORDS IN SEQUENCE OF RECORD NUMBER 02000407 ! 204: IVTNUM = 3 02010407 ! 205: IVCOMP = 0 02020407 ! 206: DO 41016 IVI = 1, 10 02030407 ! 207: READ(IUVI, REC = IVI) BVB, B4VK, JVI, BVS 02040407 ! 208: IF (JVI .NE. IVI) GOTO 20030 02050407 ! 209: IF (B4VK .NE. B41K(IVI)) GOTO 20030 02060407 ! 210: IF ((BVB .AND. .NOT. D1B(IVI)) .OR. 02070407 ! 211: 1 (.NOT. BVB .AND. D1B(IVI))) GOTO 20030 02080407 ! 212: IF (BVS .NE. G1S(JVI)) GOTO 20030 02090407 ! 213: GO TO 41016 02100407 ! 214: 20030 IVCOMP = IVCOMP + 1 02110407 ! 215: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02120407 ! 216: WRITE (NUVI, 70010) IVTNUM, IVI 02130407 ! 217: WRITE (NUVI, 70020) JVI, BVS, B4VK, BVB, IVI, G1S(IVI), 02140407 ! 218: 1 B41K(IVI), D1B(IVI) 02150407 ! 219: 41016 CONTINUE 02160407 ! 220: IF (IVCOMP -0) 0031, 10030, 0031 02170407 ! 221: 10030 IVPASS = IVPASS + 1 02180407 ! 222: WRITE (NUVI, 80002) IVTNUM 02190407 ! 223: 0031 CONTINUE 02200407 ! 224: CT004* TEST 4 READ RECORDS IN A DIFFERENT ORDER SEQUENCE 02210407 ! 225: IVTNUM = 4 02220407 ! 226: IVCOMP = 0 02230407 ! 227: DO 41018 IVI = 1, 10 02240407 ! 228: JVI = M1I(IVI) 02250407 ! 229: READ(IUVI, REC = JVI) BVB, B4VK, KVI, BVS 02260407 ! 230: IF (KVI .NE. JVI) GOTO 20040 02270407 ! 231: IF (B4VK .NE. B41K(JVI)) GOTO 20040 02280407 ! 232: IF ((BVB .AND. .NOT. D1B(JVI)) .OR. 02290407 ! 233: 1 (.NOT. BVB .AND. D1B(JVI))) GOTO 20040 02300407 ! 234: IF (BVS .NE. G1S(JVI)) GOTO 20040 02310407 ! 235: GO TO 41018 02320407 ! 236: 20040 IVCOMP = IVCOMP + 1 02330407 ! 237: IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02340407 ! 238: WRITE (NUVI, 70010) IVTNUM, JVI 02350407 ! 239: WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, G1S(JVI), 02360407 ! 240: 1 B41K(JVI), D1B(JVI) 02370407 ! 241: 41018 CONTINUE 02380407 ! 242: IF (IVCOMP - 0) 0041, 10040, 0041 02390407 ! 243: 10040 IVPASS = IVPASS + 1 02400407 ! 244: WRITE (NUVI, 80002) IVTNUM 02410407 ! 245: 0041 CONTINUE 02420407 ! 246: C***** 02430407 ! 247: CBB** ********************** BBCSUM0 **********************************02710407 ! 248: C**** WRITE OUT TEST SUMMARY 02720407 ! 249: C**** 02730407 ! 250: IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02740407 ! 251: WRITE (I02, 90004) 02750407 ! 252: WRITE (I02, 90014) 02760407 ! 253: WRITE (I02, 90004) 02770407 ! 254: WRITE (I02, 90020) IVPASS 02780407 ! 255: WRITE (I02, 90022) IVFAIL 02790407 ! 256: WRITE (I02, 90024) IVDELE 02800407 ! 257: WRITE (I02, 90026) IVINSP 02810407 ! 258: WRITE (I02, 90028) IVTOTN, IVTOTL 02820407 ! 259: CBE** ********************** BBCSUM0 **********************************02830407 ! 260: CBB** ********************** BBCFOOT0 **********************************02840407 ! 261: C**** WRITE OUT REPORT FOOTINGS 02850407 ! 262: C**** 02860407 ! 263: WRITE (I02,90016) ZPROG, ZPROG 02870407 ! 264: WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02880407 ! 265: WRITE (I02,90019) 02890407 ! 266: CBE** ********************** BBCFOOT0 **********************************02900407 ! 267: CBB** ********************** BBCFMT0A **********************************02910407 ! 268: C**** FORMATS FOR TEST DETAIL LINES 02920407 ! 269: C**** 02930407 ! 270: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31) 02940407 ! 271: 80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31) 02950407 ! 272: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31) 02960407 ! 273: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31) 02970407 ! 274: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= , 02980407 ! 275: 1I6,/,1H ,15X,10HCORRECT= ,I6) 02990407 ! 276: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 03000407 ! 277: 1E12.5,/,1H ,16X,10HCORRECT= ,E12.5) 03010407 ! 278: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= , 03020407 ! 279: 1A21,/,1H ,16X,10HCORRECT= ,A21) 03030407 ! 280: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31) 03040407 ! 281: 80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31) 03050407 ! 282: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31) 03060407 ! 283: 80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31) 03070407 ! 284: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31) 03080407 ! 285: 80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31) 03090407 ! 286: 80050 FORMAT (1H ,48X,A31) 03100407 ! 287: CBE** ********************** BBCFMT0A **********************************03110407 ! 288: CBB** ********************** BBCFMT0B **********************************03120407 ! 289: C**** FORMAT STATEMENTS FOR PAGE HEADERS 03130407 ! 290: C**** 03140407 ! 291: 90002 FORMAT (1H1) 03150407 ! 292: 90004 FORMAT (1H ) 03160407 ! 293: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER) 03170407 ! 294: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM) 03180407 ! 295: 90008 FORMAT (1H ,21X,A13,A17) 03190407 ! 296: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/) 03200407 ! 297: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20) 03210407 ! 298: 90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS, 03220407 ! 299: 1 7X,7HREMARKS,24X) 03230407 ! 300: 90014 FORMAT (1H ,46H----------------------------------------------, 03240407 ! 301: 1 33H---------------------------------) 03250407 ! 302: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/) 03260407 ! 303: C**** 03270407 ! 304: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03280407 ! 305: C**** 03290407 ! 306: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/) 03300407 ! 307: 90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/, 03310407 ! 308: 1 A13) 03320407 ! 309: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982) 03330407 ! 310: C**** 03340407 ! 311: C**** FORMAT STATEMENTS FOR RUN SUMMARY 03350407 ! 312: C**** 03360407 ! 313: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED) 03370407 ! 314: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED) 03380407 ! 315: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED) 03390407 ! 316: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION) 03400407 ! 317: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED) 03410407 ! 318: CBE** ********************** BBCFMT0B **********************************03420407 ! 319: C***** 03430407 ! 320: C***** END OF TEST SEGMENT 410 03440407 ! 321: STOP 03450407 ! 322: END 03460407 ! 323: C********************************************************************** 00010408 ! 324: C DATE***82/08/02*18.33.46 ! 325: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 326: C AUDIT FCVS78 V2.0 ! 327: C***** FORTRAN 77 00020408 ! 328: C***** FM408 00030408 ! 329: C***** SN408 DAQ - (805) 00040408 ! 330: C***** THIS SUBROUTINE IS CALLED BY FM407 00050408 ! 331: C********************************************************************** 00060408 ! 332: SUBROUTINE SN408(LW1I, KW1I, MW1I, FW1S, GW1S, CW1B, DW1B, 00070408 ! 333: 1 A4W1K, B4W1K) 00080408 ! 334: C***** 00090408 ! 335: C***** SUBROUTINE USED WITH SEGMENT FM408 TO SUPPLY VALUES 00100408 ! 336: C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110408 ! 337: C***** 00120408 ! 338: DIMENSION LT1I(10),LW1I(10),KT1I(10),KW1I(10),MT1I(10),MW1I(10) 00130408 ! 339: REAL FT1S(10),FW1S(10),GT1S(10),GW1S(10) 00140408 ! 340: LOGICAL CT1B(10),CW1B(10),DT1B(10),DW1B(10) 00150408 ! 341: CHARACTER*4 A4T1K(10),A4W1K(10),B4T1K(10),B4W1K(10) 00160408 ! 342: C***** 00170408 ! 343: DATA LT1I /2, 4, 1, 3, 10, 8, 9, 6, 7 ,5/ 00180408 ! 344: DATA KT1I /9, 10, 1, 3, 2, 5, 8, 4, 7, 6/ 00190408 ! 345: DATA MT1I /10, 1, 3, 4, 7, 6, 8, 5, 2, 9/ 00200408 ! 346: DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ 00210408 ! 347: DATA GT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1/ 00220408 ! 348: DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'00230408 ! 349: 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ 00240408 ! 350: DATA B4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'00250408 ! 351: 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL'/ 00260408 ! 352: DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 00270408 ! 353: 1 .FALSE., .TRUE., .TRUE., .FALSE./ 00280408 ! 354: DATA DT1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00290408 ! 355: 1 .TRUE., .TRUE., .FALSE., .TRUE./ 00300408 ! 356: C***** 00310408 ! 357: DO 1 IVI = 1, 10 00320408 ! 358: LW1I(IVI) = LT1I(IVI) 00330408 ! 359: KW1I(IVI) = KT1I(IVI) 00340408 ! 360: MW1I(IVI) = MT1I(IVI) 00350408 ! 361: FW1S(IVI) = FT1S(IVI) 00360408 ! 362: GW1S(IVI) = GT1S(IVI) 00370408 ! 363: CW1B(IVI) = CT1B(IVI) 00380408 ! 364: DW1B(IVI) = DT1B(IVI) 00390408 ! 365: A4W1K(IVI) = A4T1K(IVI) 00400408 ! 366: B4W1K(IVI) = B4T1K(IVI) 00410408 ! 367: 1 CONTINUE 00420408 ! 368: C***** 00430408 ! 369: RETURN 00440408 ! 370: END 00450408
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.