!
!  time series of photometric quantities (light curves) extracted from calibrated images
!
!  Copyright © 2012-4 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.


program timeseries

  use tmseries
  use fitsio

  implicit none

  integer, parameter :: dbl = selected_real_kind(15)
  character(len=FLEN_FILENAME) :: filename,output,backup,cat
  character(len=4*FLEN_FILENAME) :: line,key,val, timetype = 'JD', timestamp = 'MID', &
       cootype = 'DEG'
  real(dbl), dimension(:), allocatable :: xcoo, ycoo, vxcoo, vycoo
  character(len=FLEN_KEYWORD), dimension(:), allocatable :: fitskeys
  character(len=FLEN_VALUE), dimension(:), allocatable :: cols,coocols
  character(len=FLEN_FILENAME), dimension(:), allocatable :: files
  real(dbl) :: tol = -1.0, x, y, min0 = 0.0, per = 1.0, epoch = 0.0,timeerr = -1, timeres = -1
  logical :: stdout = .false.
  logical :: verbose = .false., diffmag = .false.
  integer :: i,eq,ncoo,nfiles,ncols,ncoocols,status

  nfiles = 0
  ncoo = 0
  ncols = 0
  ncoocols = 0

  extname = PHOTOEXTNAME
  allocate(cols(0),coocols(0))

  allocate(fitskeys(15))
  fitskeys(1) = FITS_KEY_DATEOBS
  fitskeys(2) = 'TIME-OBS'
  fitskeys(3) = FITS_KEY_EXPTIME
  fitskeys(4) = FITS_KEY_FILTER
  fitskeys(5) = 'EQUINOX'
  fitskeys(6) = FITS_KEY_OBJECT
  fitskeys(7) = FITS_KEY_OBSERVER
  fitskeys(8) = FITS_KEY_AUTHOR
  fitskeys(9) = FITS_KEY_INSTRUME
  fitskeys(10) = FITS_KEY_TELESCOP
  fitskeys(11) = FITS_KEY_ORIGIN
  fitskeys(12) = FITS_KEY_BIBREF
  fitskeys(13) = FITS_KEY_LATITUDE
  fitskeys(14) = FITS_KEY_LONGITUDE
  fitskeys(15) = FITS_KEY_PHOTSYS

  do
     read(*,'(a)',end=99) line

     eq = index(line,'=')
     if( eq == 0 ) stop 'Improper input.'

     key = line(:eq-1)
     val = line(eq+1:)

     if( key == 'OUTPUT' ) then

        read(val,*) output,backup

     else if( key == 'VERBOSE' ) then

        read(val,*) verbose

     else if( key == 'EXTNAME' ) then

        read(val,*) extname

     else if( key == 'NCOOCOL' ) then

        read(val,*) ncoocols
        deallocate(coocols)
        allocate(coocols(ncoocols))

     else if( key == 'COOCOL' ) then

        read(val,*) coocols


     else if( key == 'NCOL' ) then

        read(val,*) ncols
        deallocate(cols)
        allocate(cols(ncols))

     else if( key == 'COL' ) then

        read(val,*) cols


     else if( key == 'COOTYPE' ) then

        read(val,*) cootype

     else if( key == 'TIMETYPE' ) then

        read(val,*) timetype

     else if( key == 'TIMESTAMP' ) then

        read(val,*) timestamp

     else if( key == 'TIMEERR' ) then

        read(val,*) timeerr

     else if( key == 'TIMERES' ) then

        read(val,*) timeres

     else if( key == 'NCOO' ) then

        read(val,*) ncoo

        allocate(xcoo(ncoo),ycoo(ncoo),vxcoo(ncoo),vycoo(ncoo))
        ncoo = 0
        vxcoo = 0.0_dbl
        vycoo = 0.0_dbl

     else if( key == 'COO' ) then

        read(val,*) x,y

        if( allocated(xcoo) .and. ncoo < size(xcoo) ) then

           ncoo =  ncoo + 1
           xcoo(ncoo) = x
           ycoo(ncoo) = y

        end if

     else if( key == 'TOL' ) then

        read(val,*) tol

     else if( key == 'DIFFMAG' ) then

        read(val,*) diffmag

     else if( key == 'EPOCH0' ) then

        read(val,*) min0

     else if( key == 'PERIOD' ) then

        read(val,*) per

     else if( key == 'FITS_KEY_DATEOBS' ) then
        read(val,*) fitskeys(1)

     else if( key == 'FITS_KEY_TIMEOBS' ) then ! candidate to remove?

        read(val,*) fitskeys(2)

     else if( key == 'FITS_KEY_EXPTIME'  ) then
        read(val,*) fitskeys(3)

     else if( key == 'FITS_KEY_FILTER' ) then
        read(val,*) fitskeys(4)

     else if( key == 'STDOUT' ) then

        read(val,*) stdout

     else if( key == 'CATALOGUE' ) then

        read(val,*) cat
        call readcat(cat,epoch,xcoo,ycoo,vxcoo,vycoo,status)
        if( status /= 0 ) stop 'Failed to read a catalogue.'
        ncoo = size(xcoo)

     else if( key == 'NFILES' ) then

        read(val,*) nfiles

        allocate(files(nfiles))
        nfiles = 0

     else if( key == 'FILE' ) then

        read(val,*) filename

        if( allocated(files) .and. nfiles < size(files) ) then
           nfiles = nfiles + 1
           files(nfiles) = filename
        end if

     end if

  end do
