!
! Kombine     Combine a set of frames.
!
! Copyright © 1998-2006, 2011-7 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/>.
!

! Needs a lot of work:
!  * implement local convertion in FITS keywords


program skombine

!
! Experimental version, subpixel transformation
!
! Sum (combine) the frames.
!
!

  use interpol
  use means
  use robustmean
  use fitsio
  use astrotrafo
  use phio
  use iso_fortran_env

  implicit none

  integer, parameter :: dbl = selected_real_kind(15)
  real(dbl), parameter :: rad = 57.295779513082322865_dbl

  Character(len=*), parameter :: version = &
       'KOMBINE 0.6.x, (C)1998-2006,2011-7 F.Hroch, Masaryk University,Brno,CZ '

  ! Minimum of values
  real :: minvalue = 0.0

  ! FITS
  logical :: simple,extend,anyf,xrange
  integer :: n, i, j, status, bpix, maxvalue, bitpix = -32, naxis, naxes(2)
  integer :: pcount,gcount,eq,nfiles
  character(len=FLEN_KEYWORD) :: FILTER='FILTER',DATE_OBS='DATE-OBS', &
       EXPTIME='EXPTIME',OBJECT='OBJECT',KEY_GAIN = FITS_KEY_GAIN

  real, dimension(:,:), allocatable :: KOMBINE, IMAGE, EXPMASK
  real, dimension(:,:,:), allocatable :: frames
  real, dimension(:), allocatable :: skies, exptimes
  real :: oneexp, etime, gain, ctph, skymean
  real :: f,fs,sky,dsky
  real(dbl) :: ff,x,y,a,d
  character(len=FLEN_VALUE) :: onedate, obj, filtr, ctype1, ctype2
  character(len=2*FLEN_FILENAME), dimension(:), allocatable :: alldate
  character(len=2*FLEN_FILENAME) :: sb,record
  character(len=4*FLEN_FILENAME) :: key,val
  character(len=3*FLEN_FILENAME) :: buf
  character(len=FLEN_COMMENT) :: comgain
  logical :: init = .false., init_proj = .false., init_crval = .false., &
       init_crpix = .false., init_scale=.false., init_angle=.false., &
       reflex = .false., init_reflex = .false., sky_determine = .true.
  type(AstroTrafoProj) :: tp,tpi
  character(len=FLEN_VALUE) :: ptype = "GNOMONIC"
  real(dbl) :: xcen,ycen
  real(dbl) :: scale = 3600.0 ! pixels per deg
  real(dbl) :: angle = 0.0
  real(dbl), dimension(2) :: xcrval, xcrpix
  real(dbl), dimension(2,2) :: mat,rmat
  integer, dimension(2) :: xnaxes = (/0,0/)
  character(len=*), parameter :: un = '[deg]'

  ! selection of method of interpolation
  ! 0=no interpolation, 1=bilinear, 2=bicubic, 3=bspline
  !   fast                slow        slower     hang up
  !   pixelized           good        perfect    little bit over perfect
  integer :: sint = 2

  ! set dimensions of output image
  integer ::  nx = -1, ny = -1

  ! Output image name:
  character(len=FLEN_FILENAME) :: backup, namekombi='kombine.fits'

  ! adjust output sky
  logical :: adjustsky = .false.

  ! use exposure mask
  logical :: expomask = .false.

  ! output image is computed by robust mean, by default
  logical :: average = .false.

  ! Time start of first exposure
  character(len=FLEN_VALUE) :: first = ''

  ! verbose output
  logical :: verbose = .false.
  logical :: pipelog = .false.

