C  FTOOLs info $Header: /headas/headas/ftools/asca/src/timeconv/timeconv.f,v 3.10 2002/12/26 16:42:26 irby Exp $
C
C*****************************************************************************c
C SELECTOR TASK:
C
C     timeconv
C
C FILE:
C
C     timeconv.f
C
C DESCRIPTION:
C Routine to transform TIME column in a fitsfile from ASCATIME at satellite
C to ASCATIME at geocenter or Barycentric Dynamical Time (TDB).
C
C
C AUTHOR/DATE:
C
C       Yutaro Sekimoto,    Sep  1993
C       Kamae-Group, Dept. of Physics Univ. of Tokyo
C       ysekimoto@tkyvax.phys.s.u-tokyo.ac.jp
C
C MODIFICATION HISTORY:
C     Sep 6, 1993
C         Ver. 0.6 first release
C     Sep 8, 1993  Ver. 0.65
C         Change Keywords TSTART, TSTOP, EXPOSURE
C         Protection for the corrected time
C     Oct 1, 1993 Ver. 1.0 EAG
C	  Add frf.orbit file to parameter list
C	  allow for either ONTIME or EXPOSURE keyword
C	  default extension is 1
C     Dec 10, 1993 Ver 1.1 EAG
C         allow for either TIMEREF or TIMEFRAM keywords
C     May 22, 1994 Ver 1.2 YS
C         Change GTI time
C         Modification of geocen.c
C         Add Barycentric Time on ASCATIME
C     Jun 20, 1994 Ver 1.4 M.Hirayama
C         Change names of correction routines
C            barycen -> asca_barycen
C            barycen_init -> asca_barycen_init
C            geocen -> asca_geocen
C         Add arguments to open_ascadata (file_open, tstart, tstop)
C         Add arguments to asca_gticonv (file_open)
C         Convert TSTART and TSTOP in EVENT extension
C         Add subroutine move_to_extention
C         Remove ftmahd in open_ascadata and in asca_gticonv
C         Modify update_key drastically
C            to check if it is a primary header or not
C            to check keywords first at the beginning of the routine
C            to set comment at the beginning of the routine
C         Convert TSTART and TSTOP in PRIMARY extension
C         Add subroutine correct_asca_time
C         Modify to care TIMESYS in headers
C     Sep 16, 1994 Ver 1.4a M.Hirayama
C         Remove unused variables:
C            In subroutine open_ascadata:
C              "i", "xsize", "ival", "tcstln", "dmode", "bitrate", "keywd",
C              "pos_det", "detect", and "info"
C            In subroutine asca_timeconv:
C              "i", "j", "pha_bin", "ip", "jp", "pi_bin", "geotime",
C              "barytime", "tscale", "tzero", "info", "lastchar", and "fcstln"
C            In update_keyword:
C              "keyvals" and "keyvald"
C            In asca_gticonv:
C              "i", "blocksize", "geotime", "barytime", and "info"
C            In get_asca_event:
C              "ival"
C            In put_asca_event:
C              "ival" and "ival2"
C         Update keywords in STDGTI:
C         Remove tstart/tstop in arguments of update_key:
C         Remove tstart/tstop in arguments of open_ascadata:
C         Not to extract TSTART/TSTOP in open_ascadata:
C         Not to stop task in case of errors in updating keywords
C         Divide asca_geocen() into three functions:
C            asca_geocen_init().......Initializes asca_geocen
C            asca_geocen()............convert ASCATIME to geocentric time
C            asca_geocen_asca2mjd()...convert ASCATIME to MJD
C         Not to initialize asca_geocen/asca_barycen when not necessary
C         Add "extrapolate" to timeconv.par
C         Add "history" to timeconv.par
C         Add subroutine append_history to append HISTORY keywords
C     Apr 10, 1995 Ver 1.50 M.Hirayama
C         Update MJD-OBS keyword  (requested by GSFC)
C         Enrich error handling for errors returned by move_to_extension
C         Use ftgiou/ftfiou to get/free logical unit number
C         Fixed a bug in asca_gticonv()
C            to accept ONTIME instead of EXPOSURE if EXPOSURE not found
C     Feb 24, 1997   Jeff Guerber, GSFC 664/HSTX
C         open_asca_data and asca_gticonv: Changed exact to .false. so ftgcno
C             calls are case-insensitive.
C     Aug 20, 1998  Jeff Guerber, GSFC/HSTX
C         asca_timeconv, asca_gticonv:  Check number of events before
C             get_asca_event(), to avoid new fitsio error.
C         timeconvert: Improved error handling. Still soldiers on, though.
C         get_asca_time: ftgcvd needs a d.p. nulval argument.
C     Dec 12, 1999  Peter Wilson
C          Modify asca_geocen_asca2mjd to take leapseconds into account
C
C NOTES:
C
C
C MAKE:
C
C
C USAGE:
C
C      HOST: htimeconv
C      IRAF: timeconv
C
C ARGUMENTS:
C
C PRIMARY LOCAL VARIABLES:
C
C      data_name - input FITS file and extension number
C      timcolname   - input time column name
C      timeof    - option 1. geocen
C                         2. barycen on TDB
C                         3. barycen on ASCATIME
C      geofile   - database file for barycen
C      ra        - right ascension of target
C      dec       - declination of target
C      frforbit   - frf orbit file
C      extrapolate  - whether to extrapolate orbital elements of the satellite
C                     more than two weeks after
C      verbose   - whether to write information to screen
C      history    - whether to add history record to header
C      status    - FITSIO status
C
C CALLED ROUTINES:
C
C      subroutine time_params - gets parameters from environment.
C      subroutine timeconvert - run main program.
C
C******************************************************************************
C******************************************************************************

      Subroutine timecv
      Implicit none

      Integer status
      Character*160 data_name
      Character*80 timcolname
      Character*160 geofile, frforbit
      Character*40 taskname
      Integer timeop
      Double Precision ra, dec
      Logical extrapolate
      Logical verbose
      Logical history

