FM407.f Source File

*********** 00010408 FORTRAN 77 00020408 * FM408 00030408 * SN408 DAQ - (805) 00040408 * THIS SUBROUTINE IS CALLED BY FM407 00050408 ********** 00060408



Contents

Source Code


Source Code

      PROGRAM FM407

C***********************************************************************00010407
C*****  FORTRAN 77                                                      00020407
C*****   FM407                                                          00030407
C*****                       DIRAF1 - (410)                             00040407
C*****   THIS PROGRAM CALLS SUBROUTINE SN408                            00050407
C***********************************************************************00060407
C*****  TESTING OF DIRECT ACCESS FILES                        SUBSET REF00070407
C*****          UNFORMATED RECORDS ONLY                         12.10.1 00080407
C*****                                                                  00090407
C*****                                                                  00100407
CBB** ********************** BBCCOMNT **********************************00110407
C****                                                                   00120407
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130407
C****                          VERSION 2.1                              00140407
C****                                                                   00150407
C****                                                                   00160407
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170407
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00180407
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00190407
C****                      BUILDING 225  RM A266                        00200407
C****                     GAITHERSBURG, MD  20899                       00210407
C****                                                                   00220407
C****                                                                   00230407
C****                                                                   00240407
CBE** ********************** BBCCOMNT **********************************00250407
C*****                                                                  00260407
C*****  S P E C I F I C A T I O N S  SEGMENT 410                        00270407
        DIMENSION L1I(10), K1I(10), M1I(10), F1S(10), G1S(10)           00280407
        CHARACTER*4 A4VK, B4VK, A41K(10), B41K(10)                      00290407
        LOGICAL AVB, BVB, C1B(10), D1B(10)                              00300407
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.   00310407
CBB** ********************** BBCINITA **********************************00320407
C**** SPECIFICATION STATEMENTS                                          00330407
C****                                                                   00340407
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00350407
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00360407
CBE** ********************** BBCINITA **********************************00370407
CBB** ********************** BBCINITB **********************************00380407
C**** INITIALIZE SECTION                                                00390407
      DATA  ZVERS,                  ZVERSD,             ZDATE           00400407
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00410407
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00420407
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00430407
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00440407
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00450407
      DATA   REMRKS /'                               '/                 00460407
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00470407
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00480407
C****                                                                   00490407
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00500407
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00510407
CZ03  ZPROG  = 'PROGRAM NAME'                                           00520407
CZ04  ZDATE  = 'DATE OF TEST'                                           00530407
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00540407
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00550407
CZ07  ZNAME  = 'NAME OF USER'                                           00560407
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00570407
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00580407
C                                                                       00590407
      IVPASS = 0                                                        00600407
      IVFAIL = 0                                                        00610407
      IVDELE = 0                                                        00620407
      IVINSP = 0                                                        00630407
      IVTOTL = 0                                                        00640407
      IVTOTN = 0                                                        00650407
      ICZERO = 0                                                        00660407
C                                                                       00670407
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00680407
      I01 = 05                                                          00690407
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00700407
      I02 = 06                                                          00710407
C                                                                       00720407
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730407
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00740407
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00750407
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00760407
C                                                                       00770407
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00780407
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00790407
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00800407
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00810407
C                                                                       00820407
CBE** ********************** BBCINITB **********************************00830407
C*****                                                                  00840407
C*****    THE FOLLOWING STATEMENT MUST BE CHANGED IF                    00850407
C*****    THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A            00860407
C*****    DIRECT, UNFORMATTED FILE.                                     00870407
C*****                                                                  00880407
C     I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE.      00890407
      I10 = 24                                                          00900407
CX100   REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER).   00910407
C     SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24.               00920407
C*****                                                                  00930407
C*****  THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME             00940407
C*****  GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,               00950407
C*****  UNFORMATTED FILE.                                               00960407
C*****                                                                  00970407
C*****                                                                  00980407
      NUVI = I02                                                        00990407
      IVTOTL = 4                                                        01000407
      ZPROG = 'FM407'                                                   01010407
CBB** ********************** BBCHED0A **********************************01020407
C****                                                                   01030407
C**** WRITE REPORT TITLE                                                01040407
C****                                                                   01050407
      WRITE (I02, 90002)                                                01060407
      WRITE (I02, 90006)                                                01070407
      WRITE (I02, 90007)                                                01080407
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01090407
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01100407
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01110407
CBE** ********************** BBCHED0A **********************************01120407
C*****                                  FILE NUMBER ASSIGNMENT          01130407
      IUVI = I10                                                        01140407
C*****                                                                  01150407
C*****    HEADER FOR SEGMENT 410                                        01160407
       WRITE(NUVI,41000)                                                01170407
