!
!  support for save of listing
!
!  Copyright © 2012 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 savetables

  use fitsio

  implicit none

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


contains

! ----

  subroutine savelc(file,backup,extname,cols,fitskeys,fitsval,aperture,equinox,&
       exposure,julday,filter,xcoo,ycoo,data)
!       year,month,day,hour,minute,sec,exposure,julday,filter,xcoo,ycoo,data)

    integer, parameter :: ntime = 2
    character(len=*), intent(in) :: file,backup,extname
    character(len=*), dimension(:), intent(in) :: fitskeys,fitsval,cols,filter
!    integer, dimension(:), intent(in) :: year,month,day,hour,minute
!    real(dbl), dimension(:), intent(in) :: sec,exposure,julday,xcoo,ycoo
    real(dbl), dimension(:), intent(in) :: exposure,julday,xcoo,ycoo
    real(dbl), dimension(:,:), intent(in) :: data
    real(dbl), intent(in) :: equinox,aperture

    character(len=80), dimension(:), allocatable :: ttype, tform, tunit
    integer :: i,nd,nrows,ntypes
    integer :: status, blocksize, frow, felem
!    character(len=80) :: tmp

    frow = 1
    felem = 1
    ntypes = ntime + size(data,2)
    allocate(ttype(ntypes),tform(ntypes),tunit(ntypes))

!    ttype(1) = 'YEAR';                tform(1) = '1J';  tunit(1) = ''
!    ttype(2) = 'MONTH';               tform(2) = '1J';  tunit(2) = ''
!    ttype(3) = 'DAY';                 tform(3) = '1J';  tunit(3) = ''
!    ttype(4) = 'HOUR';                tform(4) = '1J';  tunit(4) = ''
!    ttype(5) = 'MINUTE';              tform(5) = '1J';  tunit(5) = ''
!    ttype(6) = 'SECOND';              tform(6) = '1D';  tunit(6) = ''
!    ttype(7) = fitskeys(3);           tform(7) = '1D';  tunit(7) = 's'   ! exptime
!    ttype(8) = 'JULDAY';              tform(8) = '1D';  tunit(8) = ''   ! jd
!    ttype(9) = fitskeys(4);           tform(9) = '10A';   tunit(9) = ''   ! filter

    ttype(1) = 'TIME';              tform(1) = '1D';  tunit(1) = 'day'   ! jd
    ttype(2) = fitskeys(3);         tform(2) = '1D';  tunit(2) = 's'      ! exptime
    

    do i = 1,size(cols)
       ttype(ntime+i) = cols(i);  tform(ntime+i) = '1D';  tunit(ntime+i) = ''
    end do

    status = 0
    blocksize = 0
    nrows = size(julday)
    call fitsbackup(file,backup,status)
    call ftinit(15,file,blocksize,status)

    ! LC extension
    call ftibin(15,nrows,ntypes,ttype,tform,tunit,extname,0,status)
    
    call ftpkys(15,fitskeys(6),fitsval(6),'observed object',status)
    call ftpkys(15,fitskeys(7),fitsval(7),'observer who acquired the data',status)
    call ftpkys(15,fitskeys(8),fitsval(8),'author of the data',status)
    call ftpkys(15,fitskeys(9),fitsval(9),'name of instrument',status)
    call ftpkys(15,fitskeys(10),fitsval(10),'name of telescope',status)
    call ftpkys(15,fitskeys(11),fitsval(11),'organization responsible for the data',status)
    call ftpkys(15,fitskeys(12),fitsval(12),'bibliographic reference',status)
    call ftpkyd(15,"APAPER",aperture,5,'[deg] radius of aperture ',status)
    

    ! time info: http://dotastro.org/simpletimeseries/
    call ftpkys(15,'TIMETYPE','JD','JD,MJD,HJD,phase',status)
    call ftpkys(15,'TIMESYS','UTC','',status)
    call ftpkys(15,'TIMEREF','GEOCENTER','',status)
    call ftpkys(15,'TIMESTMP','MIDPOINT','time stamp = MIDPOINT,BEGIN,END',status)
    ! implement via parameters ?
!    call ftpkyd(15,'TIMEERR',epsilon(1.0_dbl),16,'Uncertainty in the time measurement',status)
!    call ftpkyd(15,'TIMERES',epsilon(1.0_dbl),16,'Resolution in the time measurement',status)
    

    ! band
    call ftpkys(15,fitskeys(4),filter,'spectral band',status)
    
    call ftpcom(15,'Munipack VERSION, (C)1997-2012 F. Hroch <hroch@physics.muni.cz>',status)
    