! init variables
  status = 0
  obj = ''
  etime = 0.0
  f = 1.0
  fs = 0.0
  sky = 0.0

  n = 0
  status = 0
  do
     read(*,'(a)',end=20) record

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

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

     if( key == 'OUTPUT' ) then

        read(val,*) namekombi, backup

     else if( key == 'FITS_KEY_FILTER' ) then

        read(val,*) FILTER

     else if( key == 'FITS_KEY_OBJECT' ) then

        read(val,*) OBJECT

     else if( key == 'FITS_KEY_EXPTIME' ) then

        read(val,*) EXPTIME

     else if( key == 'FITS_KEY_DATEOBS' ) then

        read(val,*) DATE_OBS

     else if( key == 'FITS_KEY_GAIN' ) then

        read(val,*) KEY_GAIN

     else if( key == 'VERBOSE' ) then

        read(val,*) verbose

     else if( key == 'PIPELOG' ) then

        read(val,*) pipelog

     else if( key == 'BITPIX' ) then

        read(val,*) bitpix

     else if( key == 'SCALE' ) then

        read(val,*) scale
        init_scale = .true.

     else if( key == 'ANGLE' ) then

        read(val,*) angle
        init_angle = .true.

     else if( key == 'REFLEX' ) then

        read(val,*) reflex
        init_reflex = .true.

     else if( key == 'CRVAL' ) then

        read(val,*) xcrval
        init_crval = .true.

     else if( key == 'CRPIX' ) then

        read(val,*) xcrpix
        init_crpix = .true.

     else if( key == 'NAXES' ) then

        read(val,*) xnaxes

     else if( key == 'PROJECTION' ) then

        read(val,*) ptype
        init_proj = .true.

     else if( key == 'INTERPOL' ) then

        if( val == 'none' ) sint = 0
        if( val == 'bilinear' ) sint = 1
        if( val == 'bicubic' ) sint = 2
!        if( val == 'bspline' ) sint = 3

     else if( key == 'ADJUSTSKY' ) then

        read(val,*) adjustsky

     else if( key == 'EXPOMASK' ) then

        read(val,*) expomask

     else if( key == 'AVERAGE' ) then

        read(val,*) average

     else if( key == 'NFILES' ) then

        read(val,*) nfiles
        allocate(alldate(nfiles),skies(nfiles),exptimes(nfiles))

     else if( key == 'FILE' ) then

        ! input initialisation of the current file

        read(val,*) sb

        sky_determine = .true.
        status = 0
        Call ftdopn(25,sb,0,status)
        Call ftghpr(25,2,simple,bpix,naxis,naxes,pcount,gcount,extend,status)
        if( status /= 0 ) goto 666
        call ftgkye(25,EXPTIME,oneexp, buf, status)
        if( status /= 0 ) then
           oneexp = -1.0
           status = 0
        endif
        call ftgkys(25,DATE_OBS,onedate, buf, status)
        if( status /= 0 ) then
           onedate = ''
           status = 0
        endif
        call ftgkys(25,OBJECT,obj, buf, status)
        if( status /= 0 ) then
           obj = ''
           status = 0
        endif
        call ftgkys(25,FILTER,filtr, buf, status)
        if( status /= 0 ) then
           filtr = ''
           status = 0
        endif
        call ftgkye(25,KEY_GAIN,gain, comgain, status)
        if( status /= 0 ) then
           gain = -1.0
           status = 0
        endif

        call wcsget(25,tpi,status)
        if( status == KEYWORD_NOT_FOUND ) then
           write(*,'(a)') &
                "Skipped `"//trim(sb)//"': astrometry calibration not found."
           status = 0
           goto 665
        end if

        ! image - data input
        allocate(IMAGE(naxes(1),naxes(2)))
        call FTG2DE(25,1,minvalue,naxes(1),naxes(1),naxes(2),IMAGE,anyf,status)
        if( status /= 0 ) goto 666

        !
        if( average ) then
           ! move to photometry table
           call ftmnhd(25,BINARY_TBL,PHOTOEXTNAME,0,status)
           if( status == BAD_HDU_NUM ) then
              write(*,'(a)') "Skipped `"//trim(sb)// &
                   "': Failed to find a photometry extension."
              status = 0
              goto 665
           end if
           call ftgkye(25,FITS_KEY_CTPH,ctph,buf,status)
           if( status /= 0 ) then
              write(*,'(a)') "Skipped `"//trim(sb)// &
                   "': Failed to find CTPH in the photometry extension."
              status = 0
           endif
           call ftgkye(25,FITS_KEY_SKYMEAN,skymean,buf,status)
           if( status /= 0 ) then
              write(*,'(a)') "Skipped `"//trim(sb)// &
                   "': Failed to find SKYMEAN in the photometry extension."
              status = 0
           else
              ! per pixel (arcsec originally)
              sky = skymean * (3600*real(tpi%scale))**2
              sky_determine = .false.
           endif

        end if

        if( sky_determine ) then
           call rmean(pack(IMAGE(1:size(IMAGE,1):10,1:size(IMAGE,2):10),&
                .true.),sky,dsky)