C SET UP MAIN PROGRAM COMMON BLOCKS:

      Include 'timedefs.inc'
      Common /task/ taskname

C INITIALIZE VARIABLES:

      taskname = 'TIMECONV_V1.53'

C START:
C     GET PARAMETERS FROM PARAM FILE:

      Call time_params (data_name, timcolname,timeop, ra, dec,
     &     geofile, frforbit, extrapolate, verbose, history, status)

      If (status .eq. 0) then

         If (verbose) call fcecho (taskname)

C     RUN MAIN PROGRAM:

         Call timeconvert (data_name, timcolname, timeop, ra, dec,
     &        geofile, frforbit, extrapolate, verbose, history, status)

      End if

C     CHECK FOR ERROR:

      If (status .ne. 0) call fcerrm (status)

      End

C******************************************************************************
C******************************************************************************
C SUBROUTINE:
C
C      time_params
C
C DESCRIPTION:
C
C      gets parameters from the parameter file
C
C
C MODIFICATION HISTORY:
C
C NOTES:
C
C       time_params uses F77/VOS like calls to read parameter from .par file
C
C ARGUMENTS:
C
C      datafile  - input FITS file and extension number
C      timcolname   - input time column name
C      timeof    - option 1. geocen
C                         2. barycen on TDB
C                         3. barycen on ASCATIME
C      geofile   - database file for barycen
C      ra        - right ascension of target
C      dec       - declination of target
C      extrapolate  - whether to extrapolate orbital elements of the satellite
C                     more than two weeks after
C      verbose   - whether to write informational messages
C      history    - whether to add history record to header
C      status    - FITSIO status
C
C LOCAL VARIABLES:
C
C      contxt    - error discription string
C
C CALLED ROUTINES:
C
C      subroutine uclgst - get string parameter
C      subroutine fcecho - echo message to terminal
C      subroutine fcerr  - write error message to terminal
C
C******************************************************************************

      Subroutine time_params(datafile, timcolname, timeop, ra, dec,
     &         geofile, frforbit, extrapolate, verbose, history, status)
      Implicit none
C Argument:
      Character*(*) datafile, timcolname
      Integer timeop
      Double precision  ra
      Double precision   dec
      Character*(*)  geofile, frforbit
      Logical extrapolate, verbose, history
C Local:
      Real ra4
      Real dec4
      Character*80 contxt
      Integer      status
C
C Initialize variables

      status = 0

C Get the name of the input FITS file

      Call uclgst('infile', datafile, status)
      contxt = 'Could not get INFILE (data file) parameter'
      If (status .ne. 0) Goto 999

C Get timeop (time option) geocen or barycen

      Call uclgsi ('timeop', timeop, status)
      contxt = ' Could not get TIMEOP parameter'
      If (status .ne. 0) Goto 999

C Get right ascension of the target

      Call uclgsr ('ra', ra4, status)
      contxt = ' Could not get RA parameter'
      If (status .ne. 0) Goto 999

      ra = ra4

C Get declination of the target

      Call uclgsr ('dec', dec4, status)
      contxt = ' Could not get dec parameter'
      If (status .ne. 0) Goto 999

      dec = dec4

C Get the input TIME column name - hidden parameter

      Call uclgst ('timcolname', timcolname, status)
      contxt = ' Could not get TIMCOLNAME parameter'
      If (status .ne. 0) Goto 999

C Get the geometoryfile for barycentric correction

      Call  uclgst ('geofile', geofile, status)
      contxt = ' Could not get GEOFILE parameter'
      If (status .ne. 0) Goto 999

C Get the frf orbit file

      Call  uclgst ('frforbit', frforbit, status)
      contxt = ' Could not get FRFORBIT parameter'
      If (status .ne. 0) Goto 999

C Get whether to extrapolate orbital elements of the satellite
C more than two weeks after  - hidden paramter

      Call uclgsb ('extrapolate', extrapolate, status)
      contxt = ' Could not get EXTRAPOLATE parameter'
      If (status .ne. 0) Goto 999

C Get whether to write information to screen - hidden paramter

      Call uclgsb ('verbose', verbose, status)
      contxt = ' Could not get VERBOSE parameter'
      If (status .ne. 0) Goto 999

C Get whether to add history record - hidden paramter

      Call uclgsb ('history', history, status)
      contxt = ' Could not get HISTORY parameter'
      If (status .ne. 0) Goto 999

C Handle error

 999  Continue
      If (status .ne. 0) Call fcerr (contxt)

      End

