!
!  grow-curve photometry
!
!  Copyright © 2016-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/>.


program gphot

  use fitsio
  use iso_fortran_env

  implicit none

  character(len=4*FLEN_FILENAME) :: record,key,val
  character(len=FLEN_FILENAME) :: outname, file,backup, output = ''
  logical :: verbose = .false., plog = .false.
  integer :: eq,status
  real :: threshold = 0.1

  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 == 'VERBOSE' ) then

        read(val,*) verbose

     else if( key == 'PIPELOG' ) then

        read(val,*) plog

     else if( key == 'THRESHOLD' ) then

        read(val,*) threshold

     else if( key == 'FILE' ) then

        read(val,*) file, backup, output

        status = 0
        call fitsback(file,backup,output,.false.,outname,status)
        call growfits(outname,threshold,verbose)

     end if

  end do

20 continue

  stop 0

contains

  subroutine growfits(filename,threshold,verbose)

    use grow_curve
    use grow_report

    character(len=*),intent(in) :: filename
    real, intent(in) :: threshold
    logical, intent(in) :: verbose

    integer, parameter :: rp = selected_real_kind(15)

    integer :: status,blocksize,nrows,xcol,ycol,ecol,scol,hdutype,i,n,naper
    integer, parameter :: group = 1, extver = 0, frow = 1, felem = 1, nbegin = 4
    real, parameter :: nullval = 0.0
    logical :: anyf
    real, dimension(:), allocatable :: xcens,ycens,sky,skyerr,skycorr,skyerrcorr
    real, dimension(:,:), allocatable :: apcts,apcts_err
    real(rp), dimension(:), allocatable :: gcount,gcount_err
    integer, dimension(:), allocatable :: growflag
    real(rp), dimension(:), allocatable :: curve, curve_err, prof
    real, dimension(:), allocatable :: raper
    character(len=FLEN_VALUE), dimension(:), allocatable :: ttype, tform, tunit
    real :: hwhm, rflux90, ghwhm, sep
    character(len=FLEN_COMMENT) :: com
    character(len=FLEN_VALUE) :: key, label
    type(grow_reporter) :: reporter
    logical :: report_init

    report_init = .false.

    status = 0
    call ftopen(15,filename,1,blocksize,status)
    if( status /= 0 ) then
       write(error_unit,*) "Error: `",trim(filename),"' failed to open (for writing)."
       goto 666
    end if

    call ftmnhd(15,BINARY_TBL,APEREXTNAME,extver,status)
    if( status == BAD_HDU_NUM ) then
       write(error_unit,*) "Error: ",trim(APEREXTNAME)// &
            " extension not found. Has been aperture photometry by " // &
            "`munipack aphot "//trim(filename)//"' performed?"
       goto 666
    end if

    call ftgnrw(15,nrows,status)
    call ftgkyj(15,FITS_KEY_NAPER,naper,com,status)
    call ftgkye(15,FITS_KEY_HWHM,hwhm,com,status)
    call ftgkye(15,trim(FITS_KEY_ANNULUS)//'2',sep,com,status)

    allocate(xcens(nrows),ycens(nrows),sky(nrows),skyerr(nrows), &
         skycorr(nrows),skyerrcorr(nrows),apcts(nrows,naper),apcts_err(nrows,naper), &
         gcount(nrows),gcount_err(nrows),growflag(nrows), &
         curve(naper), curve_err(naper), prof(naper), raper(naper))

    do i = 1, naper
       call ftkeyn(FITS_KEY_APER,i,key,status)
       call ftgkye(15,key,raper(i),com,status)
    end do

    call ftgcno(15,.true.,FITS_COL_X,xcol,status)
    call ftgcno(15,.true.,FITS_COL_Y,ycol,status)
    call ftgcno(15,.true.,FITS_COL_SKY,scol,status)
    call ftgcno(15,.true.,FITS_COL_SKYERR,ecol,status)
    call ftgcve(15,xcol,frow,felem,nrows,nullval,xcens,anyf,status)
    call ftgcve(15,ycol,frow,felem,nrows,nullval,ycens,anyf,status)
    call ftgcve(15,scol,frow,felem,nrows,nullval,sky,anyf,status)
    call ftgcve(15,ecol,frow,felem,nrows,nullval,skyerr,anyf,status)

    do i = 1, naper
       write(label,'(a,i0)') FITS_COL_APCOUNT,i
       call ftgcno(15,.true.,label,n,status)
       call ftgcve(15,n,frow,felem,nrows,nullval,apcts(:,i),anyf,status)
       write(label,'(a,i0)') FITS_COL_APCOUNTERR,i
       call ftgcno(15,.true.,label,n,status)
       call ftgcve(15,n,frow,felem,nrows,nullval,apcts_err(:,i),anyf,status)
    end do

    ! all the commands must be finished without eny error for
    ! correct head, any error indicates internal inconsistency
    if( status /= 0 ) goto 666

    if( verbose ) then
       report_init = .true.
       call grow_report_init(reporter,naper,nrows,raper)
    end if

    ! angular separation of stars intended as base for growth-curve construction,
    ! the stars can share only the ring of sky
    !  sep = ring(2)

    ! growth-curve photometry
    call growphot(xcens,ycens,apcts,apcts_err,sky,skyerr,raper,hwhm,sep,threshold, &
         gcount,gcount_err,skycorr,skyerrcorr,curve,curve_err,growflag, &
         prof,rflux90,ghwhm,verbose,reporter)

    ! update sky
    sky = sky - skycorr
    where( skyerr > 0 .and. skyerrcorr > 0 )
       skyerr = sqrt(skyerr**2 + skyerrcorr**2) / 1.414
!    elsewhere
!       skyerr = 0
    end where

    ! grow photometry table
    call ftmnhd(15,BINARY_TBL,GROWEXTNAME,extver,status)
    if( status == BAD_HDU_NUM ) then
       status = 0
    else
       ! already presented ? remove it !
       call ftdhdu(15,hdutype,status)
       if( status /= 0 ) goto 666
    end if

    n = 7
    allocate(ttype(n), tform(n), tunit(n))

    tform = '1D'
    tform(7) = '1B'
    tunit = ''
    ttype(1) = FITS_COL_X
    ttype(2) = FITS_COL_Y
    ttype(3) = FITS_COL_SKY
    ttype(4) = FITS_COL_SKYERR
    ttype(5) = FITS_COL_GCOUNT
    ttype(6) = FITS_COL_GCOUNTERR
    ttype(7) = FITS_COL_GROWFLAG

    call ftibin(15,0,size(ttype),ttype,tform,tunit,GROWEXTNAME,0,status)
    call ftpkye(15,FITS_KEY_HWHM,ghwhm,-4,'[pix] half width at half of maximum',status)
    call ftpkye(15,FITS_KEY_RF90,rflux90,-4,'[pix] radius contains 90% of flux',status)
    write(com,'(a,i0)') 'Count of stars used for curve construction: ',count(growflag == 1)
    call ftpcom(15,com,status)
    call ftpcom(15,'GROWFLAG: 0 - star, not used,',status)
    call ftpcom(15,'          1 - star, used for growth curve construction,',status)
    call ftpcom(15,'          2 - non-stellar object',status)
    call ftpcle(15,1,frow,felem,size(xcens),xcens,status)
    call ftpcle(15,2,frow,felem,size(ycens),ycens,status)
    call ftpcle(15,3,frow,felem,size(sky),sky,status)
    call ftpcle(15,4,frow,felem,size(skyerr),skyerr,status)
    call ftpcld(15,5,frow,felem,size(gcount),gcount,status)
    call ftpcld(15,6,frow,felem,size(gcount_err),gcount_err,status)
    call ftpclj(15,7,frow,felem,size(growflag),growflag,status)
    deallocate(ttype,tform,tunit)

    ! store growth-curve
    call ftmnhd(15,BINARY_TBL,GROWCURVEXTNAME,extver,status)
    if( status == BAD_HDU_NUM ) then
       status = 0
    else
       ! already presented ? remove it !
       call ftdhdu(15,hdutype,status)
       if( status /= 0 ) goto 666
    end if

    n = 4
    allocate(ttype(n), tform(n), tunit(n))

    tform = '1D'
    tunit = ''
    ttype(1) = FITS_COL_R
    ttype(2) = FITS_COL_GROW
    ttype(3) = FITS_COL_GROWERR
    ttype(4) = FITS_COL_RPROF

    call ftibin(15,0,size(ttype),ttype,tform,tunit,GROWCURVEXTNAME,0,status)
    call ftpcle(15,1,frow,felem,size(raper),raper,status)
    call ftpcld(15,2,frow,felem,size(curve),curve,status)
    call ftpcld(15,3,frow,felem,size(curve),curve_err,status)
    call ftpcld(15,4,frow,felem,size(prof),prof,status)
    deallocate(ttype,tform,tunit)

    if( verbose ) call grow_report_dump(15,reporter,status)

666 continue

    if( allocated(apcts) ) deallocate(xcens,ycens,sky,skyerr,skycorr,skyerrcorr, &
         apcts,apcts_err,gcount,gcount_err,growflag,curve,curve_err,prof,raper)

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

    if( verbose .and. report_init ) call grow_report_terminate(reporter)

  end subroutine growfits


end program gphot