!        else
!           sky = skymean
        end if

        if( adjustsky ) IMAGE = IMAGE - sky

        ! first image - initialisation
        if( .not. init ) then
           init = .true.
           call trafo_init(tp)

           if( xnaxes(1) /= 0 .and. xnaxes(2) /= 0 ) then
              nx = xnaxes(1)
              ny = xnaxes(2)
           else if( nx < 0 .and. ny < 0 )then
              nx = naxes(1)
              ny = naxes(2)
           endif

           if( average ) then
              allocate(frames(nx,ny,nfiles),stat=status,errmsg=buf)
              if( status /= 0 ) then
                 if( verbose ) write(error_unit,*) 'kombine:',trim(buf)
                 stop 'Failed to allocate memmory.'
              end if
           end if

           allocate(KOMBINE(nx,ny),EXPMASK(nx,ny))
           KOMBINE = 0.0
           EXPMASK = 0.0

           xcen = nx/2.0
           ycen = ny/2.0
           if( init_proj ) then
              tp%type = ptype
           else
              tp%type = tpi%type
           end if
           if( init_crval ) then
              tp%acen = xcrval(1)
              tp%dcen = xcrval(2)
           else
              tp%acen = tpi%acen
              tp%dcen = tpi%dcen
           end if
           if( init_crpix ) then
              tp%xcen = xcrpix(1)
              tp%ycen = xcrpix(2)
           else
              tp%xcen = xcen
              tp%ycen = ycen
           end if
           if( init_scale ) then
              tp%scale = scale
           else
              tp%scale = tpi%scale
           end if
           if( init_angle )then
              tp%rot = angle
           else
              tp%rot = tpi%rot
           end if
           if( init_reflex )then
              if( reflex ) then
                 tp%refl = -1.0_dbl
              else
                 tp%refl = 1.0_dbl
              end if
           else
              tp%refl = tpi%refl
           end if
           tp%err = tpi%err

           call trafo_refresh(tp)

        end if

        if( sint == 3 ) then
           ! init bspline
           call bspline_init(IMAGE)
        endif

        n = n + 1
        write(alldate(n),*) "'",trim(sb),"' ",sky
        skies(n) = sky
        exptimes(n) = oneexp

        ! compute sumation
        do i = 1, nx
           do j = 1, ny

              x = i
              y = j
              call invtrafo(tp,x,y,a,d)
              ff = skyinterpol(sint,a,d,IMAGE,tpi,xrange)

              if( average ) then
                 frames(i,j,n) = real(ff) - sky
              else
                 KOMBINE(i,j) = KOMBINE(i,j) + real(ff)
              end if

              if( oneexp > 0.0 .and. xrange ) &
                   EXPMASK(i,j) = EXPMASK(i,j) + oneexp
           enddo
        enddo
        if( sint == 3 ) then
           call bspline_shutdown
        endif

        if( first == '' ) first = onedate
        if( oneexp > 0.0 ) etime = etime + oneexp

