!
!  Light curve parameters by FITS files
!
!
!  Copyright © 2017 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/>.
!


module lcio

  use iso_fortran_env

  implicit none

  integer, parameter, private :: dbl = selected_real_kind(15)

contains

  subroutine lcimport(tablename,time,flux,dflux)

    use fitsio

    character(len=*), intent(in) :: tablename
    real(dbl), dimension(:), allocatable, intent(out) :: time,flux,dflux

    integer, parameter :: frow = 1, felem = 1
    real(dbl), parameter :: nullval = 0.0_dbl

    integer :: nrows, status, i
    real(dbl), dimension(:), allocatable :: mag, dmag
    character(len=FLEN_CARD) :: buf, qname
    logical :: anyf, mags, check

    status = 0

    ! open and move to a table extension
    call fttopn(15,tablename,0,status)
    call ftgnrw(15,nrows,status)
    if( status /= 0 ) goto 666

    ! read options, name of second column is used to identify the quantity
    call ftgkys(15,'TTYPE2',qname,buf,status)
    mags = index(qname,'MAG') > 0

    if( nrows == 0 ) stop 'lcio: There is no timeseries.'

    allocate(time(nrows),flux(nrows),dflux(nrows))
    call ftgcvd(15,1,frow,felem,nrows,nullval,time,anyf,status)

    if( mags ) then
       allocate(mag(nrows),dmag(nrows))
       call ftgcvd(15,2,frow,felem,nrows,nullval,mag,anyf,status)
       if( status == 0 ) then
          call ftgcvd(15,3,frow,felem,nrows,nullval,dmag,anyf,status)
          if( status /= 0 ) then
             dmag = 0
             status = 0
          end if
          flux = 10**(-0.4*mag)
          dflux = (dmag/mag)*flux
       else
          goto 666
       end if
       deallocate(mag,dmag)
    else
       call ftgcvd(15,2,frow,felem,nrows,nullval,flux,anyf,status)
       if( status == 0 ) then
          call ftgcvd(15,3,frow,felem,nrows,nullval,dflux,anyf,status)
          if( status /= 0 ) then
             dflux = 1e-6
             status = 0
          end if
       end if
    end if

    check = .false.
    do i = 2, size(time)
       if( time(i) < time(i-1) ) check = .true.
    end do
    if( check ) write(error_unit,*) "Warning: Time sequence is no increasing."

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

    return

666 continue

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

    if( allocated(time) ) deallocate(time,flux,dflux)
    if( allocated(mag) ) deallocate(mag,dmag)

    stop 'LCIO'

  end subroutine lcimport


  subroutine lcfourio(tablename,c)

    use fitsio

    character(len=*), intent(in) :: tablename
    complex(dbl), dimension(:), allocatable, intent(out) :: c

    integer, parameter :: frow = 1, felem = 1
    real(dbl), parameter :: nullval = 0.0_dbl

    integer :: nrows, status
    real(dbl), dimension(:), allocatable :: a,b
    logical :: anyf

    status = 0

    ! open and move to a table extension
    call fttopn(15,tablename,0,status)
    call ftgnrw(15,nrows,status)
    if( status /= 0 ) goto 666

    if( nrows == 0 ) stop 'lcio: There are no Fourier coefficients.'

    allocate(a(nrows),b(nrows),c(0:nrows-1))
    call ftgcvd(15,1,frow,felem,nrows,nullval,a,anyf,status)
    call ftgcvd(15,2,frow,felem,nrows,nullval,b,anyf,status)
    if( status /= 0 ) goto 666

    c = cmplx(a,b,dbl)

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

    return

666 continue

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

    if( allocated(a) ) deallocate(a,b,c)

    stop 'FOURIO'


  end subroutine lcfourio

end module lcio
