       SUBROUTINE PDS_Keywords( PROD )
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine PDS_Keywords (PDS keywords management)
C.AUTHOR:         L. Nicastro - ITeSRE/CNR, Bologna.
C.VERSIONS:       0.1 - 20 June 96 - Original version (from PDS_K)
C                 0.2 - 05 July 96 - Added PRODUCT parameter.
C                 0.3 - 29 July 96 - Check for PDSCALIB env. variable
C                 0.4 - 12 Sep  96 - Removed data check for PDS_FOTUNITS
C                 0.5 - 02 Dec  96 - code for HK is H not K (LC & DDF)
C                 0.6 - 13 Jan  97 - Removed set of BINSIZE and TIMEZERO.
C                                    Added check for COUNTAXIS.
C                                    Fixed pckt lookup for dir007-14.
C                 0.7 - 08 Jul  97 - Added PSACORR keyword.
C                 0.8 - 02 Sep  97 - Added LUINST close statement.
C                                    Changed PSACORR setting.
C                 0.9 - 25 Sep 97  - changed the name of the LOCAL common
C.PURPOSE:        Transfers all the PDS keywords. FOT data.
C.METHOD:         read COMMON blocks and ASCII files (EXCONF,...) for FOT
C.                data files.
C.SYNTAX:         CALL PDS_Keywords( PRODUCT )
C.ARGUMENTS:      PRODUCT:   (char) The product type: S (spectrum), T (time
C                                   series, I (image), P (photon list),
C                                   H (housekeeping), M (matrix)
C.RESTRICTIONS:
C.NOTES:          No operation is performed if PRODUCT is not recognised.
C.FILES:
C.REFERENCES:
C
C----------------------------------------------------------------------
C
       INCLUDE  'hcommon.inc'
       INCLUDE  'bincommon.inc'
       INCLUDE  'accumcommon.inc'
       INCLUDE  'context.inc'
       INCLUDE  'timecommon.inc'
       INCLUDE  'opcommon.inc'
c.       INCLUDE  'pdsnaipsa.inc'
*
c.      INCLUDE  'pcktcommon.inc'
       CHARACTER STARTHEX*10,ENDHEX*10,SLEW,INSSLEW
       INTEGER NDIMENS, NFORMAT, IN2, ITYPE, IDUMMY
       INTEGER IOBS,INSOBS
       REAL SSEC,ESEC
       REAL DMIN,DMAX
*
C--> this should be in a common block...
*
       CHARACTER STUFF(ACCUMCOMMON_MAXDIM)*16
       CHARACTER XSTUFF(BINCOMMON_MAXFIELDS)*16
       DATA STUFF /ACCUMCOMMON_MAXDIM*'unspecified     '/
       DATA XSTUFF /BINCOMMON_MAXFIELDS*'undefined       '/
*-
       CHARACTER PRODUCT,PROD*(*)
       CHARACTER UNITS*8,COIN*3,PRODUCT2*1
       INTEGER   TRUE_LENGTH
C
       CHARACTER INSTR*4,INSTREC*133,DUMMY
       CHARACTER BUFFER*(80),BUFFER2*(82),PREPARSE*(82)
       CHARACTER*80 FILEROOT,FILEIN,FILEINST
       CHARACTER*20 FIELDNAME,FIELDQUERY,FILEINST0
       CHARACTER FIELD*2,CALON*3,CAXIS*1
       INTEGER   IERR,I,NUNITS,INDX(2),IU,IC,NU,LFR,LUINST
       INTEGER   IXNEWS,IEL(4),IEH(4), IPDIR,INDIR
       INTEGER   I70,ZC_TIME,IVOS,ISYS
       REAL*8    DJM,BMJD  ! ,BTBMJD
       LOGICAL   VOSERROR,FOUND,btest
C
       DATA IEL,IEH /4*0,4*0/
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C--> Pseudo-images specific (from "saxgaccum")... to be implemented
       REAL*4 BASEI(1)
       INTEGER ISIZEI,IADDRI,IOFFI,IXNEWI,IYNEWI
C       COMMON /LOCAL/ ISIZEI,IADDRI,IOFFI,IXNEWI,IYNEWI,BASEI
       COMMON /LOCAL_IMG/ ISIZEI,IADDRI,IOFFI,IXNEWI,IYNEWI,BASEI
*--
*
C-- Check PRODUCT is valid.
*
c.      CALL GET_GLOBAL_DEFAULT( 'CONTEXT','S',PRODUCT )
      PRODUCT=PROD(1:1)
      IF (PRODUCT.NE.'S' .AND. PRODUCT.NE.'T' .AND. PRODUCT.NE.'I'
     .    .AND. PRODUCT.NE.'P' .AND. PRODUCT.NE.'H'
     .    .AND. PRODUCT.NE.'M') THEN
        WRITE (6,*) 'PDS_Keywords: Invalid product.'
        RETURN
      ENDIF
*
C-- Get root file name (should be in a common block!)
*
      CALL SAX_FROOT_NAME( FILEROOT )
      LFR = TRUE_LENGTH( FILEROOT )
      FILEIN = FILEROOT(:LFR)//'.'//ACCUMCOMMON_PACKET 
*
C-- Get header info from first packet
*
c.      CALL PDS_PCKT( 33,FILEIN )
C
C-- re-load basic information about the packet (should be in a common block!)
C
      CALL SAX_ACC_PRELOAD( NDIMENS,NFORMAT,XSTUFF,STUFF )
*
C--> encode selected PHW units into UNITS. Not fully implemented...
*
c.      IF (PCKTCOMMON_PKTYP.EQ.'DIR' .OR.
c.     .    PCKTCOMMON_PKTYP.EQ.'ENG') CALL PDS_UNITS( STUFF,IERR )
c.      IF (INDEX(ACCUMCOMMON_PACKET,'dir').NE.0 .OR.
c.     .    INDEX(ACCUMCOMMON_PACKET,'lat').NE.0 .OR.
c.     .    INDEX(ACCUMCOMMON_PACKET,'psa').EQ.0 .OR.
c.     .    INDEX(ACCUMCOMMON_PACKET,'cal').EQ.0 .OR.
c.     .    INDEX(ACCUMCOMMON_PACKET,'eng').NE.0)
      CALL PDS_FOTUNITS( STUFF,UNITS,IERR )
*
C  current date in MJD format (provisional)
      I70 = ZC_TIME()
      CALL TIME_70S2MJD( I70,DJM,IERR )
C
C     Initialize keywords
C
      PRODUCT2 = PRODUCT
      IF (PRODUCT2.EQ.'H') PRODUCT2 = 'T'
      CALL INSTRUMENT_KEYS( PRODUCT2,12 )
*
C-- keywords common to any product...
*
      CALL INST_KEY_SET( 'ORIGIN','XAS ',1,1,IERR )
C  identify parent file
      CALL INST_KEY_SET( 'PARENTS',
     .    '1 '//FILEIN(:TRUE_LENGTH(FILEIN)),1,1,IERR )
c.      CALL INST_KEY_SET( 'COMMENT',
c.     .               'Data type: '//PCKTCOMMON_FILEDESC,1,1,IERR )

*
      CALL INST_KEY_SET( 'PDSDATE',DJM,1,1,IERR )
*
C-- Get obs. date form INSTDIR file
*
C      retrieve instrument from context
      CALL GET_GLOBAL_DEFAULT( 'INSTRUMENT','NONE',INSTR )
      BMJD = 0.
      FILEINST0 = INSTR(1:2)//'.instdir'
      CALL BUILDPATH( FILEINST0,'FOT',FILEINST )
      CALL FREE_LU( LUINST )
      CALL Z_OPEN( LUINST,FILEINST,'SEQ','OLD',0 )
      IF (VOSERROR(IVOS,ISYS)) THEN
        WRITE (6,*) 'PDS_Keywords: Error reading INSTDIR file.'
        RETURN
      ENDIF
*
      CALL GET_GLOBAL_DEFAULT( 'SLEW','n',SLEW )
      CALL LOWCASE( SLEW )
      CALL GET_OBS_CHAIN( IOBS,'Reset' )
*
  1   CONTINUE
C
C        read and decode intrument directory record sequentially
      READ (LUINST,'(A)',END=899) INSTREC
      CALL REARRANGE_INSTREC( INSTREC )
      READ (INSTREC,*,IOSTAT=IERR) DUMMY,(STARTARR(I),I=1,5),SSEC,
     .   STARTHEX,(ENDARR(I),I=1,5),ESEC,ENDHEX,INSSLEW,INSOBS
C
C        are we on the wished record ?
         CALL LOWCASE( INSSLEW )
         IF (INSSLEW .NE. SLEW) GOTO 1
         IF (INSOBS .NE. IOBS) GOTO 1
C
C        Yes we are, so ...
      CLOSE ( LUINST )
C        we can store and decode start and end times
         STARTARR(6) = SSEC
         STARTARR(7) = SSEC/100.
         ENDARR(6) = ESEC
         ENDARR(7) = ESEC/100.
         CALL TIME_1970( STARTARR,I70 )
         CALL TIME_70S2MJD( I70,BMJD,IERR )
*
 899  CALL INST_KEY_SET( 'PDSDTOBS',BMJD,1,1,IERR )
C--> Coincidence flags
      COIN = 'FFF'
C--> Decode DIR mode
      INDIR = 0
      IPDIR = INDEX(ACCUMCOMMON_PACKET,'dir')
      IF (IPDIR .NE. 0) THEN
        IPDIR = IPDIR + 3
        READ (ACCUMCOMMON_PACKET(IPDIR:IPDIR+2),*) INDIR
        IF (INDIR .LE. 2) THEN
c..      IF (INDEX(ACCUMCOMMON_PACKET,'dir001').NE.0 .OR.
c..     .    INDEX(ACCUMCOMMON_PACKET,'dir002').NE.0) THEN
          IN2 = 0
          DO 100 I=1,ACCUMCOMMON_NF
            WRITE (FIELD,201) I
  201 FORMAT ('f',I1)
            CALL PKTCAP_LOOKUP( FIELD,ITYPE,IDUMMY,FIELDNAME,FOUND )
            IF (FIELDNAME(1:TRUE_LENGTH(FIELDNAME)).EQ.'Flags') THEN
              IN2 = I
              GOTO 110
            ENDIF
  100     CONTINUE
  110     CONTINUE
          IF (IN2 .EQ. 0) THEN
            WRITE (6,202)
  202   FORMAT ('PDS_Keywords: Error in packetcap field names!')
            CALL Z_EXIT( 1 )
          ENDIF
          DO 15 I=1,3
   15     WRITE (COIN(I:I),'(L1)') btest(ACCUMCOMMON_IEH(IN2),I-1)
        ENDIF
      ENDIF
      CALL INST_KEY_SET( 'PDSCOIN',COIN,1,1,IERR )
*-- End keywords common to any product...

C-- Check if Rate or Counts ...
      CALL GET_GLOBAL_DEFAULT( 'COUNTAXIS','R',CAXIS )
      CALL UPCASE( CAXIS )
*
C-- keywords common to all
*
c.      IF (PRODUCT.NE.'A') THEN
        CALL INST_KEY_SET( 'DATE',DJM,1,1,IERR )
        CALL INST_KEY_SET( 'DATE_OBS',BMJD,1,1,IERR )
        CALL INST_KEY_SET( 'SCSTART',TIMECOMMON_START,1,1,IERR )
        CALL INST_KEY_SET( 'SCEND',TIMECOMMON_END,1,1,IERR )
*
        CALL INST_KEY_SET( 'PDSUNITS',UNITS,1,1,IERR )
c.        CALL INST_KEY_SET( 'PDSMODID',PCKTCOMMON_IPCKT,1,1,IERR )
c.        CALL INST_KEY_SET( 'PDSPKTID',PCKTCOMMON_IPCKT,1,1,IERR )
c.      ENDIF
*
C-- keywords common to all but pseudo-images...
*
      IF (PRODUCT.NE.'I') THEN
        CALL INST_KEY_SET( 'STORAGE','BYROW',1,1,IERR )
      ENDIF
*
C-- keywords common to spectra and pseudo-images...
*
      IF (PRODUCT.EQ.'S' .OR. PRODUCT.EQ.'I') THEN
        CALL INST_KEY_SET( 'EXPOSURE',TIMECOMMON_LIVE,1,1,IERR )
*
        CALL INST_KEY_SET( 'DEADTIME','FIXED',1,1,IERR )
        CALL INST_KEY_SET( 'DTVALUE',TIMECOMMON_DEAD,1,1,IERR )
        CALL INST_KEY_SET( 'DTCORR','NOT APPLIED',1,1,IERR )
*
C-- Get PDS high voltages, temperatures and status keywords from external file
*
        CALL PDSHKK( FILEROOT, IERR )
      ENDIF
*
C-- Manual input for the remaining keywords? (temporary)
*
      CALL GET_GLOBAL_DEFAULT('PDSCALIB',' ',CALON)
      IF (CALON.EQ.'ON') THEN
        CALL X_PROMPT( ' Enter PDSCALID: ',0 )
        CALL X_READ( 0,1,BUFFER )
        BUFFER2 = PREPARSE( BUFFER )
        READ (BUFFER2,*,IOSTAT=IERR) BUFFER
        CALL INST_KEY_SET( 'PDSCALID',buffer(:6),1,1,IERR )
        IF (IERR .NE. 0) WRITE (6,*) 'Warning! Error =',IERR
        CALL X_PROMPT( ' Enter PDSSPCOD: ',0 )
        CALL X_READ( 0,1,BUFFER )
        BUFFER2 = PREPARSE( BUFFER )
        READ (BUFFER2,*,IOSTAT=IERR) BUFFER
        CALL INST_KEY_SET( 'PDSSPCOD',BUFFER(:6),1,1,IERR )
        IF (IERR .NE. 0) WRITE (6,*) 'Warning! Error =',IERR
C--> To be continued below?
      ENDIF
*
C-- remaining PRODUCT specific keywords
*
C-- Spectra (assume one spectrum per file...)
      IF (PRODUCT.EQ.'S') THEN
C Counts or Rate (default = Rate)
c..       IF (CAXIS.EQ.'C') THEN
c..         CALL INST_KEY_SET( 'TUNIT3','CTS',1,1,IERR )
c..         CALL INST_KEY_SET( 'TUNIT4','CTS',1,1,IERR )
c..       ENDIF
C     ixnew is number of bins
        IXNEWS=ACCUMCOMMON_IEH(ACCUMCOMMON_IXINDEX(1)) -
     .  ACCUMCOMMON_IEL(ACCUMCOMMON_IXINDEX(1)) + 1
        IXNEWS=IXNEWS/ACCUMCOMMON_IXZOOM(1)
*
        BUFFER2 = STUFF(ACCUMCOMMON_IXINDEX(1))
        I=TRUE_LENGTH(BUFFER2)
        CALL INST_KEY_SET( 'PDSSTYPE',BUFFER2(:I),1,1,IERR )
*
C-- First accumulation range is always X-axis quantity.
C-- At the moment distinguish only PHA and RiseTime accumulations
*
c..        IF (INDEX(ACCUMCOMMON_PACKET,'dir').EQ.0) THEN
        IF (INDIR.EQ.0 .OR. INDIR.GE.7) THEN
          IU = ICHAR(UNITS(1:1)) - 64
          IEL(IU) = 0
          IEH(IU) = 1023
        ELSE
          IF (BUFFER2(1:8).EQ.'RiseTime') THEN
            FIELDQUERY = 'PHA'
          ELSE
            FIELDQUERY = 'RiseTime'
          ENDIF
          IN2 = 0
          DO 200 I=1,ACCUMCOMMON_NF
	    WRITE (FIELD,201) I
	    CALL PKTCAP_LOOKUP( FIELD,ITYPE,IDUMMY,FIELDNAME,FOUND )
	    IF (FIELDNAME(1:TRUE_LENGTH(FIELDNAME)) .EQ.
     *         FIELDQUERY(1:TRUE_LENGTH(FIELDQUERY))) THEN
              IN2=I
              GOTO 210
            ENDIF
  200     CONTINUE
  210     CONTINUE
	  IF (IN2 .EQ. 0) THEN
	    WRITE (6,202)
            CALL Z_EXIT( 1 )
	  ENDIF
          IF (UNITS(:3).EQ.'ALL') THEN
            DO 25 I=1,4
              IEL(I) = ACCUMCOMMON_IEL(IN2)
              IEH(I) = ACCUMCOMMON_IEH(IN2)
  25        CONTINUE
          ELSE
            IF (UNITS(:3).EQ.'SUM') THEN
              IC = 4
              NU = TRUE_LENGTH(UNITS) - 4
            ELSE
              IC = 0
              NU = 1
            ENDIF
*
            DO 35 I=1,NU
              IU = ICHAR(UNITS(I+IC:I+IC)) - 64
              IEL(IU) = ACCUMCOMMON_IEL(IN2)
              IEH(IU) = ACCUMCOMMON_IEH(IN2)
  35        CONTINUE
          ENDIF
        ENDIF
        CALL INST_KEY_SET( 'PDSLOTHR',IEL,1,1,IERR )
        CALL INST_KEY_SET( 'PDSUPTHR',IEH,1,1,IERR )
      ENDIF
C-- Pseudo-images
      IF (PRODUCT.EQ.'I') THEN
        CALL INST_KEY_SET( 'BUNIT','COUNTS',1,1,IERR )
        NUNITS = TRUE_LENGTH(UNITS)
        IF (INDEX(UNITS,'SUM') .NE. 0) NUNITS = NUNITS - 4
        CALL INST_KEY_SET( 'NAXIS3',NUNITS,1,1,IERR )
C Min and Max...
        CALL RMINMAX( BASEI(1+IOFFI),ISIZEI,-1.E6,INDX,DMIN,DMAX,IERR )
        CALL INST_KEY_SET( 'DATAMIN',DMIN,1,1,IERR )
        CALL INST_KEY_SET( 'DATAMAX',DMAX,1,1,IERR )
      ENDIF
C-- Time profiles
c.      IF (PRODUCT.EQ.'T' .OR. PRODUCT.EQ.'H') THEN
C-->   units are provisional
        IF (PRODUCT.EQ.'T') THEN
c.          CALL INST_KEY_SET( 'TTYPE1','TIME',1,1,IERR )
c.          CALL INST_KEY_SET( 'TTYPE2','DEADTIME',1,1,IERR )
c.          CALL INST_KEY_SET( 'TTYPE3','DATA',1,1,IERR )
c.          CALL INST_KEY_SET( 'TTYPE4','ERROR',1,1,IERR )
c.          CALL INST_KEY_SET( 'TUNIT1','s',1,1,IERR )
c.          CALL INST_KEY_SET( 'TUNIT2','fraction',1,1,IERR )
          CALL INST_KEY_SET( 'ERROR','COLUMN',1,1,IERR )
          CALL INST_KEY_SET( 'ENLOTHR',
     .         ACCUMCOMMON_IEL(ACCUMCOMMON_IXINDEX(1)),1,1,IERR )
          CALL INST_KEY_SET( 'ENUPTHR',
     .         ACCUMCOMMON_IEH(ACCUMCOMMON_IXINDEX(1)),1,1,IERR )
          CALL INST_KEY_SET( 'PDSSLTHR',
     .         ACCUMCOMMON_IEL(ACCUMCOMMON_IXINDEX(2)),1,1,IERR )
          CALL INST_KEY_SET( 'PDSSUTHR',
     .         ACCUMCOMMON_IEH(ACCUMCOMMON_IXINDEX(2)),1,1,IERR )
          IF (CAXIS.EQ.'C') THEN
            CALL INST_KEY_SET( 'TUNIT3','CTS  ',1,1,IERR )
            CALL INST_KEY_SET( 'TUNIT4','CTS  ',1,1,IERR )
          ELSE
            CALL INST_KEY_SET( 'TUNIT3','CTS/'//
     .                         TIMECOMMON_UNITS,1,1,IERR )
            CALL INST_KEY_SET( 'TUNIT4','CTS/'//
     .                         TIMECOMMON_UNITS,1,1,IERR )
          ENDIF
c.        ELSE
c.          CALL SAX_PCF_LOOKUP( 'un',IDUM,IDUM,HKUNITS,FOUND )
c.          CALL INST_KEY_SET( 'TUNIT2',HKUNITS,1,1,IERR )
c.          CALL INST_KEY_SET( 'ERROR','POISSON',1,1,IERR )
        ENDIF
      IF (PRODUCT.EQ.'T' .OR. PRODUCT.EQ.'H') THEN
        CALL INST_KEY_SET( 'BADDATA',-1.E4,1,1,IERR )
      ENDIF
C-- Photon lists
c.      IF (PRODUCT.EQ.'P') THEN
c.      ENDIF
C-- ASCII tables
c.      IF (PRODUCT.EQ.'A') THEN
c.      ENDIF
C-- Matrices
c.      IF (PRODUCT.EQ.'M') THEN
c.      ENDIF

C-- Add PDSCORR keyword for products from direct mode
      IF (INDIR.NE.0) THEN
        IF (ACCUMCOMMON_CORRECT) THEN
          CALL INST_KEY_SET( 'PSACORR','TRUE',1,1,IERR )
c.          WRITE (BUFFER,111) NREJ,FLOAT(NREJ)/
c.     .                       (ACCUMCOMMON_TOTPKT*ACCUMCOMMON_NREC)
c. 111  FORMAT (I10,' filtered events (',F5.3,' of the total)')
c.          CALL INST_KEY_SET( 'COMMENT',BUFFER,1,1,IERR )

        ELSE
          CALL INST_KEY_SET( 'PSACORR','FALSE',1,1,IERR )
        ENDIF
      ENDIF

*
C-- Flushing keywords to disk
*
      CALL INST_KEY_FLUSH( 1 )
*
      RETURN
      END
*========

      SUBROUTINE PDSHKK( FILEROOT, IERR )
*
      INTEGER LROW
      PARAMETER (LROW = 80)         ! Max row length
      INTEGER*4 VALI(12),TRUE_LENGTH
      INTEGER IERR, ISEPV, KUN, IK, IS, IA, IB, I, IC
      REAL*4 VALR(5)
      REAL*8 VALD(2)
      CHARACTER FILEROOT*(*),EXT*3,SEP*3,SEPV*2,ROW*(LROW+2)
*
c.      INCLUDE  'pcktcommon.inc'
*--
      DATA EXT /'.HK'/, SEP /' = '/, SEPV /', '/, ISEPV / 2 /
*--
      KUN = 17
      OPEN (KUN,FILE=FILEROOT(1:TRUE_LENGTH(FILEROOT))//EXT,
     .      STATUS='OLD',IOSTAT=IERR)
      IF (IERR .NE. 0) RETURN
*
   5  FORMAT (A)
  10  READ (KUN,5,END=1000,ERR=1000) ROW 
      ROW = ROW(2:)                     ! Streeps out the blank in first column
      IK = INDEX(ROW,SEP) - 1
c      KEYNAME = ROW(:IK)
      IS = IK + 4
      IF (INDEX(ROW(IS:),'.') .EQ. 0) THEN   ! Integers or String
        IA = INDEX(ROW,CHAR(39))             ! ' enclose string
        IF (IA .NE. 0) THEN                  ! String
          IA = IA + 1
          IB = INDEX(ROW(IA:),CHAR(39)) - 2
          CALL INST_KEY_SET(ROW(1:IK),ROW(IA:IA+IB),1,1,IERR)
          GOTO 10
        ELSE                                 ! Integers
          I = 0
          ROW(81:82) = SEPV
  50      IC = INDEX(ROW(IS:),SEPV)
          IF (IC .EQ. 0) GOTO 10             ! end of values
          I = I + 1
          READ (ROW(IS:IS+IC-2),*) VALI(I)
          IS = IS + IC + 1
          IF (IS .GE. LROW) THEN
            CALL INST_KEY_SET(ROW(1:IK),VALI(1),1,1,IERR)
            GOTO 10
          ENDIF
          GOTO 50
        ENDIF
      ELSE                                   ! Reals
        IF (ROW(1:4).EQ.'PDSD' .OR. ROW(1:4).EQ.'DATE') THEN  ! Dates are double
          READ (ROW(IS:),*) VALD(1)
          CALL INST_KEY_SET(ROW(1:IK),VALD(1),1,1,IERR)
          GOTO 10
        ELSE                                 ! Real*4
          I = 0
          ROW(81:82) = SEPV
  60      IC = INDEX(ROW(IS:),SEPV)
          IF (IC .EQ. 0) GOTO 10             ! end of values
          I = I + 1
          READ (ROW(IS:IS+IC-2),*) VALR(I)
          IS = IS + IC + 1
          IF (IS .GE. LROW) THEN
            CALL INST_KEY_SET(ROW(1:IK),VALR(1),1,1,IERR)
            GOTO 10
          ENDIF
          GOTO 60
        ENDIF          
      ENDIF          
*
 1000 CLOSE (KUN)
      RETURN
      END