41000  FORMAT(" ",/ " DIRAF1 - (410) DIRECT ACCESS UNFORMATTED FILE" // 01180407
     1          " SUBSET REF. - 12.10.1" )                              01190407
CBB** ********************** BBCHED0B **********************************01200407
C**** WRITE DETAIL REPORT HEADERS                                       01210407
C****                                                                   01220407
      WRITE (I02,90004)                                                 01230407
      WRITE (I02,90004)                                                 01240407
      WRITE (I02,90013)                                                 01250407
      WRITE (I02,90014)                                                 01260407
      WRITE (I02,90015) IVTOTL                                          01270407
CBE** ********************** BBCHED0B **********************************01280407
C*****                                                                  01290407
        WRITE (NUVI, 41099)                                             01300407
41099   FORMAT (" ",48X,"EACH TEST READS 10 RECORDS AND " /             01310407
     1          " ",48X,"EACH RECORD IS CHECKED, I.E.,  " /             01320407
     2          " ",48X,"THERE ARE 10 SUBTESTS MADE FOR " /             01330407
     3          " ",48X,"EACH TEST                      " )             01340407
C*****                                                                  01350407
        CALL SN408(L1I,K1I,M1I,F1S,G1S,C1B,D1B,A41K,B41K)               01360407
C*****                                                                  01370407
        OPEN(IUVI, ACCESS='DIRECT',RECL=132)                            01380407
C*****                      WRITE 10 RECORDS IN SEQUENCE, REC = 1 TO 10 01390407
        DO 41001 IVI = 1, 10                                            01400407
        AVS = F1S (IVI)                                                 01410407
        A4VK = A41K (IVI)                                               01420407
        AVB = C1B (IVI)                                                 01430407
        WRITE(IUVI, REC= IVI) IVI, AVS, A4VK, AVB                       01440407
41001   CONTINUE                                                        01450407
CT001*  TEST 1                         READ RECORDS 1 TO 10 IN SEQUENCE 01460407
           IVTNUM = 1                                                   01470407
           IVCOMP = 0                                                   01480407
        DO 41002 IVI = 1, 10                                            01490407
        READ(IUVI, REC = IVI) KVI, BVS, B4VK, BVB                       01500407
        IF (IVI .NE. KVI) GOTO 20010                                    01510407
        IF (B4VK .NE. A41K(IVI)) GOTO 20010                             01520407
        IF ((BVB .AND. .NOT. C1B(IVI)) .OR.                             01530407
     1      (.NOT. BVB .AND. C1B(IVI))) GOTO 20010                      01540407
        IF (BVS .NE. F1S(IVI)) GO TO 20010                              01550407
        GO TO 41002                                                     01560407
20010      IVCOMP = IVCOMP + 1                                          01570407
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       01580407
           WRITE (NUVI, 70010) IVTNUM, IVI                              01590407
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, IVI, F1S(IVI),      01600407
     1                         A41K(IVI), C1B(IVI)                      01610407
70010      FORMAT (" ",2X,I3,4X," FAIL ON REC " ,I2)                    01620407
70020      FORMAT (" ",16X,"COMPUTED: " ,I2,1X,F5.2,1X,A4,1X,L1/        01630407
     1             " ",16X,"CORRECT:  " ,I2,1X,F5.2,1X,A4,1X,L1)        01640407
41002      CONTINUE                                                     01650407
           IF (IVCOMP - 0) 0011, 10010, 0011                            01660407
10010      IVPASS = IVPASS + 1                                          01670407
           WRITE (NUVI, 80002) IVTNUM                                   01680407
 0011      CONTINUE                                                     01690407
CT002*  TEST 2            READ RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01700407
           IVTNUM = 2                                                   01710407
           IVCOMP = 0                                                   01720407
        DO 41013 IVI = 1, 10                                            01730407
        JVI = L1I(IVI)                                                  01740407
        READ(IUVI, REC = JVI) KVI, BVS, B4VK, BVB                       01750407
        IF (KVI .NE. JVI) GOTO 20020                                    01760407
        IF (B4VK .NE. A41K(JVI)) GOTO 20020                             01770407
        IF ((BVB .AND. .NOT. C1B(JVI)) .OR.                             01780407
     1      (.NOT. BVB .AND. C1B(JVI))) GOTO 20020                      01790407
        IF (BVS .NE. F1S(JVI)) GOTO 20020                               01800407
        GO TO 41013                                                     01810407
20020      IVCOMP = IVCOMP + 1                                          01820407
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       01830407
           WRITE (NUVI, 70010) IVTNUM, JVI                              01840407
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, F1S(JVI),      01850407
     1                         A41K(JVI), C1B(JVI)                      01860407
