      SUBROUTINE TXDDF
C     VERSION 2    LONG LABELS
C
C     TXDDF INITIALIZES THE FIRST TAPE FILE
C            DDF OR DATA DESCRIPTION FILE
C     VIA THE EXCHANGE PACKAGE SUBROUTINES.
C
C     TXDDF READS THE DDF ITEM (FIELD) DESCRIPTIONS FROM CARDS
C     OR RECORDS IN THE INPUT STREAM.
C     THE FIRST CARD EXPECTED IS AN *DDF CARD.
C     THE SECOND CARD MUST CONTAIN INITIALIZATION PARAMETERS
C     THE THIRD CARD MUST BE TAG 0...0
C     THE LAST CARD EXPECTED IS AN *EODDF CARD.
C     A BLANK ITEM (FIELD) TAG WILL ALSO CAUSE THE PROCESS TO TERMINATE.
C
C     THE ITEM DESCRIPTORS (TAG, ETC) ARE SUPPLIED TO THE EXCHANGE
C     SUBROUTINES FOR PROCESSING AND WRITING AS THE FIRST TAPE FILE.
C
      LOGICAL *1 DSN(17),IVSNS(6),DT(70)
      REAL*8 TAG,CARDID,DDF,EODDF,BLANK
C
C
      DATA NS/0/, NDAT/0/, NT/5/                            
      DATA  BLANK/'        '/
      DATA DDF /'*DDF    ' /, EODDF /'*EODDF  ' /
C
C
      TYPE 21                                                       
21    FORMAT(' BEGIN TXDDF')
C
      LUNPR=6
      LUNCR=1
      OPEN(UNIT=LUNCR,NAME='DATA.DDF',TYPE='OLD')
C
C
      READ(LUNCR,101,END=777)  CARDID
101   FORMAT (A6)
      WRITE(LUNPR,801)  CARDID
801   FORMAT(1H ,A6)
      IF (CARDID .EQ. DDF )  GO TO 109
C
C
      WRITE(LUNPR,106)  CARDID
106   FORMAT (' ERROR 1ST CARD NOT *DDF, BUT  ',A6)
      STOP 'ABORT'
C
C          GET INITIALIZATION PARAMETERS
C
C          PARAMETERS READ ARE_                                      
C                                                                    
C            IFILE    - LOCAL FILE NAME                              
C            IVSNS(1) - TAPE REEL IDENTIFIER                         
C            ISSC     - SUBSYSTEM CONTROL CHARACTER                  
C            ICSC     - CHARACTER SET CONTROL                        
C            IFCC     - FIELD CONTROL COUNT                          
C            ITL      - TAG LENGTH                                   
C            ICM      - CONVERSION MODE                              
C            MFID     - MULTIFILE SET IDENTIFIER
C
C        READ PARAMETERS
109   READ(LUNCR,11,END=777) ISSC,ICSC,IFCC,ITL,ICM
   11 FORMAT (25X,A1,2A2,1X,2I2)
      WRITE(LUNPR,802)  ISSC,ICSC,IFCC,ITL,ICM
802   FORMAT(1H0,25X,A1,2A2,1X,2I2)
C
C          GET DATA BASE NAME
C
C        READ TAG 00...00
      READ(LUNCR,24,END=777)  TAG,LNTH,(DT(I),I=1,70)
      WRITE(LUNPR,803)  TAG,LNTH,(DT(I),I=1,70)
803   FORMAT(1H0,A8,I2,70A1)
C
C          PUT DATA SET NAME IN LABEL AREA
C
      CALL STRMOV(DT,DSN,17)
C
C
C
C          INITIALIZE FILE
C
   12 CALL INITCN
C
C     DDF LEADER                                                        
   14 CALL SETDDF(ISTAT,ISSC,ICSC,IFCC,ITL,ICM)                       
C                                                                       003401
C      GO TO STATEMENT 26 TO OUTPUT TAG 00000                           003411
C                                                                       003421
      IF (ISTAT .EQ. 0)  GO TO 26
      PRINT 15, ISTAT
   15 FORMAT (7H ERROR ,I2,24H FROM SETDDF, WILL ABORT)
      STOP 'ABORT'
C
C
C     LOOP TO READ DDF DIRECTORY                                      
23    READ(LUNCR,24,END=777) TAG,LNTH,(DT(I),I=1,70)
24    FORMAT(A8,I2,70A1)
      WRITE(LUNPR,803)  TAG,LNTH,(DT(I),I=1,70)
      IF (TAG .EQ. EODDF)  GO TO 27
      IF(TAG.EQ.BLANK) GO TO 27                                       
C
26    CONTINUE
C	WRITE(LUNPR,6)  TAG,LNTH,(DT(I),I=1,70)
C6	FORMAT(1X,A8,I2,70A1)
      CALL ADDFLD(ISTAT,TAG,DT,LNTH)
      IF (ISTAT .NE. 0)  GO TO 30
      GO TO 23                                                        
C
C
   30 PRINT 31, ISTAT
   31 FORMAT(7H ERROR ,I2,24H FROM ADDFLD, WILL ABORT)
      STOP 'ABORT'
C
C
   27 CALL WRTREC(ISTAT)
      IF (ISTAT .EQ. 0) GO TO 99
   36 WRITE(LUNPR,37)   ISTAT
   37 FORMAT(7H ERROR ,I2,24H FROM WRTREC, WILL ABORT)
      STOP 'ABORT'
777	WRITE(LUNPR,778)
778	FORMAT(' PREMATURE END OF DATA')
	GOTO 27
C	ANYWAY
C
99    TYPE 909
909   FORMAT(' END TXDDF')
      CLOSE(UNIT=LUNCR)
      CLOSE(UNIT=LUNPR)
      RETURN
      END