C******************************************************************************
C******************************************************************************
C     SUBROUTINE:
C
C     timeconvert
C
C     DESCRIPTION:
C
C     main program
C
C     MODIFICATION HISTORY:
C
C     NOTES:
C
C     USAGE:
C
C     ARGUMENTS:
C
C     data_name - input FITS file and extension number
C     timcolname   - input time column name
C      timeof    - option 1. geocen 2. barycen
C      geofile   - database file for barycen
C      ra        - right ascension of target
C      dec       - declination of target
C     frforbit   - frf orbit file
C     extrapolate - whether to extrapolate orbital elements of the satellite
C                   more than two weeks after
C     verbose   - whether to write informational messages
C     history    - whether to add history record to header
C     status    - FITSIO status
C
C     CALLED ROUTINES:
C
C     subroutine fcecho - echo message to terminal
C     function   fcstln - returns index of last non-blank character
C     subroutine ftxxxx - FITSIO calls
C
C******************************************************************************

      Subroutine timeconvert(data_name, timcolname, timeop, ra, dec,
     &     geofile, frforbit, extrapolate, verbose, history, status)
      Implicit none
C Argument:
      Character*(*) data_name
      Character*(*) timcolname
      Character*(*) geofile, frforbit
      Integer timeop
      Integer status
      Double Precision ra, dec
      Logical extrapolate, verbose, history
C Include:
      Include 'timedefs.inc'
C constant:
      Double Precision MAXEXTRAPOLATE
      Parameter (MAXEXTRAPOLATE = 14.0D0)
C Local:
      Integer data_unit, stat
      Integer n_events
      Integer time_col
      Double Precision mjdobs, mjdref
      Double Precision exposure
      Integer timefram
      data timefram /-1/
      Logical file_open
      Character*80 info
      Integer hdutype
      Double Precision epoch, orbelem(15)

C     INITIALIZE VARIABLES:

      stat = 0
      Call ftgiou(data_unit, status)
      file_open = .FALSE.

C Start:

      If (status .ne. 0) Goto 999

C Open data file:

      Write(info, 222)
     &     'reading data file: ', data_name(1:57)
      If (verbose) call fcecho (info)

      Call open_ascadata (data_name, data_unit,
     &     time_col, timcolname, file_open, mjdobs, mjdref,
     &     timefram, n_events, status)

      If (status .ne. 0) Goto 999

      If (timeop.le.timefram) then
         Call fcecho (' Time convert has aleady done ! ')
         status = 1
         Return
      End if

C Time conversion:

C Intialize geocentric correction and check epoch of orbital elements:

      If ((timefram.lt.1).and.(timeop.ge.1)) then
         Call asca_geocen_init(mjdobs, ra, dec, frforbit,
     &        epoch, orbelem, status)
         If (status.ne.0) then
            Call fcerr('Error: Could not set orbital elements')
            Goto 999
         End if
         Write(info,*) ' the data start time (MJD) :', mjdobs
         If (verbose) Call fcecho(info)
         Write(info,*) ' epoch of orbital elements (MJD) :', epoch
         If (verbose) Call fcecho(info)
         If (abs(mjdobs-epoch) .gt. MAXEXTRAPOLATE) then
            Write(info,*) 'Warning: Could not get orbital elements',
     &           ' close enough to the observation date.'
            Call fcerr(info)
            If (.not.extrapolate) Goto 999
         End if
      End if

C Initialize barycentric correction:

      If ((timefram.lt.2).and.(timeop.ge.2)) then
         Call asca_barycen_init(ra, dec, geofile)
      End if

C Convert ASCATIME in EVENTS extension:

      If (verbose) Call fcecho('processing data...')

      status = 0
      info = 'ERROR: Error in converting TIME in EVENTS extension'
      Call move_to_extension(data_unit, 'EVENTS', hdutype, status)
      If (status .eq. 0)
     &    Call asca_timeconv(data_unit,timeop, time_col,
     &        mjdref, n_events, timefram, verbose, status)

      If (status .ne. 0) then
          call fcerr(info)
          call fcerrm(status)
      Endif