41013   CONTINUE                                                        01870407
           IF (IVCOMP - 0) 0021, 10020, 0021                            01880407
10020      IVPASS = IVPASS + 1                                          01890407
           WRITE (NUVI, 80002) IVTNUM                                   01900407
 0021      CONTINUE                                                     01910407
C*****                   WRITE RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01920407
41014   DO 41015 IVI = 1, 10                                            01930407
        JVI = K1I (IVI)                                                 01940407
        AVS = G1S (JVI)                                                 01950407
        A4VK = B41K (JVI)                                               01960407
        AVB = D1B (JVI)                                                 01970407
        WRITE(IUVI, REC= JVI) AVB, A4VK, JVI, AVS                       01980407
41015   CONTINUE                                                        01990407
CT003*  TEST 3                READ RECORDS IN SEQUENCE OF RECORD NUMBER 02000407
           IVTNUM = 3                                                   02010407
           IVCOMP = 0                                                   02020407
        DO 41016 IVI = 1, 10                                            02030407
        READ(IUVI, REC = IVI) BVB, B4VK, JVI, BVS                       02040407
        IF (JVI .NE. IVI) GOTO 20030                                    02050407
        IF (B4VK .NE. B41K(IVI)) GOTO 20030                             02060407
        IF ((BVB .AND. .NOT. D1B(IVI)) .OR.                             02070407
     1      (.NOT. BVB .AND. D1B(IVI))) GOTO 20030                      02080407
        IF (BVS .NE. G1S(JVI)) GOTO 20030                               02090407
        GO TO 41016                                                     02100407
20030      IVCOMP = IVCOMP + 1                                          02110407
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       02120407
           WRITE (NUVI, 70010) IVTNUM, IVI                              02130407
           WRITE (NUVI, 70020) JVI, BVS, B4VK, BVB, IVI, G1S(IVI),      02140407
     1                         B41K(IVI), D1B(IVI)                      02150407
41016   CONTINUE                                                        02160407
           IF (IVCOMP -0) 0031, 10030, 0031                             02170407
10030      IVPASS = IVPASS + 1                                          02180407
           WRITE (NUVI, 80002) IVTNUM                                   02190407
 0031      CONTINUE                                                     02200407
CT004*  TEST 4               READ RECORDS IN A DIFFERENT ORDER SEQUENCE 02210407
           IVTNUM = 4                                                   02220407
           IVCOMP = 0                                                   02230407
        DO 41018 IVI = 1, 10                                            02240407
        JVI = M1I(IVI)                                                  02250407
        READ(IUVI, REC = JVI) BVB, B4VK, KVI, BVS                       02260407
        IF (KVI .NE. JVI) GOTO 20040                                    02270407
        IF (B4VK .NE. B41K(JVI)) GOTO 20040                             02280407
        IF ((BVB .AND. .NOT. D1B(JVI)) .OR.                             02290407
     1      (.NOT. BVB .AND. D1B(JVI))) GOTO 20040                      02300407
        IF (BVS .NE. G1S(JVI)) GOTO 20040                               02310407
           GO TO 41018                                                  02320407
20040      IVCOMP = IVCOMP + 1                                          02330407
           IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1                       02340407
           WRITE (NUVI, 70010) IVTNUM, JVI                              02350407
           WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, G1S(JVI),      02360407
     1                         B41K(JVI), D1B(JVI)                      02370407
41018   CONTINUE                                                        02380407
           IF (IVCOMP - 0) 0041, 10040, 0041                            02390407
10040      IVPASS = IVPASS + 1                                          02400407
           WRITE (NUVI, 80002) IVTNUM                                   02410407
 0041      CONTINUE                                                     02420407
C*****                                                                  02430407
CBB** ********************** BBCSUM0  **********************************02710407
C**** WRITE OUT TEST SUMMARY                                            02720407
C****                                                                   02730407
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02740407
      WRITE (I02, 90004)                                                02750407
      WRITE (I02, 90014)                                                02760407
      WRITE (I02, 90004)                                                02770407
      WRITE (I02, 90020) IVPASS                                         02780407
      WRITE (I02, 90022) IVFAIL                                         02790407
      WRITE (I02, 90024) IVDELE                                         02800407
      WRITE (I02, 90026) IVINSP                                         02810407
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02820407
CBE** ********************** BBCSUM0  **********************************02830407
CBB** ********************** BBCFOOT0 **********************************02840407
C**** WRITE OUT REPORT FOOTINGS                                         02850407
C****                                                                   02860407
      WRITE (I02,90016) ZPROG, ZPROG                                    02870407
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02880407
      WRITE (I02,90019)                                                 02890407
