!
! astrofit - fitting engine
!
!
! Copyright © 2011-3, 2015-8 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 astrofitting

  use iso_fortran_env

  implicit none

  integer, parameter, private :: dbl = selected_real_kind(15)
  real(dbl), parameter, private :: rad = 57.295779513082322865_dbl
  logical, private :: debug = .true., verbose = .false., plog = .false.

contains

  subroutine astrofit(fit,type,a,d,pma,pmd,x,y,sig,xsig,epoch,jd,xc,yc, &
       acen,dacen,dcen,ddcen,sc,dsc,refl,rms,rot,drot,ares,dres, &
       id1_init,id2_init,id1_final,id2_final,rmscheck,verb,pl,reliable)

    use absfit
    use robfit
    use lsfit
    use astrotrafo
    use astrosphere
    use matcher
    use estimator
    use nearmatch

    character(len=*), intent(in) :: fit,type
    logical, intent(in) :: verb, pl, rmscheck
    logical, intent(out) :: reliable
    real(dbl), dimension(:), intent(in) :: a, d, pma, pmd, x, y
    real(dbl), intent(in) :: xc,yc,sig,xsig,epoch,jd
    real(dbl), intent(out) :: acen,dcen,dacen,ddcen,sc,dsc,rms,rot,drot,refl
    real(dbl), dimension(:), allocatable, intent(out) :: ares, dres
    integer, dimension(:), intent(in) :: id1_init,id2_init
    integer, dimension(:), allocatable, intent(out) :: id1_final,id2_final
    real(dbl), dimension(:), allocatable :: alpha,delta,xstar,ystar,u,v,xx,yy
    integer, dimension(:), allocatable :: id1, id2
    type(AstroTrafoProj) :: t

    real(dbl) :: dlim,mad,xoff,dxoff,yoff,dyoff
    logical :: status
    integer :: i,j,n

    verbose = verb
    debug = verb
    plog = pl
    reliable = .false.

    ! check dimensions
    if( size(a) /= size(d) ) &
         stop 'Astrofit: alpha and delta sizes does not corresponds.'
    if( size(x) /= size(y) ) &
         stop 'Astrofit: xstar and ystar sizes does not corresponds.'

    ! check stars > 1 ???
    if( .not. (size(id1_init) > 1) ) then
       rms = huge(rms)
       return
    end if

    allocate(id1(size(id1_init)),id2(size(id2_init)))
    id1 = id1_init
    id2 = id2_init

    mad = -1

    ! rearrange matched objects and compute apparent coordinates
!    dt = (jd - epoch)/365.25_dbl
    n = size(id1)
    allocate(alpha(n),delta(n),xstar(n),ystar(n))
    do i = 1, n
       j = id1(i)
       call propercoo(jd,epoch,a(j),d(j),pma(j),pmd(j),alpha(i),delta(i))
!       if( debug ) write(*,*) j,alpha(i),delta(i)
    end do
    do i = 1, n
       j = id2(i)
       xstar(i) = x(j)
       ystar(i) = y(j)
!       if( debug ) write(*,*) j,xstar(i),ystar(i)
    end do

    ! an intial estimate of scale, rotation and reflection
    call inestim(type,alpha,delta,xc,yc,xstar,ystar,acen,dcen,sc,dsc, &
         rot,drot,refl,xoff,dxoff,yoff,dyoff,verbose)

    ! initial robust estimation
    call absmin(type,alpha,delta,xc,yc,xstar,ystar,acen,dcen,sc,dsc, &
         rot,drot,refl,xoff,dxoff,yoff,dyoff,mad,verbose)
    if( plog ) &
         write(*,'(a,en12.3,en13.3,f8.1,2f14.5)') "=AFIT> ",mad,sc,rot,acen,dcen

    ! estimator of MAD
    mad = 1.41*max(mad,epsilon(1.0))
    ! Important note: a numerical precision of MAD should not be higher than
    ! precision of coordinates stored in FITS files - single real precision!

    if( debug ) write(error_unit,'(2(a,g0.3),a)') '# astrofit stdsig by mad=',&
         mad/0.6745,' deg  ',3600.0*mad/0.6745,' arcsec'

!    do i = 1,n
!       write(*,*) real(xstar(i)),real(ystar(i))
!    end do
!    stop

    ! select such much stars as possible for final fit
!    goto 222
    deallocate(alpha,delta,xstar,ystar)
    deallocate(id1,id2)

    ! In fact, the limit xsig is limit of clipping of data.
    dlim = xsig*max(sig/sc,mad)
!    write(*,*) dlim,1.0/sc,mad
    call listmatch(type,a,d,pma,pmd,x,y,epoch,jd,acen,dcen,xc,yc,sc,&
         rot,refl,dlim,id1,id2,status)
    n = size(id1)
    if( n < 1 .or. size(id1) /= size(id2) ) stop 'n < 1'
    allocate(alpha(n),delta(n),xstar(n),ystar(n))
    do i = 1,n
       j = id1(i)
       call propercoo(jd,epoch,a(j),d(j),pma(j),pmd(j),alpha(i),delta(i))
       xstar(i) = x(id2(i))
       ystar(i) = y(id2(i))
!       write(*,*) real(xstar(i)),real(ystar(i))
    end do
!222 continue

    if( debug ) &
         write(error_unit,'(a,i0)') '# astrofit stars to fit: ',n

    if( n > 5 ) then

       if( fit == 'SQUARES' ) then
          call lsmin(type,alpha,delta,xc,yc,refl,xstar,ystar, &
               acen,dacen,dcen,ddcen,sc,dsc,rot,drot,rms,verbose)
          reliable = .true.

          if(plog) write(*,'(a,en12.3,en13.3,f8.1,2f14.5)') &
               "=LSFIT> ",rms,sc,rot,acen,dcen

       else ! if( fit == 'ROBUST' ) then