!    call ftpclj(15,1,frow,felem,nrows,year,status)
!    call ftpclj(15,2,frow,felem,nrows,month,status)
!    call ftpclj(15,3,frow,felem,nrows,day,status)
!    call ftpclj(15,4,frow,felem,nrows,hour,status)
!    call ftpclj(15,5,frow,felem,nrows,minute,status)
!    call ftpcld(15,6,frow,felem,nrows,sec,status)
!    call ftpcld(15,7,frow,felem,nrows,exposure,status)
!    call ftpcld(15,8,frow,felem,nrows,julday,status)
!    call ftpcls(15,9,frow,felem,nrows,filter,status)

    call ftpcld(15,1,frow,felem,nrows,julday,status)
    call ftpcld(15,2,frow,felem,nrows,exposure,status)

    nd = size(data,2)
    do i = 1,nd
       call ftpcld(15,ntime+i,frow,felem,nrows,data(:,i),status)
    end do
    deallocate(ttype,tform,tunit)


    ! OBJECT extension
    nrows = size(xcoo)
    ntypes = 2
    allocate(ttype(ntypes),tform(ntypes),tunit(ntypes))
    tform = '1D'
    tunit = 'deg'
    ttype(1) = FITS_COL_RA
    ttype(2) = FITS_COL_DEC
    
    call ftibin(15,nrows,ntypes,ttype,tform,tunit,trim(extname)//'CAT',0,status)
    call ftpkys(15,FITS_KEY_REFRAME,'ICRS','reference celestial coordinate system',status)
!    call ftpkyd(15,"EQUINOX",equinox,5,'equinox of celestial coordinate system',status)
    call ftpcld(15,1,frow,felem,nrows,xcoo,status)
    call ftpcld(15,2,frow,felem,nrows,ycoo,status)

    deallocate(ttype,tform,tunit)

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


  end subroutine savelc

! ----

  subroutine savecat(file,backup,extname,dtext,fitskeys,fitsval,&
       dateobs,filter,exptime,aperture,equinox,a,d,data)

    character(len=*), intent(in) :: file,backup,extname,dateobs,filter
    character(len=*), dimension(:), intent(in) :: fitskeys,fitsval,dtext
    real(dbl), dimension(:), intent(in) :: a,d
    real(dbl), dimension(:,:), intent(in) :: data
    real(dbl), intent(in) :: exptime, equinox, aperture

    character(len=80), dimension(:), allocatable :: ttype, tform, tunit
    integer :: i,nd,ntypes,nrows
    integer :: status, blocksize, frow, felem

    frow = 1
    felem = 1
    ntypes = 2 + size(dtext)
    allocate(ttype(ntypes),tform(ntypes),tunit(ntypes))
    tform = '1D'
    tunit = 'deg'
    ttype = (/ FITS_COL_RA, FITS_COL_DEC /)
    do i = 1,size(dtext)
       ttype(2+i) = dtext(i);       tform(2+i) = '1D';  tunit(2+i) = ''
    end do

    status = 0
    blocksize = 0
    nrows = size(a)
    call fitsbackup(file,backup,status)
    call ftinit(15,file,blocksize,status)
    call ftibin(15,nrows,ntypes,ttype,tform,tunit,extname,0,status)
    
    call ftpkyd(15,"APAPER",aperture,5,'[deg] radius of aperture photometry',status)
!    call ftpkyd(15,"EQUINOX",equinox,5,'equinox of celestial coordinate system',status)
    call ftpkys(15,fitskeys(1),dateobs,'exposure start',status)
    call ftpkyd(15,fitskeys(3),exptime,-3,'[sec] exposure time',status)
    call ftpkys(15,fitskeys(4),filter,'filter',status)
    call ftpkys(15,fitskeys(6),fitsval(6),'observed object',status)
    call ftpkys(15,fitskeys(7),fitsval(7),'observer who acquired the data',status)
    call ftpkys(15,fitskeys(8),fitsval(8),'author of the data',status)
    call ftpkys(15,fitskeys(9),fitsval(9),'name of instrument',status)
    call ftpkys(15,fitskeys(10),fitsval(10),'name of telescope',status)
    call ftpkys(15,fitskeys(11),fitsval(11),'organization responsible for the data',status)
    call ftpkys(15,fitskeys(12),fitsval(12),'bibliographic reference',status)

    call ftpcld(15,1,frow,felem,nrows,a,status)
    call ftpcld(15,2,frow,felem,nrows,d,status)
    nd = size(data,2)
    do i = 1,nd
       call ftpcld(15,2+i,frow,felem,nrows,data(:,i),status)
    end do

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

    deallocate(ttype,tform,tunit)

  end subroutine savecat


end module savetables
