      SUBROUTINE INIT_CORRECT_PDS
*
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine INIT_CORRECT_PDS
C.LIBRARY:        PDSLIB
C.AUTHOR:         L. Nicastro - TeSRE Bologna
C.VERSIONS:       0.0 - 25 Dec 96 - Dummy version
C                 0.1 - 11 Mar 97 - Original version
C                 0.2 - 25 Sep 97 - Commented the private version of
C                                   RESET_TABLE_DESC (using the mecslib
C                                   version in me_gain_time.f)
C                 0.3 - 30 Sep 97 - Use BUILDPATH to point calib. dir.
C                 0.4 - 12 Dec 97 - Added END kwd for the pha_psa.dat read stat.
C.PURPOSE:        Load NaI PSA peak position for PDS correction
C
C.METHOD:
C.SYNTAX:         Called only by INIT_CORRECT
C
C.PARAMETERS:     None.
C.RESTRICTIONS:   Temporarely use a fixed temperature through the obs.
C.NOTES:
C.FILES:          PDS calibration file "pha_psa.dat" in $MYCALDIR
C                 (def. $XASTOP/calib/sax/pds) and temperature file
C                 for current obs. "tempw1.time"
C.REFERENCES:
C----------------------------------------------------------------------
*
      INCLUDE 'accumcommon.inc'     
      INCLUDE 'timecommon.inc'
      INCLUDE 'opcommon.inc'
      INCLUDE 'hcommon.inc'
      INCLUDE 'bincommon.inc'
      INCLUDE 'syscommon.inc'
      INCLUDE 'pdsnaipsa.inc'
*
      LOGICAL VOSERROR,LOP
*
      INTEGER*4 NPHADEF, NPSADEF
      PARAMETER ( NPHADEF = 1024, NPSADEF = 512 )
*
      INTEGER*4 IVOS,ISYS,IER,IUN,I,J,IPDIR,INDIR,TRUE_LENGTH,
     .          ITYPE,IDUMMY,IPHA,LPHA,IPSA,LPSA, SAVED
      INTEGER*4 NAXIS1,NT,NFIELDS,IZOFF,START70,DAY70
      REAL*8 TJ,T0,UDOUBLE
      CHARACTER*80 FPHAPSA,XASTOP,NAMETF,BUFFER
      CHARACTER*20 FIELDNAME
      CHARACTER    FIELD*2,FCAL*11,FTEMPS*11
      LOGICAL      FOUND
*--
*
      DATA FCAL,FTEMPS /'pha_psa.dat','tempw1.time'/,
     .     TEMPEX /.TRUE./
*-------------------------
C--  redundant : shall never be called as such
      IF (.NOT.ACCUMCOMMON_CORRECT) THEN
        WRITE (*,*) CHAR(7)//
     .     'INIT_CORRECT_PDS: ACCUMCOMMON_CORRECT is false.'
        RETURN
      ENDIF
*
C-- Also check the only interesting field "RiseTime" is present
C-- (see init_correct.f).
*
      DO 1 I=1,ACCUMCOMMON_NF
        IF (ACCUMCOMMON_CORRINDX(I) .NE. 0) GOTO 2
 1    CONTINUE
*
      WRITE (*,*) CHAR(7)//
     .     'INIT_CORRECT_PDS: "RiseTime" field not present.'
      WRITE (*,*) 'INIT_CORRECT_PDS: ACCUMCOMMON_CORRECT set to false.'
      ACCUMCOMMON_CORRECT = .FALSE.
      RETURN
*
 2    CONTINUE
*
    5 FORMAT (A)
*
      CALL GET_GLOBAL_DEFAULT( 'XASTOP',' ',XASTOP )
      IF (XASTOP.EQ.' ') THEN
        WRITE (*,*) CHAR(7)//'INIT_CORRECT_PDS: XASTOP undefined.'
        GOTO 999
      ENDIF
