!
!  FITS tool for kombine
!
!  Copyright © 2018-21 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 fitskombi

  use astrotrafo
  use phio
  use titsio
  use iso_fortran_env

  implicit none

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

  type :: KombiFits
     character(len=FLEN_FILENAME) :: filename = ''
     character(len=FLEN_VALUE) :: dateobs = '', filter = '', object = ''
     character(len=FLEN_VALUE), dimension(2) :: ctype
     real(dbl), dimension(2) :: crval, crpix, crerr
     real(dbl), dimension(2,2) :: cd
     real(dbl) :: longitude, latitude
     real, dimension(:,:), allocatable :: image
     integer, dimension(2) :: naxes = [ 0, 0 ]
     integer :: bitpix = -32
     integer :: naxis = 0
     real :: exptime = 1
     logical :: background = .true.
     logical :: geo = .false.
     logical :: status = .false.
   contains
     procedure :: Load,loadimg,reproject,jd
     procedure, private :: bestim
  end type KombiFits

contains

  subroutine Load(fits,filename,fitskeys,background,verbose)

    ! opens a FITS file, only metadata are probed,
    ! %image components remains undefined

    class(KombiFits) :: fits
    character(len=*), intent(in) :: filename
    character(len=*), dimension(:), intent(in) :: fitskeys
    logical, intent(in) :: background, verbose

    type(fitsfiles) :: fitsfile
    integer :: status

    fits%filename = filename
    fits%background = background

    status = 0
    call fits_open_image(fitsfile,filename,FITS_READONLY,status)
    if( status /= 0 ) then
       write(error_unit,*) 'Error: failed to read the file `',trim(filename),"'."
       fits%status = .false.
       return
    end if

    call fits_get_img_type(fitsfile,fits%bitpix,status)
    call fits_get_img_dim(fitsfile,fits%naxis,status)
    if( status /= 0 ) goto 666

    if( fits%naxis /= 2 ) then
       write(error_unit,*) &
            'Error: the assertion NAXIS /= 2 failed: `',trim(filename),"."
       goto 666
    end if

    call fits_get_img_size(fitsfile,2,fits%naxes,status)
    if( status /= 0 ) goto 666

    ! read date and time, dateobs
    call fits_write_errmark
    call fits_get_dateobs(fitsfile,fitskeys(1:2),fits%dateobs,status)
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       call fits_clear_errmark
       if( verbose ) write(error_unit,*) 'Warning: Date of observation by ', &
            trim(fitskeys(1)),',',trim(fitskeys(2)),' keywords not found.'
       status = 0
       fits%dateobs = ''
    end if

    ! exposure time
    call fits_write_errmark
    call fits_read_key(fitsfile,fitskeys(3),fits%exptime,status)
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       call fits_clear_errmark
       if( verbose ) write(error_unit,*) &
            'Warning: Exposure time by ',trim(fitskeys(3)),' keyword not found.'
       status = 0
       fits%exptime = 1
    end if

    ! filter
    call fits_write_errmark
    call fits_read_key(fitsfile,fitskeys(4),fits%filter,status)
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       call fits_clear_errmark
       if( verbose ) write(error_unit,*) &
            'Warning: Filter by ',trim(fitskeys(4)),' keyword not found.'
       status = 0
       fits%filter = ''
    end if

    ! object
    call fits_write_errmark
    call fits_read_key(fitsfile,fitskeys(5),fits%object,status)
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       call fits_clear_errmark
       if( verbose ) write(error_unit,*) &
            'Warning: Object name by ',trim(fitskeys(5)),' keyword not found.'
       status = 0
       fits%object = ''
    end if

    ! Geographic coordinates
    call fits_write_errmark
    call fits_read_key(fitsfile,fitskeys(6),fits%longitude,status)
    call fits_read_key(fitsfile,fitskeys(7),fits%latitude,status)
    fits%geo = status == 0
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       call fits_clear_errmark
       if( verbose ) write(error_unit,*) &
            'Warning: Geographics coordinates by ',trim(fitskeys(6)),&
            ' and ',trim(fitskeys(7)),' keyword not found.'
       status = 0
    end if

    ! astrometry
    call fits_read_wcs(fitsfile,fits%ctype,fits%crval,fits%crpix,fits%cd,fits%crerr,&
         status)
    if( status == FITS_KEYWORD_NOT_FOUND ) then
       if( verbose ) write(error_unit,'(a)') &
            "Error: `"//trim(filename)//"': astrometry calibration not found."
       goto 666
    end if