665     continue

        call ftclos(25,status)
        if( status /= 0 ) then
           goto 666
        end if

        if( allocated(IMAGE) ) deallocate(IMAGE)

     end if

  enddo
20 continue

  if( n == 0 ) stop 'No input images.'
  nfiles = n

  if( average ) then
     call rmean(skies(1:nfiles),skymean,dsky)
     do i = 1, nx
        do j = 1, ny
           call rmean(frames(i,j,1:n),f,fs)
           kombine(i,j) = f*n + skymean
        end do
     end do
     deallocate(frames)
  end if


  if( expomask ) then
     where( EXPMASK /= 0.0 )
        KOMBINE = KOMBINE / EXPMASK
     end where
  end if

  ! range checking
  if( bitpix > 0 )then
     maxvalue = int(2.0**bitpix - 1)
     where( KOMBINE < minvalue )
        KOMBINE = minvalue
     endwhere
     where( KOMBINE > maxvalue )
        KOMBINE = maxvalue
     endwhere
  end if

! form an output image
  call fitsbackup(namekombi,backup,status)
  call ftinit(26,namekombi,1,status)
  naxis = 2
  naxes = (/nx, ny/)
  Call ftphps(26,bitpix,naxis,naxes,status)
  if( bitpix > 0 ) then
     call ftpkye(26,'BSCALE',1.0,10,'',status)
     call ftpkye(26,'BZERO',2.0**(bitpix-1),10,'',status)
  endif
  Call ftukys(26,OBJECT,obj,'',status)
  Call ftukys(26,FILTER,filtr,'',status)
  if( average ) then
     call rmean(exptimes(1:nfiles),etime,oneexp)
     call ftukye(26,EXPTIME,etime,10,'Average exposure time',status)
  else
     call ftukye(26,EXPTIME,etime,10,'Sum of all exposure times',status)
  end if
  if( first /= '' ) call ftukys(26,DATE_OBS,first,'UTC of series exposure start',status)
  if( gain > 0.0 ) call ftukye(26,FITS_KEY_GAIN,gain,7,comgain,status)

  rmat(1,:) = (/-1.0_dbl,0.0_dbl/)
  rmat(2,:) = (/ 0.0_dbl,1.0_dbl/)
  mat = matmul(rmat,tp%mat)

  if( tp%type == 'GNOMONIC' ) then
     ctype1 = 'RA---TAN'
     ctype2 = 'DEC--TAN'
  end if
  if( tp%type /= 'IDENTITY' ) then
     call ftukys(26,'CTYPE1',ctype1,'the coordinate type for the first axis',status)
     call ftukys(26,'CTYPE2',ctype2,'the coordinate type for the second axis',status)
  else
     call ftdkey(26,'CTYPE1',status)
     if( status == KEYWORD_NOT_FOUND ) status = 0
     call ftdkey(26,'CTYPE2',status)
     if( status == KEYWORD_NOT_FOUND ) status = 0
  end if
  call ftukyd(26,'CRVAL1',tp%acen,16,un//' first axis value at reference pixel',status)
  call ftukyd(26,'CRVAL2',tp%dcen,16,un//' second axis value at reference pixel',status)
  call ftukyd(26,'CRDER1',tp%err,2,un//' random error in first axis',status)
  call ftukyd(26,'CRDER2',tp%err,2,un//' random error in second axis',status)
  call ftukys(26,'CUNIT1','deg','units of first axis',status)
  call ftukys(26,'CUNIT2','deg','units of second axis',status)
  call ftukyd(26,'CRPIX1',tp%xcen,16,'x-coordinate of reference pixel',status)
  call ftukyd(26,'CRPIX2',tp%ycen,16,'y-coordinate of reference pixel',status)
  call ftukyd(26,'CD1_1',mat(1,1),16,'partial of first axis coordinate w.r.t. x',status)
  call ftukyd(26,'CD1_2',mat(1,2),16,'partial of first axis coordinate w.r.t. y',status)
  call ftukyd(26,'CD2_1',mat(2,1),16,'partial of second axis coordinate w.r.t. x',status)
  call ftukyd(26,'CD2_2',mat(2,2),16,'partial of second axis coordinate w.r.t. y',status)

  if( nfiles > 0 ) then
     write(buf,'(a,i0,a)',iostat=i) &
          'The image is a result of composition of ',nfiles,' exposure(s).'
     if( i== 0 ) call ftpcom(26,buf,status)
     call ftpcom(26,'The time of start, the exposure time, the filter,',status)
     call ftpcom(26,'the intensity multiplier and relative sky value for each image used:',status)
     do i = 1, nfiles
        call ftpcom(26,alldate(i),status)
     enddo
     call ftpcom(26,'All times are derived from DATE-OBS and EXPTIME keywords.',status)
  endif
  if( expomask ) call ftpcom(26,'Fluxes are normalized by exposure times.',status)
  if( adjustsky ) call ftpcom(26,'All sky levels are adjusted to zero.',status)
  select case (sint)
  case(0)
     buf = 'No interpolation has been used.'
  case(1)
     buf = 'Bilinear interpolation has been used.'
  case(2)
     buf = 'Bicubic interpolation has been used.'
  case(3)
     buf = 'Bspline interpolation has been used.'
  end select
  if( average ) then
     call ftpcom(26,'Frames has been averaged by robust mean.',status)
  else
     call ftpcom(26,'Frames has been summed.',status)
  end if
  call ftpcom(26,buf,status)
  call ftpcom(26,version,status)
  if( status /= 0 ) goto 666

  call ftp2de(26,1,nx,nx,ny,KOMBINE,status)

  ! exposure mask
  if( expomask ) then
     call ftiimg(26,bitpix,naxis,naxes,status)
     call ftukys(26,'EXTNAME','EXPOMASK','',status)
     call ftpcom(26,'The exposure mask as an *experimental* feature.',status)
     call ftp2de(26,1,naxes(1),naxes(1),naxes(2),EXPMASK,status)
     if( status == NUMERICAL_OVERFLOW ) status = 0
  end if

  CALL ftclos(26,status)
  if( status /= 0 ) goto 666

  ! print output info
  if( verbose ) then
     write(*,*) 'Output image: ',trim(namekombi)
     write(*,*) 'Dimension: ',nx,'x',ny
  end if

666 continue
  if( allocated(KOMBINE) ) deallocate(KOMBINE)
  if( allocated(EXPMASK) ) deallocate(EXPMASK)
  if( allocated(alldate) ) deallocate(alldate,skies)

  if( status == 0 )then
     stop 0
  else
     call ftrprt ('STDERR',status)
  end if


contains

  function skyinterpol(sint,a,d,array,t,range)

    use astrotrafo

    implicit none

    real(dbl) :: skyinterpol
    real(dbl), intent(in) :: a,d
    integer, intent(in) :: sint
    real, dimension(:,:), intent(in) :: array
    type(AstroTrafoProj),intent(in) :: t
    logical, intent(out) :: range
    real(dbl) :: x,y
    integer :: i,j

    call trafo(t,a,d,x,y)
    i = nint(x)
    j = nint(y)
!    write(*,*) a,d,x,y

    if(  1 <= i .and. i <= size(array,1) .and. &
         1 <= j .and. j <= size(array,2) ) then

       select case (sint)
       case(0)
          ! nearest neighborhood
          skyinterpol = array(i,j)
       case(1)
          ! bilinear interpolation
          skyinterpol = bilinear(real(x),real(y),array)
       case(2)
          ! bicubic interpolation
          skyinterpol = bicubic(real(x),real(y),array)
       end select

       range = .true.
    else
       skyinterpol = 0.0_dbl
       range = .false.
    end if

  end function skyinterpol

end program skombine