*
C--> This is temporary
      do 550 i=1,ntemp
      TEMPS(i) = 18.0
      TTEMPS(i) = 9d4
 550  continue
*
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
      ELSE
        WRITE (*,*) CHAR(7)//'INIT_CORRECT_PDS: Invalid packet type.'//
     .            'INIT_CORRECT_PDS: ACCUMCOMMON_CORRECT set to false.'
        ACCUMCOMMON_CORRECT = .FALSE.
        RETURN
      ENDIF
*
C-- Get the TIME, PHA, RiseTime and Unit fields
*
      DO 200 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.'TIME') THEN
          ITIMEF = I
        ELSE IF (FIELDNAME(1:TRUE_LENGTH(FIELDNAME)).EQ.'PHA') THEN
          IPHAF = I
        ELSE IF (FIELDNAME(1:TRUE_LENGTH(FIELDNAME)).EQ.'RiseTime') THEN
          IPSAF = I
        ELSE IF (FIELDNAME(1:TRUE_LENGTH(FIELDNAME)).EQ.'Unit') THEN
          IUNITF = I
        ENDIF
  200 CONTINUE
*
C-- Get # of PHA and PSA channels
*
      WRITE (FIELD,202) IPHAF
  202 FORMAT ('m',I1)
      CALL PKTCAP_LOOKUP( FIELD,ITYPE,IPHA,FIELDNAME,FOUND )
      WRITE (FIELD,203) IPHAF
  203 FORMAT ('M',I1)
      CALL PKTCAP_LOOKUP( FIELD,ITYPE,LPHA,FIELDNAME,FOUND )
      NPHAFAC = NPHADEF / (LPHA - IPHA + 1)
      WRITE (FIELD,202) IPSAF
      CALL PKTCAP_LOOKUP( FIELD,ITYPE,IPSA,FIELDNAME,FOUND )
      WRITE (FIELD,203) IPSAF
      CALL PKTCAP_LOOKUP( FIELD,ITYPE,LPSA,FIELDNAME,FOUND )
      NPSAFAC = NPSADEF / (LPSA - IPSA + 1)

c      write(6,*)NPHAFAC,NPSAFAC,IUNITF,IPHAF,IPSAF,INDIR
*
C--  Inquire which I/O unit is free
*
      DO 55 I=10,99
        INQUIRE (UNIT=I,OPENED=LOP)
        IF (.NOT. LOP) GOTO 56
   55 CONTINUE
   56 IUN = I
*
C-- Build the temperature array rebinned to 64 s (use only unit A)
*
      CALL BUILDPATH( FTEMPS,'DATA',NAMETF )
      SAVED = SYSCOMMON_ICONV
      CALL OPEN_TIME( IUN,NAMETF,NAXIS1,NT,NFIELDS,IZOFF )
c      write(6,*)IUN,NAXIS1,NT,NFIELDS,IZOFF
      IF (VOSERROR(IVOS,ISYS) .OR. NT.LE.0) THEN
        WRITE (*,66)  CHAR(7),FTEMPS
   66 FORMAT (A,'INIT_CORRECT_PDS: Error opening temperature file "',
     .        A,'" in DATADIR.'/,'Assuming T=18 C')
C...     .        A,'" in DATADIR.'/,'<Return> to continue.'$)
C...        READ (*,*)
        TEMPEX = .FALSE.
      ELSE
C-- prepare constants for time conversion to OBT
        T0 = UDOUBLE(STARTOBT)*TIMECOMMON_SCCONVERSION
        CALL H_READ_JKEYWORD( 'TIMEREF', DAY70, 0, IER, 1 )
        CALL TIME_1970( STARTARR,START70 )
        TJ = START70 - DAY70
        DO 80 J = 1,NT
          READ (IUN,REC=J+IZOFF,IOSTAT=IER,ERR=1000) TTEMPS(J),TEMPS(J)