666 continue

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

    fits%status = status == 0

  end subroutine Load

  logical function loadimg(this)

    ! fills %image structure item

    class(KombiFits) :: this
    character(len=80) :: msg
    integer :: status
    logical :: anyf
    type(fitsfiles) :: fitsfile

    allocate(this%image(this%naxes(1),this%naxes(2)),stat=status,errmsg=msg)
    if( status /= 0 ) then
       write(error_unit,*) "Error: ",trim(this%filename),": ",trim(msg)
       loadimg = .false.
       return
    end if

    status = 0
    call fits_open_image(fitsfile,this%filename,FITS_READONLY,status)
    if( status == 0 ) then
       call fits_read_image(fitsfile,0,0.0,this%image,anyf,status)
       call fits_close_file(fitsfile,status)
       call fits_report_error(error_unit,status)
    end if

    loadimg = allocated(this%image) .and. status == 0

  end function loadimg

  subroutine reproject(this,method,jdref,crmov,alpha,delta,img,mask)

    use interpol

    class(KombiFits) :: this
    character(len=*), intent(in) :: method
    real(dbl), intent(in) :: jdref
    real(dbl), dimension(:), intent(in) :: crmov
    real(dbl), dimension(:,:), intent(in) :: alpha, delta
    real, dimension(:,:), intent(out) :: img
    logical, dimension(:,:), intent(out) :: mask

    real, dimension(:,:), allocatable :: fx,fy,fxy
    integer :: i,j,n,m,i1,i2,j1,j2,nx,ny
    real :: x,y,back
    real(dbl) :: xx,yy,dt
    type(AstroTrafoProj) :: t

    nx = size(this%image,1)
    ny = size(this%image,2)

    mask = .false.
    call trafo_fromwcs(t,this%ctype,this%crval,this%crpix,this%cd,this%crerr)

    ! proper motion
    dt = this%jd() - jdref
    t%acen = t%acen - dt * crmov(1)
    t%dcen = t%dcen - dt * crmov(2)

    ! background
    if( this%background ) then
       back = this%bestim()
    else
       back = 0.0
    end if

    if( method == 'BICUBIC' ) then
       allocate(fx(nx,ny),fy(nx,ny),fxy(nx,ny))
       call diff(this%image,fx,1,0)
       call diff(this%image,fy,0,1)
       call diff2(this%image,fxy)
    end if

    do i = 2, size(alpha,1)-1
       do j = 2, size(delta,2)-1

          call trafo(t,alpha(i,j),delta(i,j),xx,yy)
          x = real(xx)
          y = real(yy)
          i1 = int(x)
          i2 = i1 + 1
          j1 = int(y)
          j2 = j1 + 1

          if( method == 'BI3CONV' ) then
             i2 = i2 + 2
             j2 = j2 + 2
          end if

          if(  1 <= i1 .and. i2 <= nx .and. 1 <= j1 .and. j2 <= ny ) then

             if( method == 'NEAR' ) then

                n = nint(x)
                m = nint(y)
                img(i,j) = this%image(n,m) -  back

             else if( method == 'BILINEAR' ) then

                img(i,j) = bilinear(x-i1,y-j1,this%image(i1:i2,j1:j2)) - back

             else if( method == 'BICUBIC' ) then

                img(i,j) = bicubic(x-i1,y-j1,this%image(i1:i2,j1:j2), &
                     fx(i1:i2,j1:j2),fy(i1:i2,j1:j2),fxy(i1:i2,j1:j2)) - back

             else if( method == 'BI3CONV' ) then

                img(i,j) = bi3conv(x-i1,y-j1,this%image(i1:i2,j1:j2)) -  back

             else

                call random_number(img(i,j)) ! noise

             end if

             mask(i,j) = .true.
          end if
       end do
    end do

  end subroutine reproject

  real(dbl) function jd(this)

    ! returns JD at middle of this exposure

    use phio

    class(KombiFits) :: this
    integer :: status

    status = 0
    jd = fits_jd(this%dateobs,status)
    if( status /= 0 ) write(error_unit,'(a)') &
         "Error: Failed to convert `"//trim(this%dateobs)//"' to JD."

    jd = jd + this%exptime / (2*86400)

  end function jd

  real function bestim(this)

    use oakleaf

    class(KombiFits), intent(in) :: this
    integer :: n,m

    if( .not. this%status ) then
       bestim = 0.0
       return
    end if

    do n = 0, 10
       m = 2**n
       if( (this%naxes(1)/m) * (this%naxes(2)/m) < 2**20 ) exit
    end do

    call rmean(pack(this%image(::m,::m),.true.),bestim)

  end function bestim

end module fitskombi