99 continue

  if( nfiles == 0 ) stop 'No files on input.'

  if( (size(cols) == 0 .or. size(coocols) == 0) .and. extname == PHOTOEXTNAME ) &
       call colinit(files(1))

  call tmseries_init(timetype,timestamp,timeerr,timeres,cootype,nfiles,fitskeys, &
       extname,coocols,cols, tol,min0,per,epoch,diffmag, &
       verbose,stdout,ncoo==0)

  if( allocated(xcoo) ) call tmseries_coo(xcoo,ycoo,vxcoo,vycoo)

  do i = 1,nfiles
     call tmseries_add(files(i))
  end do

  call tmseries_finish(output,backup)

  deallocate(fitskeys)
  if( allocated(files) ) deallocate(files)
  if( allocated(xcoo) ) deallocate(xcoo,ycoo,vxcoo,vycoo)
  deallocate(cols,coocols)

  stop 0

contains

  subroutine readcat(cat,epoch,ra,dec,pmra,pmdec,status)

    use fitsio

    character(len=*), intent(in) :: cat
    real(dbl), intent(out) :: epoch
    real(dbl), dimension(:), allocatable, intent(out) :: ra,dec,pmra,pmdec
    integer, intent(out) :: status

    integer, parameter :: frow = 1, felem = 1
    real(dbl), parameter :: nullval = 0.0_dbl
    real(dbl), parameter :: xpm = 365.25_dbl * 3600.0_dbl

    integer :: nrows, ncols, i
    integer, parameter :: nlabels = 4
    integer, dimension(nlabels) :: col
    character(len=FLEN_VALUE), dimension(nlabels) :: labels
    character(len=FLEN_CARD) :: runits,dunits,buf
    logical :: anyf

    labels(1) = FITS_COL_RA
    labels(2) = FITS_COL_DEC
    labels(3) = FITS_COL_PMRA
    labels(4) = FITS_COL_PMDEC

    status = 0

    call fttopn(15,cat,0,status)
    call ftgkyd(15,FITS_KEY_EPOCH,epoch,buf,status)
    if( status == KEYWORD_NOT_FOUND ) then
       status = 0
       epoch = 2451545.0_dbl
    end if

    call ftgncl(15,ncols,status)
    call ftgnrw(15,nrows,status)
    if( ncols /= size(labels) ) stop 'ncols /= size(labels)'

    ! find columns by labels
    do i = 1, size(labels)
       call ftgcno(15,.true.,labels(i),col(i),status)
    end do
    if( status /= 0 ) goto 666

    ! get units of PM_*
    call ftgkys(15,'TUNIT3',runits,buf,status)
    call ftgkys(15,'TUNIT4',dunits,buf,status)

    allocate(ra(nrows),dec(nrows),pmra(nrows),pmdec(nrows))

    call ftgcvd(15,col(1),frow,felem,nrows,nullval,ra,anyf,status)
    call ftgcvd(15,col(2),frow,felem,nrows,nullval,dec,anyf,status)
    call ftgcvd(15,col(3),frow,felem,nrows,nullval,pmra,anyf,status)
    call ftgcvd(15,col(4),frow,felem,nrows,nullval,pmdec,anyf,status)

    if( status /= 0 ) goto 666

    if( runits == 'arcsec/year' )  pmra = pmra  / xpm
    if( dunits == 'arcsec/year' ) pmdec = pmdec / xpm

    call ftclos(15,status)
    if( status /= 0 ) goto 666

    return

666 continue

    deallocate(ra,dec,pmra,pmdec)

    call ftclos(15,status)
    call ftrprt('STDERR',status)

  end subroutine readcat



  subroutine colinit(filename)

    character(len=*), intent(in) :: filename

    integer, parameter :: extver = 0
    integer :: status, blocksize, ncols, n
    character(len=FLEN_VALUE) :: ttype,key
    character(len=FLEN_COMMENT) :: com

    ! input FITS file
    status = 0
    call ftopen(20,filename,0,blocksize,status)

    ! looking for photometry extension
    call ftmnhd(20,BINARY_TBL,PHOTOEXTNAME,extver,status)
    call ftgncl(20,ncols,status)
    if( status /= 0 .or. ncols < 3 ) goto 666

    if( size(coocols) == 0 ) then
       deallocate(coocols)
       allocate(coocols(2))
       do n = 1,2
          call ftkeyn('TTYPE',n,key,status)
          call ftgkys(20,key,ttype,com,status)
          if( status /= 0 ) goto 666
          coocols(n) = ttype
       end do
    end if

    if( size(cols) == 0 ) then
       deallocate(cols)
       allocate(cols(ncols-2))
       do n = 3,ncols
          call ftkeyn('TTYPE',n,key,status)
          call ftgkys(20,key,ttype,com,status)
          if( status /= 0 ) goto 666
          cols(n-2) = ttype
       end do
    end if

666 continue
    call ftclos(20,status)
    call ftrprt('STDERR',status)

    if( status == BAD_HDU_NUM ) stop 'Photometry extension not found.'

  end subroutine Colinit


end program timeseries
