!
! Astrometry related transformations
!
!
! Copyright © 2011-3, 2015 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 astrotrafo

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

  ! Transformation and projection:
  !
  ! type ... type of projection (GNOMONIC,..)
  !      ... mostly affine transformation ...
  ! scale... scale [deg/pixel]
  ! rot  ... rotation angle [deg]
  ! acen ... center projection in alpha [deg]
  ! dcen ... center projection in delta [deg]
  ! xcen ... horizontal center projection [pixel]
  ! ycen ... vertical center projection [pixel]
  ! refl ... -1 for reflected frame
  ! err  ... typical statistical error of acen, dcen [deg]

  type AstroTrafoProj
     character(len=80) :: type
     real(dbl) :: acen,dcen,xcen,ycen,ucen,vcen,scale,rot,err,refl
     real(dbl), dimension(2,2) :: mrot,smat,mat,mat1
     real(dbl), dimension(2) :: xy0,uv0
  end type AstroTrafoProj
  
  interface trafo
     module procedure trafo_point, trafo_array
  end interface trafo

  interface invtrafo
     module procedure invtrafo_point, invtrafo_array
  end interface invtrafo

  interface affine
     module procedure affine_point, affine_array
  end interface affine

  interface invaffine
     module procedure invaffine_point, invaffine_array
  end interface invaffine

  interface proj
     module procedure proj_point, proj_array
  end interface proj

  interface invproj
     module procedure invproj_point, invproj_array
  end interface invproj

  private :: trafo_point, trafo_array,invtrafo_point, invtrafo_array, &
       affine_point, affine_array, invaffine_point, invaffine_array, &
       proj_point, proj_array, invproj_point, invproj_array, &
       gproj, invgproj

contains

! --- init ---

  subroutine trafo_init(t,type,acen,dcen,xcen,ycen,ucen,vcen,scale,rot,refl,err)

    type(AstroTrafoProj), intent(out) :: t
    character(len=*), intent(in), optional :: type
    real(dbl), intent(in), optional :: acen,dcen,xcen,ycen,ucen,vcen,scale,rot,err,refl

    t%type = 'GNOMONIC'
    t%acen = 0.0_dbl
    t%dcen = 0.0_dbl
    t%xcen = 0.0_dbl
    t%ycen = 0.0_dbl
    t%ucen = 0.0_dbl
    t%vcen = 0.0_dbl
    t%scale= 1.0_dbl
    t%rot  = 0.0_dbl
    t%refl = 1.0_dbl
    t%err  = epsilon(t%err)

    if( present(type) ) t%type = type
    if( present(acen) ) t%acen = acen
    if( present(dcen) ) t%dcen = dcen
    if( present(xcen) ) t%xcen = xcen
    if( present(ycen) ) t%ycen = ycen
    if( present(ucen) ) t%ucen = ucen
    if( present(vcen) ) t%vcen = vcen
    if( present(scale)) t%scale= scale
    if( present(rot)  ) t%rot  = rot
    if( present(refl) ) t%refl = refl
    if( present(err)  ) t%err  = err

    call trafo_refresh(t)

  end subroutine trafo_init


  subroutine trafo_refresh(t)

    type(AstroTrafoProj), intent(inout) :: t
    real(dbl), dimension(2,2) :: m
    real(dbl) :: f,c,s,det

    ! construct affine projection matrix
    f = t%rot / rad
    c = cos(f)
    s = sin(f)

    t%smat(1,:) = (/ t%scale * t%refl, 0.0_dbl /)
    t%smat(2,:) = (/ 0.0_dbl,          t%scale /)
    t%mrot(1,:) = (/c,-s/)
    t%mrot(2,:) = (/s, c/)

    t%mat = matmul(t%mrot,t%smat)

    m = t%mat
    det = m(1,1)*m(2,2) - m(1,2)*m(2,1)
    t%mat1(1,:) = (/ m(2,2),-m(1,2) /) / det
    t%mat1(2,:) = (/-m(2,1), m(1,1) /) / det

    t%xy0 = (/t%xcen, t%ycen/)
    t%uv0 = (/t%ucen, t%vcen/)

  end subroutine trafo_refresh

! --- trafo ---

  subroutine trafo_point(t, a, d, x,y)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: a,d
    real(dbl), intent(out) :: x,y
    real(dbl), dimension(1) :: xx,yy
    
    call trafo(t, (/a/), (/d/), xx,yy)
    x = xx(1)
    y = yy(1)

  end subroutine trafo_point

  subroutine trafo_array(t, a, d, x,y)


    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: a,d
    real(dbl), dimension(:), intent(out) :: x,y
    real(dbl), dimension(:), allocatable :: u,v
    integer :: n

    n = size(a)
    allocate(u(n),v(n))

    call proj(t,a,d,u,v)
    call affine(t,u,v,x,y)

    deallocate(u,v)

  end subroutine trafo_array

! --- invtrafo ---

  subroutine invtrafo_point(t,x,y,a,d)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: x,y
    real(dbl), intent(out) :: a,d
    real(dbl), dimension(1) :: aa,dd

    call invtrafo(t,(/x/),(/y/),aa,dd)
    a = aa(1)
    d = dd(1)

  end subroutine invtrafo_point

  subroutine invtrafo_array(t,x,y,a,d)

    use projections

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: x,y
    real(dbl), dimension(:), intent(out) :: a,d
    real(dbl), dimension(:), allocatable :: u,v
    integer :: n

    n = size(a)
    allocate(u(n),v(n))

    call invaffine(t,x,y,u,v)
    call invproj(t,u,v,a,d)

    deallocate(u,v)

  end subroutine invtrafo_array