C Convert ASCATIME in STDGTI:

      Call fcecho('changing STDGDI ...')

      status = 0
      info = 'ERROR: Error in converting STDGTI'
      Call move_to_extension(data_unit,'STDGTI', hdutype, status)
      If (status .eq. 0)
     &    Call asca_gticonv(data_unit, timefram, timeop,
     &        mjdref, verbose, file_open, exposure, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

C Update keywords in primary header:

      If (verbose) Call fcecho('updating primary header...')

      status = 0
      info = 'Warning: Error in updating primary header'
      Call move_to_extension(data_unit, 'PRIMARY', hdutype, status)
      If (status .eq. 0)
     &    Call update_key(data_unit, timefram, timeop,
     &        mjdref, exposure, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

      Call fcecho('end of update')

C Update keywords in EVENTS extension:

      If (verbose) Call fcecho('updating EVENTS extension header...')

      status = 0
      info = 'Warning: error in updating EVENTS extension header'
      Call move_to_extension(data_unit, 'EVENTS', hdutype, status)
      If (status .eq. 0)
     &    Call update_key (data_unit, timefram, timeop,
     &         mjdref, exposure, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

      Call fcecho('end of update')

C Update keywords in STDGTI extension:

      If (verbose) Call fcecho('updating STDGTI extension header...')

      status = 0
      info = 'Warning: error in updating STDGTI extension header'
      Call move_to_extension(data_unit, 'STDGTI', hdutype, status)
      If (status .eq. 0)
     &    Call update_key (data_unit, timefram, timeop,
     &        mjdref, exposure, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

      Call fcecho('end of update')

C Appending HISTORY keywords:

      If (verbose) Call fcecho('appending HISTORY keywords...')

      status = 0
      info = 'Warning: error in appending HISTORY keywords'
     &    //' to PRIMARY header'
      Call move_to_extension(data_unit, 'PRIMARY', hdutype, status)
      If (status .eq. 0)
     &    Call append_history(data_unit, data_name, timefram,
     &        timeop, ra, dec, geofile, frforbit, epoch, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

      status = 0
      info = 'Warning: error in appending HISTORY keywords'
     &    //' to EVENTS extension header'
      Call move_to_extension(data_unit, 'EVENTS', hdutype, status)
      If (status .eq. 0)
     &    Call append_history(data_unit, data_name, timefram,
     &        timeop, ra, dec, geofile, frforbit, epoch, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

      status = 0
      info = 'Warning: error in appending HISTORY keywords'
     &    //' to STDGTI extension header'
      Call move_to_extension(data_unit, 'STDGTI', hdutype, status)
      If (status .eq. 0)
     &    Call append_history(data_unit, data_name, timefram,
     &        timeop, ra, dec, geofile, frforbit, epoch, status)

      If (status .ne. 0) then
          Call fcerr(info)
          Call fcerrm(status)
      End if

C Close data file:

 999  Continue
      If (file_open) then
         If (verbose) call fcecho('closing data file...')
         Call fcecho('file closed')
         Call ftclos(data_unit, status)
         Call ftfiou(data_unit, status)
      End if

      If (status .ne. 0) then
          Call fcerrm(status)
      Endif

C Format

 222  Format(a23, a57)

      End

C******************************************************************************

      Subroutine open_ascadata (data_name, iunit,
     &     time_col, timcolname, file_open, mjdobs, mjdref,
     &     timefram, n_events, status)
      Implicit none

C Arguments:
      Character*(*) data_name
      Integer iunit
      Integer time_col
      Character*(*) timcolname
      Logical file_open
      Double precision mjdobs, mjdref
      Integer timefram
      Integer n_events
      Integer status
C Include:
      Include 'timedefs.inc'
C Common:
      Common /task/ taskname
C Constant:
      Integer maxcl
      Parameter (maxcl = 512)
C Local:
      Integer stat
      Double precision tscale, tzero
      Integer hdutype, nrecords, xtensn, rwmode, block, rowlen
      Integer vardat, tfield, tbcol(maxcl)
      Character*80 filenm, ttype(maxcl), tform(maxcl), tunit(maxcl)
      Character*80 extnam, contxt, comment
      Character*40 taskname
      Logical exact
      Character*80 timefram_s, timesys
      Logical history

C Initialize variables

      tzero  = 0.0
      tscale = 1.0
      exact = .false.
      rwmode = 1

C Get input file name and extension

      Call fcpars (data_name, filenm, xtensn, status)
      contxt = ' Unable to parse data file name and extension '
      If (status .ne. 0) Goto 999

C Default to 1st extension

      If (xtensn .eq. -99) xtensn = 1

C Open data file

      Call ftopen (iunit, filenm, rwmode, block, status)
      contxt = ' Unable to open ASCA data file: '//filenm
      If (status .ne. 0) Goto 999
      file_open = .TRUE.

C Check for reasonable extension number

      contxt = ' Primary array not supported'
      If (xtensn .le. 0) then
         status = 999
         Goto 999
      End if

C Move to the correct extension

C      Call ftmahd (iunit, 2, hdtype, status)
      Call move_to_extension(iunit, 'EVENTS', hdutype, status)
      contxt = ' Error moving to requested extension'
      If (status .ne. 0) Goto 999

C Get header depending on extension type

      If (hdutype .eq. 1) then
         Call ftghtb (iunit, maxcl, rowlen, nrecords, tfield,
     &        ttype, tbcol, tform, tunit, extnam, status)
      Else If (hdutype .eq. 2) then
         Call ftghbn (iunit, maxcl, nrecords, tfield, ttype,
     &        tform, tunit, extnam, vardat, status)
      Else
         contxt = ' file extension type not supported'
         Goto 999
      End if

      contxt = ' error getting extension header info'
      If (status .ne. 0) Goto 999

Ccc
C     reset scaling for table columns (ignore scaling parameters):
c
c        do i=1, tfield
c           call fttscl(iunit, i, tscale, tzero, status)
c        end do
c
c        contxt = ' error reseting TSCALE/TZERO values'
c        if (status .ne. 0) goto 999
Ccc
      n_events = nrecords

C Get extension observation parameters

      Call ftgkyd(iunit, 'MJD-OBS', mjdobs, comment, status)
      contxt = ' cannot get MJD-OBS'
      If (status .ne. 0) Goto 999

      Call ftgkyd(iunit, 'MJDREF', mjdref, comment, status)
      contxt = ' cannot get MJDREF'
      If (status .ne. 0) Goto 999

      Call ftgkys(iunit,'TIMEFRAM', timefram_s,comment,status)
CEAG
      If (status .eq. 202) then
         status = 0
         Call ftgkys(iunit,'TIMEREF', timefram_s,comment,status)
      End if
CEAG
CEAG
C      contxt = ' cannot get TIMEFRAM'
      contxt = ' cannot get TIMEFRAM or TIMEREF'
CEAG
      If (status .ne. 0) Goto 999

      Call ftgkys(iunit,'TIMESYS', timesys, comment, status)
      contxt = ' cannot get TIMESYS from EVENTS extention'
      If (status .ne. 0) Goto 999

      If(timefram_s .eq. 'LOCAL ') then
         timefram = 0
      Else If(timefram_s .eq. 'GEOCENTRIC ') then
         timefram = 1
      Else If(timefram_s .eq. 'SOLARSYSTEM ') then
         If (timesys .eq. 'TDB') then
            timefram = 2
         Else If (timesys .eq. '1993.0') then
            timefram = 3
         Else
            contxt = ' unknown TIMESYS detected'
            Goto 999
         Endif
      Else
         contxt = ' unknown TIMEFRAM detected'
         Goto 999
      Endif

C Check that the TIME columns exist

      Call ftgcno (iunit, exact, timcolname, time_col, status)
      contxt = ' TIME column does not exist'
      If (status .ne. 0) Goto 999

C Return:

      Return

C Handle error

 999  Call fcerr(contxt)
      Write(contxt,*) 'Umm... status = ', status
      Call fcerr(contxt)
      Call ftclos (iunit, stat)
      file_open = .FALSE.

      End

C******************************************************************************
      Subroutine asca_timeconv(iunit, timeop, time_col, mjdref,
     &     n_events, timefram, verbose, status)
      Implicit none
C Argument:
      Integer iunit
      Integer timeop
      Integer time_col
      Double Precision mjdref
      Integer n_events
      Integer timefram
      Logical verbose
      Integer status
C Local:
      Integer counts
      Integer start, event
      Double precision asca_time
      Double precision correct_time
      Character*80 string

c      parameter(deg_to_rad = 0.01745329)

C     check if valid file:
c
c        if (.not.(datamode.eq.PH_mode .or. datamode.eq.PH2_mode)) then
c        if (.not.(datamode.eq.PH_mode .or. datamode.eq.MPC_mode)) then
c           call fcerr(' ERROR: non-timing data mode!')
c           status = 999
c           return
c        end if

C Intialize local variables:

      start = 0
      status = 0
      event = 1
      counts = n_events

C Read the first event record:

      Call get_asca_event (iunit, event, asca_time, time_col, status)

C Loop through events:

      Do while (status .eq. 0 .and. event .le. counts)

         Call correct_asca_time(asca_time, timefram, timeop,
     &        mjdref, correct_time, status)
         Call put_asca_event(iunit,event,correct_time,time_col,status)

C Get next event:

         event = event + 1
         if (event .le. counts)  Call get_asca_event(iunit, event,
     &       asca_time, time_col, status)

      End do

C Loop end:

c     tstop = correct_time

      If (verbose) then
         Write(string, 1000) event - 1
 1000    Format (' Number of EVENT records processed = ', I10)
         Call fcecho (string)
      End if

      Return
      End

C******************************************************************************
      Subroutine update_key(data_unit, timefram, timeop,
     &     mjdref, exposure, status)
      Implicit none
C Input:
      Integer  data_unit
      Integer timefram, timeop
      Double Precision mjdref
      Double Precision exposure
C Output:
      Integer status
C Include:
      include 'timedefs.inc'
C Constant:
      Double Precision DAYSEC
      Parameter (DAYSEC=86400.0D0)
C Local:
      Integer decimals
      Character*80 comment
      Character*40 taskname
      Character*80 cmt_tstart, cmt_tstop, cmt_exposure
      Character*80 cmt_timefram, cmt_timesys, cmt_mjdobs
      Character*8 key_tstart, key_tstop, key_exposure
      Character*8 key_timefram, key_timesys, key_mjdobs
      Character*80 cval, timefram_s, timesys
      Double Precision tstart, tstop, mjdobs
      Double Precision tstart_original, tstop_original
      Logical ok_tstart, ok_tstop, ok_exposure
      Logical ok_timefram, ok_timesys, ok_mjdobs
c      Logical primary
c      Integer hdutype
C Common:
      Common /task/ taskname

C Initialize local variables:

      decimals = 14

C Chack if it is a primary header or not:
c
c      Call ftmrhd(data_unit, 0, hdutype, status)
c      If (status.eq.0) then
c         If (hdutype.eq.0) then
c            primary = .true.
c         Else
c            primary = .false.
c         End if
c      Else
c         Goto 999
c      End if
c
C Check keywords:

      status = 0
      key_tstart = 'TSTART'
      comment = 'Warning: missing TSTART keywords'
      Call ftgkey(data_unit, key_tstart, cval, comment, status)
      If (status.ne.0) Call fcerr(comment)
      ok_tstart = (status.eq.0)

      status = 0
      key_tstop = 'TSTOP'
      comment = 'Warning: missing TSTOP keywords'
      Call ftgkey(data_unit, key_tstop, cval, comment, status)
      If (status.ne.0) Call fcerr(comment)
      ok_tstop = (status.eq.0)

      status = 0
      key_exposure = 'EXPOSURE'
      comment = 'Warning: missing EXPOSURE or ONTIME keywords'
      Call ftgkey(data_unit, key_exposure, cval, comment, status)
      If (status.eq.202) then
         status = 0
         key_exposure = 'ONTIME'
         Call ftgkey(data_unit, key_exposure, cval, comment, status)
      End if
      If (status.ne.0) Call fcerr(comment)
      ok_exposure = (status.eq.0)

      status = 0
      key_timefram = 'TIMEFRAM'
      comment = 'Warning: missing TIMEFRAM or TIMEREF keywords'
      Call ftgkey(data_unit, key_timefram, cval, comment, status)
      If (status.eq.202) then
         status = 0
         key_timefram = 'TIMEREF'
         Call ftgkey(data_unit, key_timefram, cval, comment, status)
      End if
      If (status.ne.0) Call fcerr(comment)
      ok_timefram = (status.eq.0)

      status = 0
      key_timesys = 'TIMESYS'
      comment = 'Warning: missing TIMESYS keywords'
      Call ftgkey(data_unit, key_timesys, cval, comment, status)
      If (status.ne.0) Call fcerr(comment)
      ok_timesys = (status.eq.0)

      status = 0
      key_mjdobs = 'MJD-OBS'
      comment = 'Warning: missing MJD-OBS keywords'
      Call ftgkey(data_unit, key_mjdobs, cval, comment, status)
      If (status.ne.0) Call fcerr(comment)
      ok_mjdobs = (status.eq.0)

C Get TSTART/TSTOP:

      If (ok_tstart) then
         status = 0
         comment = 'Warning: cannot get TSTART'
         Call ftgkyd(data_unit,'TSTART',tstart_original,comment,status)
         If (status.ne.0) Call fcerr(comment)
         ok_tstart = (status.eq.0)
      End if

      If (ok_tstop) then
         status = 0
         comment = 'Warning: cannot get TSTOP'
         Call ftgkyd(data_unit,'TSTOP',tstop_original,comment,status)
         If (status.ne.0) Call fcerr(comment)
         ok_tstop = (status.eq.0)
      End if

C Convert TSTART/TSTOP and calculate MJD-OBS:

      If (ok_tstart) then
         status = 0
         comment = 'Warning: failed to convert TSTART'
         Call correct_asca_time(tstart_original, timefram, timeop,
     &        mjdref, tstart, status)
         If (status.ne.0) Call fcerr(comment)
         ok_tstart = (status.eq.0)
      End if

      If (ok_tstop) then
         status = 0
         comment = 'Warning: failed to convert TSTOP'
         Call correct_asca_time(tstop_original, timefram, timeop,
     &        mjdref, tstop,status)
         If (status.ne.0) Call fcerr(comment)
         ok_tstop = (status.eq.0)
      End if

      If (ok_mjdobs.and.ok_tstart) then
         status = 0
         comment = 'Warning: failed to calculate MJD-OBS'
         mjdobs = tstart/DAYSEC + mjdref
         If (status.ne.0) Call fcerr(comment)
         ok_mjdobs = (status.eq.0)
      End if

C Set variables depending on timeop:

      If (timeop.eq.1) then

         cmt_tstart = ' data start time on geocenteric time '
         cmt_tstop = ' data end time on geocenteric time '
         cmt_exposure = ' exposure time on geocenteric time '
         cmt_timefram = 'Geocentric correction is applied to times'
         timefram_s = 'GEOCENTRIC'
         cmt_timesys = 'Time measured from 1993 Jan 1 00:00 UT'
         cmt_mjdobs = 'Modified Julian date of the data start time'
         timesys = '1993.0'

      Else If (timeop.eq.2) then

         cmt_tstart = ' data start time on barycenteric time '
         cmt_tstop  = ' data end time on barycenteric time '
         cmt_exposure = ' exposure time on barycenteric time '
         cmt_timefram = 'Barycentric correction is applied to times'
         timefram_s = 'SOLARSYSTEM'
         cmt_timesys = 'Time measured from 1993 Jan 1 00:00 TDB'
         cmt_mjdobs = 'Modified Julian date of the data start time'
         timesys = 'TDB'

      Else if (timeop.eq.3) then

         cmt_tstart = ' data start time on barycenteric asca-time '
         cmt_tstop = ' data end time on barycenteric asca-time '
         cmt_exposure = ' exposure time on barycenteric asca-time '
         cmt_timefram = 'Barycentric correction is applied to times'
         timefram_s = 'SOLARSYSTEM'
         cmt_timesys = 'Time measured from 1993 Jan 1 00:00 UT'
         cmt_mjdobs = 'Modified Julian date of the data start time'
         timesys = '1993.0'
      End if

C Update keyword:

      If (ok_tstart) then
         status = 0
         comment = 'Warning: failed to update TSTART keywords'
         Call ftmkyd(data_unit, key_tstart, tstart, decimals,
     &        cmt_tstart,status)
         If (status.ne.0) Call fcerr(comment)
      End if

      If (ok_tstop) then
         status = 0
         comment = 'Warning: failed to update TSTOP keywords'
         Call ftmkyd(data_unit,key_tstop, tstop, decimals,
     &        cmt_tstop,status)
         If (status.ne.0) Call fcerr(comment)
      End if

      If (ok_exposure) then
         status = 0
         comment = 'Warning: '//
     &        'failed to update EXPOSURE or ONTIME keyword'
         Call ftmkyd(data_unit, key_exposure, exposure, decimals,
     &        cmt_exposure,status)
         If (status.ne.0) Call fcerr(comment)
      End if

      If (ok_timefram) then
         status = 0
         comment = 'Warning: '//
     &        'failed to update TIMEFRAM or TIMEREF keyword'
         Call ftmkys(data_unit, key_timefram, timefram_s,
     &        cmt_timefram, status)
         If (status.ne.0) Call fcerr(comment)
      End if

      If (ok_timesys) then
         status = 0
         comment = 'Warning: failed to update TIMESYS keywords'
         Call ftmkys(data_unit, key_timesys, timesys,
     &        cmt_timesys, status)
         If (status.ne.0) Call fcerr(comment)
      End if

      If (ok_mjdobs.and.ok_tstart) then
         status = 0
         comment = 'Warning: failed to update MJD-OBS keywords'
         Call ftmkyd(data_unit, key_mjdobs, mjdobs, decimals,
     &        cmt_mjdobs,status)
         If (status.ne.0) Call fcerr(comment)
      End if

      Return
      End

C**************************************************************************
      Subroutine asca_gticonv(iunit, timefram, timeop,
     &     mjdref, verbose, file_open, exposure, status)
      Implicit none
C Input:
      Integer iunit
      Integer timefram, timeop
      Double Precision mjdref
      Double Precision ra, dec
      Character*160 frforbit
      Logical verbose
C Modify:
      Logical file_open
C Output:
      Double precision exposure
      Integer status
C Local:
      Integer hdutype, rowlen, nrecords, tfield
      Integer maxcl, stat
      Parameter (maxcl = 512)
      Integer tbcol(maxcl)
      Character*80 ttype(maxcl), tunit(maxcl), tform(maxcl)
      Integer vardat
      Integer  lastchar, fcstln
      Integer start_col, stop_col
      Integer start, event, n_events, counts
      Double precision start_time, stop_time
      Double precision cstart_time, cstop_time
      Double precision tscale, tzero
      Character*80 string, contxt, extnam, extype, comment
      Include 'timedefs.inc'
      Logical exact
      Double precision TDB2ASCA
      Parameter (TDB2ASCA = 59.184)
      Integer decimals

C Initialize local variables:

      tzero = 0.0
      tscale = 1.0
      exact = .false.
      decimals = 14

C Get header depending on extension type

      Call ftgkys(iunit, 'XTENSION', extype, comment, status)
      If (status.ne.0) then
         contxt = ' failed to get a file extension type'
         Goto 998
      Else if (extype.eq.'TABLE') then
         Call ftghtb (iunit, maxcl, rowlen, nrecords, tfield,
     &        ttype, tbcol, tform, tunit, extnam, status)
      Else if (extype.eq.'BINTABLE') then
         Call ftghbn (iunit, maxcl, nrecords, tfield, ttype,
     &        tform, tunit, extnam, vardat, status)
      Else
         contxt = ' file extension type not supported'
         Goto 998
      End if

C
C Reset scaling for table columns (ignore scaling parameters):

      status = 0
      n_events = nrecords

C Check if the START and STOP columns exist

      Call ftgcno (iunit, exact,'START ', start_col, status)
      contxt = ' START column does not exist'
      If (status .ne. 0) Goto 998

      Call ftgcno (iunit, exact,'STOP ', stop_col, status)
      contxt = ' STOP column does not exist'
      If (status .ne. 0) Goto 998

C Intialize local variables:

      start = 0
      status = 0
      event = 1
      counts = n_events
      exposure = 0.0

C Read the first event record:

      Call get_asca_event (iunit, event, start_time, start_col, status)
      Call get_asca_event (iunit, event, stop_time, stop_col, status)

C Loop through events:

      Do while (status .eq. 0 .and. event .le. counts)

C Get an event:

         lastchar = fcstln(frforbit)
         frforbit(lastchar+1:) = char(0)

         Call correct_asca_time(start_time, timefram, timeop,
     &        mjdref, cstart_time, status)
         Call correct_asca_time(stop_time, timefram, timeop,
     &        mjdref, cstop_time, status)

         Call put_asca_event(iunit,event,cstart_time,start_col,status)
         Call put_asca_event(iunit,event,cstop_time,stop_col,status)
         exposure = exposure + (cstop_time - cstart_time)

C Get next event

         event = event + 1
         if (event .le. counts) then
             Call get_asca_event(iunit,event,start_time,start_col,
     &           status)
             Call get_asca_event(iunit,event,stop_time,stop_col,status)
         endif

C Loop end:

      End do

      contxt = ' error occurred in converting STDGTI'
      If (status.ne.0) Goto 998

C Update EXPOSURE:

      If (timeop.eq.1) then
         comment = ' exposure time on geocenteric time '
      Else If (timeop.eq.2) then
         comment = ' exposure time on barycenteric time '
      Else if (timeop.eq.3) then
         comment = ' exposure time on barycenteric asca-time '
      End if

      Call ftmkyd(iunit, 'EXPOSURE', exposure, decimals,
     &     comment ,status)
      If (status.eq.202) then
         status = 0
         Call ftmkyd(iunit, 'ONTIME', exposure, decimals,
     &        comment ,status)
      End if

      contxt = ' error occurred in updating EXPOSURE or ONTIME keywords'
      If (status.ne.0) Goto 998

C Print out messages:

      If (verbose) then
         Write(string, 1000) event - 1
 1000    Format (' Number of GTI records processed = ', I10)
         Call fcecho (string)
      End if
      Return

 998  call fcerr(contxt)
      call  ftclos (iunit, stat)
      file_open = .FALSE.

      End

C******************************************************************************
      Subroutine get_asca_event (iunit, k, asca_time, time_col, status)
      Implicit None
C Argument:
      Integer iunit, k
      double precision asca_time
      Integer time_col
C Include:
       include 'timedefs.inc'
C Local:
      Integer anyf, status
      double precision dval

      Call ftgcvd(iunit, time_col, k, 1, 1, 0.0d0, dval, anyf, status)
      asca_time = dval

      Return
      End

C******************************************************************************
      Subroutine put_asca_event (iunit, k, asca_time, time_col, status)
      Implicit None
C Argument:
      Integer iunit, k
      Double precision asca_time
      Integer time_col
C Include:
      Include 'timedefs.inc'
C Local:
      Integer status
      Double precision dval

      dval = asca_time
      Call ftpcld(iunit, time_col, k, 1, 1, dval, status)

      Return
      End

C******************************************************************************
      Subroutine correct_asca_time (asca_time, timefram, timeop,
     &     mjdref, correct_time, status)
      Implicit None
C Input:
      Double precision asca_time
      Integer timefram, timeop
      Double precision mjdref
C Output:
      Double precision correct_time
      Integer status
C Include:
      Include 'timedefs.inc'
C Constant:
      Double precision TDB2ASCA
      Parameter (TDB2ASCA = 59.184)
      Double precision MJDREFERENCE
      Parameter (MJDREFERENCE = 48988.0)
      Double precision EPS
      Parameter (EPS = 1.0D-10)
C Local:
      Double precision dif
      Double precision geotime, barytime, ascabary
      Character*80 info

C Check MJDREF

      dif = abs(mjdref - MJDREFERENCE)
      If (dif.gt.EPS) then
         Write(info,*) 'Warning : Unexpected MJDREF',
     &        mjdref, ' is found.'
         Call fcerr(info)
         Call fcerr('Warning : MJDREF=48988.0 is assumed.')
      End if

C Geocentric correction (asca_time -> geotime):

      If ((timefram.lt.1).and.(timeop.ge.1)) then
         Call asca_geocen(asca_time, geotime)
      Else
         geotime = asca_time
      End if
      correct_time = geotime

C Barycentric correction (geotime -> barytime):

      If ((timefram.lt.2).and.(timeop.ge.2)) then
         Call asca_barycen(geotime, barytime)
      Else
         barytime = geotime
      End if
      correct_time = barytime

C Correction to barycentric ASCATIME (barytime -> ascabary):

      If ((timefram.lt.3).and.(timeop.ge.3)) then
         ascabary = barytime - TDB2ASCA
      Else
         ascabary = barytime
      End if
      correct_time = ascabary

      Return
      End

C******************************************************************************
      Subroutine move_to_extension (iunit, extname, hdutype, status)
      Implicit None
C Input:
      Integer iunit
      Character*(*) extname
C Output:
      Integer status
      Integer hdutype
C Local:
      Character*80 ext, comment, contxt

C Initialize local variables:
      status = 0
      Write(contxt,'(A,A8,A)') 'Error moving to ', extname, ' extension'

C Check current extension name:

      Call ftgkys(iunit, 'EXTNAME', ext, comment, status)
      If ((status.eq.0).and.(ext.eq.extname)) Return
      status = 0

C Move to primary header:

      Call ftmahd(iunit, 1, hdutype, status)
      If (status.ne.0) Goto 999
      If ((extname.eq.' ').or.(extname.eq.'PRIMARY')) Return

C Move to specified extension:

      Do while ((status.eq.0).and.(ext.ne.extname))
         Call ftmrhd(iunit, 1, hdutype, status)
         If (status.eq.0) then
            Call ftgkys(iunit, 'EXTNAME', ext, comment, status)
         End if
      End do

      If (status.ne.0) Goto 999

C Return:

      Return

C Handle error:

 999  Call fcerr(contxt)
      Return

      End

C******************************************************************************
      Subroutine append_history(data_unit, data_name,
     &     timefram, timeop, ra, dec, geofile, frforbit, epoch, status)
      Implicit None
C Input:
      Integer data_unit
      Character*(*) data_name
      Integer timefram, timeop
      Double Precision ra, dec
      Character*(*) geofile, frforbit
      Double precision epoch
C Output:
      Integer status
C Task name:
      Character*40 taskname
      Common /task/ taskname
      Integer length, fcstln
C Local:
      Character*256 info
      Character*80 timesys(0:3)
      data timesys
     &     /'ASCATIME at the satellite',
     &      'ASCATIME at the geocenter',
     &      'Barycentric Dynamical Time (TDB)',
     &      'ASCATIME at the solar system barycenter'/

C Task name:

      length = fcstln(taskname)
      Write(info,*) 'TASK ', taskname(:length), ' on ', data_name
      Call ftphis(data_unit, info, status)
      Write(info,*) '   converted from ', timesys(timefram)
      Call ftphis(data_unit, info, status)
      Write(info,*) '   converted to ', timesys(timeop)
      Call ftphis(data_unit, info, status)

C NOT to append in case of barycen -> barycen-ASCA

      If (timefram.lt.2) then
         Write(info,*) '   R.A. in degree (J2000) = ', ra
         Call ftphis(data_unit, info, status)
         Write(info,*) '   Dec. in degree (J2000) = ', dec
         Call ftphis(data_unit, info, status)
      End if

C Geocentric correction:

      If ((timefram.lt.1).and.(timeop.ge.1)) then
         Write(info,*) '   Orbital parameter file = ', frforbit
         Call ftphis(data_unit, info, status)
         Write(info,*) '   Epoch of orbital elements (MJD) = ', epoch
         Call ftphis(data_unit, info, status)
      End if

C Barycentric correction:

      If ((timefram.lt.2).and.(timeop.ge.2)) then
         Write(info,*) '   Earth''s geometry file = ', geofile
         Call ftphis(data_unit, info, status)
      End if

      Return
      End