CBE** ********************** BBCFOOT0 **********************************02900407
CBB** ********************** BBCFMT0A **********************************02910407
C**** FORMATS FOR TEST DETAIL LINES                                     02920407
C****                                                                   02930407
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02940407
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02950407
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02960407
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02970407
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02980407
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02990407
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03000407
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              03010407
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03020407
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  03030407
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03040407
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03050407
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03060407
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03070407
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03080407
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03090407
80050 FORMAT (" ",48X,A31)                                              03100407
CBE** ********************** BBCFMT0A **********************************03110407
CBB** ********************** BBCFMT0B **********************************03120407
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03130407
C****                                                                   03140407
90002 FORMAT ("1")                                                      03150407
90004 FORMAT (" ")                                                      03160407
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03170407
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03180407
90008 FORMAT (" ",21X,A13,A17)                                          03190407
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03200407
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03210407
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03220407
     1       7X,"REMARKS",24X)                                          03230407
90014 FORMAT (" ","----------------------------------------------" ,    03240407
     1        "---------------------------------" )                     03250407
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03260407
C****                                                                   03270407
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03280407
C****                                                                   03290407
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03300407
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03310407
     1        A13)                                                      03320407
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03330407
C****                                                                   03340407
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03350407
C****                                                                   03360407
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03370407
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03380407
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03390407
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03400407
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03410407
CBE** ********************** BBCFMT0B **********************************03420407
C*****                                                                  03430407
C*****    END OF TEST SEGMENT 410                                       03440407
      STOP                                                              03450407
      END                                                               03460407

C********************************************************************** 00010408
C*****  FORTRAN 77                                                      00020408
C*****   FM408                                                          00030408
C*****    SN408                 DAQ - (805)                             00040408
C*****   THIS SUBROUTINE IS CALLED BY FM407                             00050408
C********************************************************************** 00060408
        SUBROUTINE SN408(LW1I, KW1I, MW1I, FW1S, GW1S, CW1B, DW1B,      00070408
     1           A4W1K, B4W1K)                                          00080408
C*****                                                                  00090408
C*****  SUBROUTINE USED WITH SEGMENT FM408        TO SUPPLY VALUES      00100408
C*****  TO ARRAYS THRU THE DUMMY ARGUMENT LIST                          00110408
C*****                                                                  00120408
        DIMENSION LT1I(10),LW1I(10),KT1I(10),KW1I(10),MT1I(10),MW1I(10) 00130408
        REAL FT1S(10),FW1S(10),GT1S(10),GW1S(10)                        00140408
        LOGICAL CT1B(10),CW1B(10),DT1B(10),DW1B(10)                     00150408
        CHARACTER*4 A4T1K(10),A4W1K(10),B4T1K(10),B4W1K(10)             00160408
C*****                                                                  00170408
        DATA LT1I /2, 4, 1, 3, 10, 8, 9, 6, 7 ,5/                       00180408
        DATA KT1I /9, 10, 1, 3, 2, 5, 8, 4, 7, 6/                       00190408
        DATA MT1I /10, 1, 3, 4, 7, 6, 8, 5, 2, 9/                       00200408
        DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/   00210408
        DATA GT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1/   00220408
        DATA A4T1K / 'AAAA',  'BBBB',  'CCCC',  'DDDD',  'EDFG',  'JLKD'00230408
     1             , 'CDFE',  'LKJH',  'JHGF',  'LLLL'/                 00240408
        DATA B4T1K / 'HDFK',  'LKJH',  'ASDF',  'LKJH',  'XMNC',  'ALXM'00250408
     1             , 'IEOW',  'IERU',  'DJNC',  'DJAL'/                 00260408
        DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE.,    00270408
     1            .FALSE., .TRUE., .TRUE., .FALSE./                     00280408
        DATA DT1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00290408
     1            .TRUE., .TRUE., .FALSE., .TRUE./                      00300408
C*****                                                                  00310408
        DO 1  IVI = 1, 10                                               00320408
        LW1I(IVI) = LT1I(IVI)                                           00330408
        KW1I(IVI) = KT1I(IVI)                                           00340408
        MW1I(IVI) = MT1I(IVI)                                           00350408
        FW1S(IVI) = FT1S(IVI)                                           00360408
        GW1S(IVI) = GT1S(IVI)                                           00370408
        CW1B(IVI) = CT1B(IVI)                                           00380408
        DW1B(IVI) = DT1B(IVI)                                           00390408
        A4W1K(IVI) = A4T1K(IVI)                                         00400408
        B4W1K(IVI) = B4T1K(IVI)                                         00410408
1       CONTINUE                                                        00420408
C*****                                                                  00430408
        RETURN                                                          00440408
        END                                                             00450408