! --- proj ---

  subroutine proj_array(t,a,d,u,v)

    use projections

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: a,d
    real(dbl), dimension(:), intent(out) :: u,v

    if( t%type == "GNOMONIC" ) then
       call gproj(gnomond,t%acen,t%dcen,a,d,u,v)
    else if( t%type == " " ) then
       call gproj(identity,t%acen,t%dcen,a,d,u,v)
    end if

  end subroutine proj_array

  subroutine proj_point(t,a,d,u,v)
    
    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: a,d
    real(dbl), intent(out) :: u,v
    real(dbl), dimension(1) :: uu,vv

    call proj(t,(/a/),(/d/),uu,vv)
    u = uu(1)
    v = vv(1)

  end subroutine proj_point

! --- invproj ---

  subroutine invproj_array(t,u,v,a,d)

    use projections

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: u,v
    real(dbl), dimension(:), intent(out) :: a,d

    if( t%type == "GNOMONIC" ) then
       call invgproj(invgnomond,t%acen,t%dcen,u,v,a,d)
    else if( t%type == " " ) then
       call invgproj(invidentity,t%acen,t%dcen,u,v,a,d)
    end if

  end subroutine invproj_array

  subroutine invproj_point(t,u,v,a,d)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: u,v
    real(dbl), intent(out) :: a,d
    real(dbl), dimension(1) :: aa,dd

    call invproj(t,(/u/),(/v/),aa,dd)
    a = aa(1)
    d = dd(1)

  end subroutine invproj_point

! --- invaffine ---


  subroutine invaffine_point(t,x,y,u,v,g,h)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: x,y
    real(dbl), intent(out) :: u,v
    real(dbl), intent(out), optional :: g,h

    real(dbl), dimension(1) :: uu,vv,gg,hh

    if( present(g) .and. present(h) ) then
       call invaffine(t,(/x/),(/y/),uu,vv,gg,hh)
       u = uu(1)
       v = vv(1)
       g = gg(1)
       h = hh(1)
    else
       call invaffine(t,(/x/),(/y/),uu,vv)
       u = uu(1)
       v = vv(1)
    end if

  end subroutine invaffine_point

  subroutine invaffine_array(t,x,y,u,v,g,h)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: x,y
    real(dbl), dimension(:), intent(out) :: u,v
    real(dbl), dimension(:), intent(out), optional :: g,h

    real(dbl), dimension(2) :: r,s
    integer :: i

    do i = 1,size(x)
       r = (/x(i),y(i)/) - t%xy0
       s = matmul(t%mat,r) + t%uv0
       u(i) = s(1)
       v(i) = s(2)

       if( present(g) .and. present(h) ) then
          s = matmul(t%mrot,r)
          g(i) = s(1)
          h(i) = s(2)
       end if

    end do

  end subroutine invaffine_array

! --- affine ---

  subroutine affine_point(t,u,v,x,y)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), intent(in) :: u,v
    real(dbl), intent(out) :: x,y

    real(dbl), dimension(1) :: xx,yy

    call affine(t,(/u/),(/v/),xx,yy)
    x = xx(1)
    y = yy(1)

  end subroutine affine_point

  subroutine affine_array(t,u,v,x,y)

    type(AstroTrafoProj), intent(in) :: t
    real(dbl), dimension(:), intent(in) :: u,v
    real(dbl), dimension(:), intent(out) :: x,y

    real(dbl), dimension(2) :: r,s
    integer :: i

    do i = 1,size(u)
       s = (/u(i),v(i)/) - t%uv0
       r = matmul(t%mat1,s) + t%xy0
       x(i) = r(1)
       y(i) = r(2)
    end do

  end subroutine affine_array


! --- projections ---

  subroutine gproj(proj, acen,dcen, a, d, u,v)

    interface
       subroutine proj(a,d,a0,d0,u,v)
         implicit none
         integer, parameter :: dp = selected_real_kind(15)
         real(dp),intent(in) :: a,d,a0,d0
         real(dp),intent(out) :: u,v
       end subroutine proj
    end interface
    
    real(dbl), intent(in) :: acen,dcen
    real(dbl), dimension(:),intent(in) :: a,d
    real(dbl), dimension(:),intent(out) :: u,v
    integer :: i

    do i = 1, size(a)
       call proj(a(i),d(i),acen,dcen,u(i),v(i))
    end do

  end subroutine gproj

  subroutine invgproj(invproj, acen,dcen, u, v, a,d)

    interface
       subroutine invproj(a,d,a0,d0,u,v)
         implicit none
         integer, parameter :: dp = selected_real_kind(15)
         real(dp),intent(in) :: a,d,a0,d0
         real(dp),intent(out) :: u,v
       end subroutine invproj
    end interface
    
    real(dbl), intent(in) :: acen,dcen
    real(dbl), dimension(:),intent(in) :: u,v
    real(dbl), dimension(:),intent(out) :: a,d
    integer :: i

    do i = 1, size(a)
       call invproj(u(i),v(i),acen,dcen,a(i),d(i))
    end do

  end subroutine invgproj


end module astrotrafo
