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

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

    real(dbl), parameter :: nullval = 0.0_dbl

    integer :: nrows, srows, status, i, l, frow
    real(dbl), dimension(:), allocatable :: mag, dmag
    character(len=FLEN_CARD) :: qname
    logical :: anyf, mags, check
    type(fitsfiles) :: fits

    status = 0

    ! open and move to a table extension
    call fits_open_table(fits,tablename,FITS_READONLY,status)
    if( status /= 0 ) then
       write(error_unit,*) &
            'Error: failed to read a table in the file `',trim(tablename),"'."
       stop 'LCIO'
    end if

    call fits_get_num_rows(fits,nrows,status)
    if( status /= 0 ) goto 666
    if( nrows == 0 ) stop 'lcio: There is no timeseries.'

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

    allocate(time(nrows),flux(nrows),dflux(nrows))
    if( mags ) then
       allocate(mag(nrows),dmag(nrows))
    end if

    call fits_get_rowsize(fits,srows,status)
    do i = 1, nrows, srows
       frow = i
       l = min(i+srows,nrows)

       call fits_read_col(fits,1,frow,nullval,time(i:l),anyf,status)

       if( mags ) then
          call fits_read_col(fits,2,frow,nullval,mag(i:l),anyf,status)
          call fits_read_col(fits,3,frow,nullval,dmag(i:l),anyf,status)
       else
          call fits_read_col(fits,2,frow,nullval,flux(i:l),anyf,status)
          call fits_read_col(fits,3,frow,nullval,dflux(i:l),anyf,status)
       end if

       if( status /= 0 ) goto 666
    end do

    if( mags ) then
       flux = 10**(-0.4*mag)
       dflux = (dmag/mag)*flux
       deallocate(mag,dmag)
    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 fits_close_file(fits,status)
    return

666 continue

    call fits_close_file(fits,status)
    call fits_report_error(error_unit,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

    real(dbl), parameter :: nullval = 0.0_dbl

    integer :: nrows, srows, status, frow, i, l
    real(dbl), dimension(:), allocatable :: a,b
    logical :: anyf
    type(fitsfiles) :: fits

    status = 0

    ! open and move to a table extension
    call fits_open_table(fits,tablename,FITS_READONLY,status)
    if( status /= 0 ) then
       write(error_unit,*) &
            'Error: failed to read a table in the file `',trim(tablename),"'."
       stop 'FOURIO'
    end if

    call fits_get_num_rows(fits,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 fits_get_rowsize(fits,srows,status)
    do i = 1, nrows, srows
       frow = i
       l = min(i+srows,nrows)

       call fits_read_col(fits,1,frow,nullval,a(i:l),anyf,status)
       call fits_read_col(fits,2,frow,nullval,b(i:l),anyf,status)
       if( status /= 0 ) goto 666
    end do

    c = cmplx(a,b,dbl)
    deallocate(a,b)

    call fits_close_file(fits,status)
    return

666 continue

    call fits_close_file(fits,status)
    call fits_report_error(error_unit,status)

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

    stop 'FOURIO'


  end subroutine lcfourio

end module lcio