!          write(*,*) xc,yc,w,h,mad,acen,dcen,sc,pa

          call robmin(type,alpha,delta,xc,yc,refl,xstar,ystar,mad,&
               acen,dacen,dcen,ddcen,sc,dsc,rot,drot,rms,verbose,reliable)

          if(plog) write(*,'(a,en12.3,en13.3,f8.1,2f14.5)') &
               "=RFIT> ",rms,sc,rot,acen,dcen

       end if

    else if( n > 1 ) then

!       call lfit(type,alpha,delta,xstar,ystar, &
!            xc,yc,acen,dacen,dcen,ddcen,sc,dsc,rms,pa,dpa)
       call absmin(type,alpha,delta,xc,yc,xstar,ystar,acen,dcen,sc,dsc, &
            rot,drot,refl,0.0_dbl,0.0_dbl,0.0_dbl,0.0_dbl,rms,verbose)
       rms = mad
       reliable = .true.

       if(plog) write(*,'(a,en12.3,en13.3,f8.1,2f14.5)') &
            "=AFIT> ",rms,sc,rot,acen,dcen

    else

       write(error_unit,*) "Astrofit: At least, two stars are required."
       rms = huge(rms)
       reliable = .false.
       return

    end if

    if( (rmscheck .and. rms*sc < xsig*sig ) .or. .not. rmscheck ) then

       ! residuals
       allocate(ares(n),dres(n),u(n),v(n),xx(n),yy(n))
       call trafo_init(t,type,acen,dcen)
       call proj(t,alpha,delta,u,v)
       call trafo_init(t,xcen=xc,ycen=yc,scale=1/sc,rot=rot,refl=refl)
       call invaffine(t,xstar,ystar,xx,yy)
       ares = u - xx
       dres = v - yy
       deallocate(u,v,xx,yy)

       allocate(id1_final(n),id2_final(n))
       id1_final = id1
       id2_final = id2

    else
       allocate(id1_final(0),id2_final(0))
       if(debug) then
          write(error_unit,*) 'rms*scale < xsig*sig: ',rms*sc,xsig*sig
          write(error_unit,*)
          write(error_unit,*) 'Most common occurrences:'
          write(error_unit,*) &
               '  * crowded field mesh: increase --minmatch 6 (or more)'
          write(error_unit,*) &
               '  * wide-field deformation: increase --sig or --sigcat'
       end if
    end if

    deallocate(alpha,delta,xstar,ystar)
    deallocate(id1,id2)

  end subroutine astrofit


! it would be better to derive uradius by using fwhm-like qunatity?


!!$  ! low-precision estimator of uncertainties for a few data points
!!$  subroutine lfit(type,alpha, delta, xstar, ystar, xcen, ycen, &
!!$       acen,dacen,dcen,ddcen,sc,dsc,s0,rms,pa,dpa)
!!$
!!$    !!!!!!    NO   TESTING   DONE  YET    !!!!
!!$
!!$    use astrotrafo
!!$
!!$    character(len=*), intent(in) :: type
!!$    real(dbl),dimension(:), intent(in) :: alpha, delta, xstar, ystar
!!$    real(dbl),intent(in) :: xcen,ycen
!!$    real(dbl),intent(out) :: acen,dcen,dacen,ddcen,sc,dsc,s0,rms,pa,dpa
!!$    real(dbl),dimension(:), allocatable :: u, v,x,y
!!$!    type(TypeProjection) :: t
!!$    type(AstroTrafoProj) :: t
!!$    integer :: n,i
!!$    real(dbl) :: tol,ds,rx,ry,c,s
!!$
!!$    tol = sqrt(epsilon(tol))
!!$
!!$!    t%type = type
!!$!    t%xcen = 0.0_dbl
!!$!    t%ycen = 0.0_dbl
!!$!    t%scale = sc
!!$!    t%pa = pa
!!$!    t%acen = acen
!!$!    t%dcen = dcen
!!$!    write(*,*) t%type,t%acen,t%dcen,t%xcen,t%ycen,t%scale,t%pa
!!$
!!$
!!$    n = size(alpha)
!!$    allocate(u(n),v(n),x(n),y(n))
!!$    x = xstar - xcen
!!$    y = ystar - ycen
!!$
!!$    call trafo_init(t,type,acen,dcen)
!!$    call trafo(t,alpha,delta,u,v)
!!$
!!$    call trafo_init(t,scale=sc,rot=pa,refl=refl)
!!$    call affine(
!!$    ! residual sum
!!$
!!$!    s0 = sum((xstar - u)**2 + (ystar - v)**2)
!!$    s0 = 0.0
!!$    c = sc*cos(pa/rad)
!!$    s = sc*sin(pa/rad)
!!$    do i = 1,n
!!$       rx = u(i) - (c*x(i) - s*y(i))
!!$       ry = v(i) - (s*x(i) + c*y(i))
!!$!       write(*,*) u(i),v(i),x(i),y(i),rx,ry
!!$       s0 = s0 + rx**2 + ry**2
!!$    end do
!!$    deallocate(u,v,x,y)
!!$
!!$    ds = -1
!!$    sc = t%scale
!!$    dsc = ds
!!$    rms = sqrt(s0/(n - 2))
!!$    dpa = 0
!!$    dacen = 0
!!$    ddcen = 0
!!$
!!$!    if( debug ) write(*,*) '# solution:',p
!!$!    if( debug ) write(*,*) '# uncerts.: ',dp
!!$    if( debug ) write(*,*) '# scale,dsc=',sc,dsc
!!$    if( debug ) write(*,*) '# s0=',s0
!!$
!!$  end subroutine lfit




end module astrofitting