C-- convert times to elapsed OBT
          TTEMPS(J) = (TTEMPS(J)-TJ)*TIMECOMMON_SCALE
          TTEMPS(J) = TTEMPS(J) + T0
   80   CONTINUE
        WRITE (*,*) 'INIT_CORRECT_PDS: Temperature time series loaded.' 
      ENDIF
      CALL RESET_TABLE_DESC( HCOMMON_CURFILE )
      CALL CLOSE_XAS_FILE( IUN )
*
C-- Read the temperature dependence coeffs and PHA-PSA table
C-- PHA_CH, PSA(PHW1) PSA(PHW2) PSA(PHW3) PSA(PHW4), skipping comment lines
*
c.      FPHAPSA = XASTOP(1:TRUE_LENGTH(XASTOP))//'/calib/sax/pds/'//FCAL
      CALL BUILDPATH(FCAL,'CALIB',FPHAPSA)

      CALL Z_OPEN( IUN,FPHAPSA,'S','OLD',1 )
      IF (VOSERROR(IVOS,ISYS)) THEN
        WRITE (*,*) CHAR(7)//
     .             'INIT_CORRECT_PDS: Error opening cal file '//FPHAPSA
        GOTO 999
      ENDIF
*
C-- First row contains the 4x2 PSA chan. coeff. dependence with temperature
*
  100 READ (IUN,5,ERR=1000,IOSTAT=IER) BUFFER
      IF (BUFFER(1:1).EQ.'#') GOTO 100
      READ (BUFFER,*,ERR=1000,IOSTAT=IER)
     .       (TFAC(1,J), TFAC(2,J), J=1,4)
*
C-- Second row contains the reference temperature
*
  110 READ (IUN,5,ERR=1000,IOSTAT=IER) BUFFER
      IF (BUFFER(1:1).EQ.'#') GOTO 110
      READ (BUFFER,*,ERR=1000,IOSTAT=IER) TEMP0
*
      I = 1
   10 READ (IUN,5,ERR=1000,END=500,IOSTAT=IER) BUFFER
      IF (BUFFER(1:1).EQ.'#') GOTO 10
      READ (BUFFER,*,ERR=1000,END=500,IOSTAT=IER) PHACH(I,1),PHACH(I,2),
     .                        (PSACH(I,J), PSAFWHM(I,J), J=1,4)
*
C-- Exit if max number of points reached... shouldn't happen!
*
      IF (I .EQ. NBINST) GOTO 500
      I = I + 1
      GOTO 10
*
  500 CLOSE (IUN)
      WRITE (*,*) 'INIT_CORRECT_PDS: NaI PSA peak table loaded.' 
      WRITE (*,*) 'INIT_CORRECT_PDS: ',I,' data read' 
*
C-- Set to 1 the index of the TEMPS/TTEMPS arrays
      JT = 1
      SYSCOMMON_ICONV = SAVED
*
      RETURN
*
C-- Errors
*
 999  WRITE(*,*)' file error : VOS ',IVOS,' sys ',ISYS
      CALL Z_EXIT( 1 )
 1000 CONTINUE
      WRITE(*,*)' data error : IOSTAT = ',IER
      CALL Z_EXIT( 2 )
*
      END
C
C     SUBROUTINE RESET_TABLE_DESC(NTAB)
C-->  this provisional routine resets the table descriptor
C-->  in a future it will be enclosed in close_xas_file
C-->  currently it needs to be called if a time profile is closed
C-->  and another xas file is opened later with less columns than
C-->  the number of logical columns in a time profile
C     INTEGER I,NTAB
C     INCLUDE   'hcommon.inc'
C     INCLUDE   'bincommon.inc'
C     DO 1 I=1,BINCOMMON_MAXFIELDS
C     BINCOMMON_OFFSET(NTAB,I)=-1
C     BINCOMMON_BITPIX(NTAB,I)=0
C     BINCOMMON_DIMENS(NTAB,I)=0
C1    CONTINUE
C     RETURN
C     END
