!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! TELCAL routines related to pointing
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine fit_xy_gauss(line,error)
  use telcal_interfaces, except_this=>fit_xy_gauss
  use fit_definitions
  use gildas_def
  use gkernel_interfaces
  use gbl_format
  use gkernel_types
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for command:
  !     GAUSS Xvar Yvar [Wvar]
  ! 1        [/DUAL]
  ! 2        [/BASE]
  ! 3        [/GUESS   Area1 Position1 Width1 [Area2/Area1 Position2-Position1 Width2/Width1] [Offset Slope]]
  ! 4        [/FIXED   Area1 Position1 Width1 [Area2/Area1 Position2-Position1 Width2/Width1] [Offset Slope]]
  ! 5        [/RESULTS Area1 Position1 Width1 [Area2/Area1 Position2-Position1 Width2/Width1] [Offset Slope]]]
  ! 6        [/PROFILE Y]
  !
  ! Purpose: Fit one or two Gaussian + a 1st order polynomial into given variables
  !          the 1st order polynomial fit is implied by the 2 Gaussian fit
  !----------------------------------------------------------------------
  character(len=*), intent(in)  :: line  ! Command line
  logical,          intent(out) :: error ! Error flag
  ! Local
  character(len=*), parameter :: rname='GAUSS'
  type (simple_1d) :: dat,sol
  type (fit_fun) :: fun
  logical :: do_dual,do_base
  type(sic_descriptor_t) :: inca,xinca,yinca
  integer(kind=address_length) :: ip,ipx,ipy
  integer(kind=4) :: memory(1)
  integer :: nc,ixy,inx,iny,ier,ipar
  logical :: found
  character(16) :: var
  character(80) :: chain
  !
  ! 0. Initialization
  !
  error = .false.
  !
  ! 1. Data vector setup
  !
  ! Xvar (mandatory)
  call sic_ch(line,0,1,var,nc,.true.,error)
  if (error) goto 100
  call sic_descriptor(var,xinca,found)
  if (.not.found) then
     chain = 'E-GAUSS,  Unknown variable '//var
     call gagout (chain)
     error = .true.
     goto 100
  endif
  if (xinca%type.eq.fmt_r8) then
     inx = xinca%size/2
  elseif (xinca%type.eq.fmt_r4) then
     inx = xinca%size
  endif
  !
  ! Yvar (mandatory)
  call sic_ch(line,0,2,var,nc,.true.,error)
  if (error) goto 100
  call sic_descriptor(var,yinca,found)
  if (.not.found) then
     chain = 'E-GAUSS,  Unknown variable '//var
     call gagout(chain)
     error = .true.
     goto 100
  endif
  if (yinca%type.eq.fmt_r8) then
     iny = yinca%size/2
  elseif (yinca%type.eq.fmt_r4) then
     iny = yinca%size
  endif
  if (iny.ne.inx) then
     call gagout('E-GAUSS, Arrays do not match')
     error = .true.
     goto 100
  endif
  ixy = inx
  !
  dat%n = ixy
  allocate(dat%x(dat%n),dat%y(dat%n),stat=ier)
  if (failed_allocate(rname,"data",ier,error)) goto 100
  !
  ipx = gag_pointer(xinca%addr,memory)
  ipy = gag_pointer(yinca%addr,memory)
  if (xinca%type.eq.fmt_r8) then
     call r8tor8(memory(ipx),dat%x,ixy)
  else
     call r4tor8(memory(ipx),dat%x,ixy)
  endif
  if (yinca%type.eq.fmt_r8) then
     call r8tor8(memory(ipy),dat%y,ixy)
  else
     call r4tor8(memory(ipy),dat%y,ixy)
  endif
  !
  ! Wvar (optional)
  allocate(dat%w(dat%n),stat=ier)
  if (failed_allocate(rname,"weight",ier,error)) goto 100
  !
  if (sic_present(0,3)) then
     print *,'Using input weights'
     call sic_ch(line,0,3,var,nc,.true.,error)
     if (error) goto 100
     call sic_descriptor(var,yinca,found)
     if (.not.found) then
        chain = 'E-GAUSS,  Unknown variable '//var
        call gagout (chain)
        error = .true.
        goto 100
     endif
     if (yinca%type.eq.fmt_r8) then
        iny = yinca%size/2
     elseif (yinca%type.eq.fmt_r4) then
        iny = yinca%size
     endif
     if (iny.ne.inx) then
        call gagout('E-GAUSS, Arrays do not match')
        error = .true.
        goto 100
     endif
     ipy = gag_pointer(yinca%addr,memory)
     if (yinca%type.eq.fmt_r8) then
        call r8tor8(memory(ipy),dat%w,ixy)
     else
        call r4tor8(memory(ipy),dat%w,ixy)
     endif
  else
     print *,'Setting equal weights'
     dat%w = 1.0
  endif
  !
  ! 2. Fitting function setup
  !
  ! Initialization
  nullify(fun%par)
  call null_function(fun)
  ! Fitting method
  fun%method = 'SLATEC'
  ! Search for /DUAL option
  do_dual = sic_present(1,0)
  ! Search for /BASE option
  do_base = sic_present(2,0)
  ! Function name and number of parameters
  if (do_dual) then
     fun%name = '2*GAUSSIAN+BASE'
     fun%npar = 8
  else if (do_base) then
     fun%name = 'GAUSSIAN+BASE'
     fun%npar = 5
  else
     fun%name = 'GAUSSIAN'
     fun%npar = 3
  endif
  allocate(fun%par(fun%npar),stat=ier)
  if (failed_allocate(rname,"function",ier,error)) goto 100
  !
  ! Names
  call null_parameter(fun%par(1))
  fun%par(1)%name = 'AREA1'
  call null_parameter(fun%par(2))
  fun%par(2)%name = 'POSITION1'
  call null_parameter(fun%par(3))
  fun%par(3)%name = 'WIDTH1'
  if (do_dual) then
     call null_parameter(fun%par(4))
     fun%par(4)%name = 'AREA2/AREA1'
     call null_parameter(fun%par(5))
     fun%par(5)%name = 'POSITION2-POSITION1'
     call null_parameter(fun%par(6))
     fun%par(6)%name = 'WIDTH2/WIDTH1'
     call null_parameter(fun%par(7))
     fun%par(7)%name = 'OFFSET'
     call null_parameter(fun%par(8))
     fun%par(8)%name = 'SLOPE'
  else if (do_base) then
     call null_parameter(fun%par(4))
     fun%par(4)%name = 'OFFSET'
     call null_parameter(fun%par(5))
     fun%par(5)%name = 'SLOPE'
  endif
  ! Search for /GUESS option
  if (sic_present(3,0)) then
     ! Guesses are given by user
     do ipar=1,fun%npar
        call sic_r8(line,3,ipar,fun%par(ipar)%guess,.true.,error)
        if (error) goto 100
     enddo
  else
     ! Try not-so-clever guesses
     fun%par(1:fun%npar)%guess = 1.0
  endif
  ! Fixed or variable parameters?
  if (sic_present(4,0)) then
     ! User expresses which parameter are fixed and which are free
     do ipar=1,fun%npar
        call sic_l4(line,4,ipar,fun%par(ipar)%fixed,.true.,error)
        if (error) goto 100
     enddo
  else
     ! All parameters are free
     fun%par(1:fun%npar)%fixed = .false.
  endif
  !
  ! 3. Fitting
  !
  call fit_1d(dat,fun,.true.)
  !
  ! Search for /RESULTS option
  if (sic_present(5,0)) then
     do ipar=1,fun%npar
        call sic_ch(line,5,ipar,var,nc,.true.,error)
        if (error) goto 100
        call sic_descriptor(var,inca,found)
        if (.not.found) then
           chain = 'E-GAUSS,  Unknown variable '//var
           call gagout (chain)
           error = .true.
           goto 100
        endif
        ip = gag_pointer(inca%addr,memory)
        if (inca%type.eq.fmt_r8) then
           call r8tor8(fun%par(ipar)%value,memory(ip),1)
        else
           call r8tor4(fun%par(ipar)%value,memory(ip),1)
        endif
     enddo
  endif
  !
  ! Search for /PROFILE option
  if (sic_present(6,0)) then
     ! Allocate the solution structure
     sol%n = ixy
     allocate(sol%x(sol%n),sol%y(sol%n),stat=ier)
     if (failed_allocate(rname,"solution",ier,error)) goto 100
     ! Compute the solution profile
     call get_profile(fun,sol)
     ! Get variable name
     call sic_ch(line,6,1,var,nc,.true.,error)
     if (error) goto 100
     ! Find its descriptor
     call sic_descriptor(var,inca,found)
     if (.not.found) then
        chain = 'E-GAUSS,  Unknown variable '//var
        call gagout (chain)
        error = .true.
        goto 100
     endif
     ! Transfer memory content
     ip = gag_pointer(inca%addr,memory)
     if (inca%type.eq.fmt_r8) then
        call r8tor8(sol%y,memory(ip),ixy)
     else
        call r8tor4(sol%y,memory(ip),ixy)
     endif
  endif
  !
  ! 4. Freeing memory
  !
100 continue
  call null_simple_1d(dat)
  call null_simple_1d(sol)
  call null_function(fun)
  !
end subroutine fit_xy_gauss
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine default_pointing_guess(guess)
  use telcal_interfaces, except_this=>default_pointing_guess
  use point_definitions
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing
  ! Purpose: Try to make clever guesses to prepare to solve for pointing
  !          parameters. A few comments:
  !            * It is safe to leave offset and slope values to zero as
  !              the fit easily find good values from those guesses
  !            * The initial guesses of area and position will anyway
  !              be changed in the solving process. They are present here
  !              for generality
  !            * The area_ratio and width_ratio guesses are quite easy.
  !            * Nevertheless, to obtain a robust fitting, it is mandatory
  !              that the user gives (outside this routine) useful guesses
  !              of the width (probably the beam FWHM) and the beam throw
  !          We have at most 8 parameters to fit. At high SNR, without bias
  !          this will be easy. However, this is rarely the case. Fixing
  !          the value of the area_ratio, beam_throw and width_ratio is a
  !          good way to obtain a robust value of the position (the goal).
  !          Indeed, it is easy to have good guesses for those values. While
  !          it is true that those guesses are not perfect, simulations
  !          show that this gives robust determination of the pointing
  !          error even when the fit looks biased.
  !----------------------------------------------------------------------
  type(point_guess_t), intent(out) :: guess ! User guesses from command line
  !
  ! Local variables
  !
  guess%offset%value      =  0.0
  guess%slope%value       =  0.0
  guess%area%value        =  0.0
  guess%position%value    =  0.0
  guess%width%value       =  0.0
  guess%area_ratio%value  = -1.0
  guess%beam_throw%value  =  0.0
  guess%width_ratio%value = +1.0
  !
  guess%offset%fixed      = .false.
  guess%slope%fixed       = .false.
  guess%area%fixed        = .false.
  guess%position%fixed    = .false.
  guess%width%fixed       = .false.
  guess%area_ratio%fixed  = .true.
  guess%beam_throw%fixed  = .true.
  guess%width_ratio%fixed = .true.
  !
end subroutine default_pointing_guess
!
subroutine init_pointing(ndat,nsol,psys,pdir,ptype,point,error)
  use gkernel_interfaces
  use telcal_interfaces, except_this=>init_pointing
  use point_definitions
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing
  ! Purpose: Free, reallocate and initialize the POINT structure
  !          according to user defined input. Data must be filled
  !          outside
  !----------------------------------------------------------------------
  integer, intent(in) :: ndat             ! Number of data points
  integer, intent(in) :: nsol             ! Number of solution points
  integer, intent(in) :: psys             ! Pointing coordinate system
  character(len=16), intent(in) :: pdir   ! Pointing direction in above system
  character(len=16), intent(in) :: ptype  ! Pointing type (SINGLE|DUAL)
  type(pointing_t), intent(out) :: point  ! Pointing structure
  logical, intent(out) :: error           ! Error flag
  !
  ! Local variables
  character(len=13) :: rname = 'INIT_POINTING'
  integer :: npar,ipar,ier
  !
  ! Initialization
  error = .false.
  !
  ! Fill in pointing coordinate system, direction, and type
  point%sys  = psys
  point%dir  = pdir
  point%type = ptype
  !
  ! Free (if needed), (re)allocate and initialize the data structure
  call null_simple_1d(point%dat)
  point%dat%n = ndat
  allocate(point%dat%x(ndat),point%dat%y(ndat),point%dat%w(ndat),point%dat%d(ndat),stat=ier)
  if (failed_allocate(rname,"data",ier,error)) return
  point%dat%x = 0.
  point%dat%y = 0.
  point%dat%w = 1.
  point%dat%d = 0.
  !
  ! Free (if needed), (re)allocate and initialize the solution structure
  call null_simple_1d(point%sol)
  point%sol%n = nsol
  allocate(point%sol%x(nsol),point%sol%y(nsol),point%sol%w(nsol),point%sol%d(nsol),stat=ier)
  if (failed_allocate(rname,"solution",ier,error)) return
  point%sol%x = 0.
  point%sol%y = 0.
  point%sol%w = 1.
  point%sol%d = 0.
  !
  ! Free (if needed), (re)allocate and initialize the function structure
  call null_function(point%fun)
  point%fun%method = 'SLATEC'
  if (ptype.eq."SINGLE") then
     point%fun%name = 'GAUSSIAN+BASE'
     npar = 5
  else
     point%fun%name = '2*GAUSSIAN+BASE'
     npar = 8
  endif
  point%fun%npar = npar
  allocate(point%fun%par(npar),stat=ier)
  if (failed_allocate(rname,"function",ier,error)) return
  do ipar=1,npar
     call null_parameter(point%fun%par(ipar))
  enddo
  point%fun%par(1)%name = 'AREA'
  point%fun%par(2)%name = 'POSITION'
  point%fun%par(3)%name = 'WIDTH'
  if (ptype.eq."SINGLE") then
     point%fun%par(4)%name = 'OFFSET'
     point%fun%par(5)%name = 'SLOPE'
  else
     point%fun%par(4)%name = 'AREA2/AREA1'
     point%fun%par(5)%name = 'POSITION2-POSITION1'
     point%fun%par(6)%name = 'WIDTH2/WIDTH1'
     point%fun%par(7)%name = 'OFFSET'
     point%fun%par(8)%name = 'SLOPE'
  endif
  !
end subroutine init_pointing
!
subroutine define_sic_pointing(point,varname,error)
  use telcal_interfaces, except_this=>define_sic_pointing
  use point_definitions
  use gildas_def
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing
  ! Purpose: (Re)define the SIC structure VARNAME associated to the
  !          FORTRAN90 structure POINT
  !----------------------------------------------------------------------
  type(pointing_t), intent(in) :: point     ! FORTRAN 90 pointing structure
  character(len=*), intent(in) :: varname   ! Name of the SIC structure associated to POINT
  logical, intent(out) :: error             ! Logical flag
  ! Local
  integer :: ndat,nsol,npar,ipar
  character(len=1) :: cpar
  !
  ! Initialization
  error = .false.
  !
  ! Create the SIC substructure (Delete it first if needed)
  if (sic_varexist(varname)) then
     call sic_delvariable(varname,.false.,error)
     if (error) return
  endif
  call sic_defstructure(varname,.true.,error)
  if (error) return
  !
  call sic_def_inte (varname//'%sys',point%sys,0,0,.false.,error)
  call sic_def_charn(varname//'%dir',point%dir,0,0,.false.,error)
  !
  ! Create data, solution and function structures
  call sic_defstructure(varname//'%dat',.true.,error)
  call sic_defstructure(varname//'%sol',.true.,error)
  call sic_defstructure(varname//'%fun',.true.,error)
  if (error) return
  !
  ! Create data associated variables
  ndat = point%dat%n
  call sic_def_inte(varname//'%dat%n',point%dat%n,0,0,.false.,error)
  call sic_def_dble(varname//'%dat%x',point%dat%x,1,ndat,.false.,error)
  call sic_def_dble(varname//'%dat%y',point%dat%y,1,ndat,.false.,error)
  call sic_def_dble(varname//'%dat%w',point%dat%w,1,ndat,.false.,error)
  if (error) return
  !
  ! Create solution associated variables
  nsol = point%sol%n
  call sic_def_inte(varname//'%sol%n',point%sol%n,0,0,.false.,error)
  call sic_def_dble(varname//'%sol%x',point%sol%x,1,nsol,.false.,error)
  call sic_def_dble(varname//'%sol%y',point%sol%y,1,nsol,.false.,error)
  call sic_def_dble(varname//'%sol%w',point%sol%w,1,nsol,.false.,error)
  if (error) return
  !
  ! Create function associated variables
  npar = point%fun%npar
  call sic_def_char(varname//'%fun%name',  point%fun%name,.true.,error)
  call sic_def_char(varname//'%fun%method',point%fun%method,.true.,error)
  call sic_def_real(varname//'%fun%chi2',  point%fun%chi2,0,0,.false.,error)
  call sic_def_real(varname//'%fun%rms',   point%fun%rms,0,0,.false.,error)
  call sic_def_inte(varname//'%fun%flag',  point%fun%flag,0,0,.false.,error)
  call sic_def_inte(varname//'%fun%ncall', point%fun%ncall,0,0,.false.,error)
  call sic_def_inte(varname//'%fun%npar',  point%fun%npar,0,0,.true.,error)
  if (error) return
  ! Loop over the function parameters
  do ipar=1,npar
     write(cpar,'(i1)') ipar
     call sic_def_char(varname//'%fun%par'//cpar//'%name', point%fun%par(ipar)%name,.true.,error)
     call sic_def_dble(varname//'%fun%par'//cpar//'%guess',point%fun%par(ipar)%guess,0,0,.false.,error)
     call sic_def_dble(varname//'%fun%par'//cpar//'%value',point%fun%par(ipar)%value,0,0,.false.,error)
     call sic_def_dble(varname//'%fun%par'//cpar//'%error',point%fun%par(ipar)%error,0,0,.false.,error)
     call sic_def_dble(varname//'%fun%par'//cpar//'%mini', point%fun%par(ipar)%mini,0,0,.false.,error)
     call sic_def_dble(varname//'%fun%par'//cpar//'%maxi', point%fun%par(ipar)%maxi,0,0,.false.,error)
     call sic_def_logi(varname//'%fun%par'//cpar//'%fixed',point%fun%par(ipar)%fixed,.false.,error)
     if (error) return
  enddo
  !
end subroutine define_sic_pointing
!
subroutine solve_pointing(point,guess,verbose,error)
  use telcal_interfaces, except_this=>solve_pointing
  use point_definitions
  use phys_const
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing
  ! Purpose: Find the first guesses, fit and compute profile of fit
  !          solution. The fit is iterated with position guess every half
  !          FWHM in the x coordinate range. The best fit is then selected.
  !          In real cases, this implies of the order of 20 fits if the width
  !          parameter. This scheme provides a very robust solution.
  !----------------------------------------------------------------------
  type(pointing_t), intent(inout) :: point ! FORTRAN 90 pointing structure
  type(point_guess_t), intent(in) :: guess ! User guesses from command line
  logical, intent(in)  :: verbose          ! Verbose or quiet solving?
  logical, intent(out) :: error            ! Error flag
  !
  ! Local variables
  logical :: start
  integer :: idat,isol,iiter,niter,ibest
  real :: xmin,xmax,xcur
  real :: ymin,ymax,ycur
  real :: bestchi2
  real(8) :: width
  !
  ! Initialization
  error = .false.
  !
  ! Do something only when the structure is ready for solving
  if (point%fun%flag.eq.2) then
     !
     ! Check valid data points and find minimum and maximum values
     ! in x and y
     ! Maybe I should also set a minimum number of valid data point
     start = .true.
     do idat=1,point%dat%n
        if (point%dat%w(idat).gt.0) then
           xcur = point%dat%x(idat)
           ycur = point%dat%y(idat)
           if (start) then
              start = .false.
              xmin = xcur
              xmax = xmin
              ymin = ycur
              ymax = ymin
           else
              if (xcur.lt.xmin) then
                 xmin = xcur
              else if (xmax.lt.xcur) then
                 xmax = xcur
              endif
              if (ycur.lt.ymin) then
                 ymin = ycur
              else if (ymax.lt.ycur) then
                 ymax = ycur
              endif
           endif
        endif
     enddo
     if (start) then
        call gagout('E-POINT, No valid data point...')
        error = .true.
        return
     endif
     !
     ! The absolute value is to avoid fitting negative noise
     ! peaks as the searched Gaussian
     width = abs(guess%width%value)
     if (width.eq.0) then
        call gagout('E-POINT, Width must be different from 0')
        error = .true.
        return
     endif
     !
     ! The user has the choice to fixe or free any parameter
     point%fun%par(1)%fixed = guess%area%fixed
     point%fun%par(2)%fixed = guess%position%fixed
     point%fun%par(3)%fixed = guess%width%fixed
     if (point%fun%name.eq."GAUSSIAN+BASE") then
        point%fun%par(4)%fixed = guess%offset%fixed
        point%fun%par(5)%fixed = guess%slope%fixed
     else
        point%fun%par(4)%fixed = guess%area_ratio%fixed
        point%fun%par(5)%fixed = guess%beam_throw%fixed
        point%fun%par(6)%fixed = guess%width_ratio%fixed
        point%fun%par(7)%fixed = guess%offset%fixed
        point%fun%par(8)%fixed = guess%slope%fixed
     endif
     !
     ! Initial guesses for all parameters except position
     if (guess%area%fixed) then
        point%fun%par(1)%guess = guess%area%value
     else
        point%fun%par(1)%guess = 0.5*abs(ymax*width)*sqrt(pi/log(2.0))
     endif
     point%fun%par(3)%guess = width
     if (point%fun%name.eq."GAUSSIAN+BASE") then
        point%fun%par(4)%guess = guess%offset%value
        point%fun%par(5)%guess = guess%slope%value
     else
        point%fun%par(4)%guess = guess%area_ratio%value
        point%fun%par(5)%guess = guess%beam_throw%value
        point%fun%par(6)%guess = guess%width_ratio%value
        point%fun%par(7)%guess = guess%offset%value
        point%fun%par(8)%guess = guess%slope%value
        !
        xmin = xmin-0.5*point%fun%par(5)%guess
     endif
     !
     ! Position guess is essential to have a robust fitting
     ! => Particular treatement
     if (guess%position%fixed) then
        ! The user knows what he is doing...
        point%fun%par(2)%guess = guess%position%value
     else
        ! Loop over the position guess with a coordinate
        ! resolution of half FWHM. The best chi2 fit is
        ! then selected
        niter = 2*abs(xmax-xmin)/width
        start = .true.
        do iiter=1,niter
           point%fun%par(2)%guess = xmin+0.5*width*(iiter-1)
           call fit_1d(point%dat,point%fun,.false.)
           if ((point%fun%flag.eq.0).and.(point%fun%par(1)%value*point%fun%par(3)%value.gt.0)) then
              if (start) then
                 ibest = iiter
                 bestchi2 = point%fun%chi2
                 start = .false.
              else if (point%fun%chi2.lt.bestchi2) then
                 ibest = iiter
                 bestchi2 = point%fun%chi2
              endif
           endif
        enddo
        if (start) then
           call gagout('E-POINT, Fitting problem...')
           error = .true.
           return
        endif
        point%fun%par(2)%guess = xmin+0.5*width*(ibest-1)
     endif
     !
     ! Redo the best chi2 fit: a bit more computation but a much
     ! simpler source code
     call fit_1d(point%dat,point%fun,verbose)
     !
     ! Get profile of fit solution
     do isol=1,point%sol%n
        point%sol%x(isol) = xmin+(xmax-xmin)*(isol-1)/(point%sol%n-1)
     enddo
     call get_profile(point%fun,point%sol)
     !
  endif
  !
end subroutine solve_pointing
!
subroutine free_pointing(point)
  use telcal_interfaces, except_this=>free_pointing
  use point_definitions
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing
  ! Purpose: Free memory associated to the FORTRAN 90 pointing structure
  !----------------------------------------------------------------------
  type(pointing_t), intent(inout) :: point ! FORTRAN 90 pointing structure
  !
  ! Local variables
  !
  call null_function(point%fun)
  call null_simple_1d(point%sol)
  call null_simple_1d(point%dat)
  !
end subroutine free_pointing
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine init_point_cross(my_ncross,ndat,nsol,psys,pdir,ptype,error)
  use telcal_interfaces, except_this=>init_point_cross
  use pcross_definitions
  use gildas_def
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing through a cross
  ! Purpose: Initialize the PCROSS FORTRAN90 and SIC structures
  !----------------------------------------------------------------------
  integer, intent(in) :: my_ncross        ! Number of subscans real used in the PCROSS structure
  integer, intent(in) :: ndat(my_ncross)  ! Number of data points in each subscan
  integer, intent(in) :: nsol(my_ncross)  ! Number of solution points in each subscan
  integer, intent(in) :: psys(my_ncross)  ! Coordinate system of each subscan
  character(len=16), intent(in) :: pdir(my_ncross)  ! Direction of each subscan
  character(len=16), intent(in) :: ptype(my_ncross) ! Type of each subscan (SINGLE or DUAL)
  logical, intent(out) :: error
  ! Local
  character(len=128) :: mess
  character(len=32) :: varname
  integer :: icross
  !
  ! Initialization
  error = .false.
  !
  ! Sanity check
  if (my_ncross.eq.0) then
     call gagout('E-POINT, Number of cross subscans must be greater than 0')
     error = .true.
     return
  else if (my_ncross.gt.mcross) then
     write(mess,*) 'E-POINT, Number of cross subscans must be lower than',mcross
     call gagout(mess)
     error = .true.
     return
  endif
  !
  ! Set actual number of cross subscans
  ncross = my_ncross
  !
  ! Check whether the SIC pcross structure exists
  if (sic_varexist('pcross')) then
     ! Structure already exists => Delete it
     call sic_delvariable('pcross',.false.,error)
     if (error) return
  endif
  ! Recreate the PCROSS structure
  call sic_defstructure('pcross',.true.,error)
  !
  ! Loop over the subscans
  do icross=1,ncross
     ! Initialize FORTRAN90 structure
     call init_pointing(  &
          ndat(icross),   &
          nsol(icross),   &
          psys(icross),    &
          pdir(icross),   &
          ptype(icross),  &
          pcross(icross), &
          error)
     if (error) return
     ! Define associated PCROSS SIC structure
     write(varname,'(a10,i0)') "pcross%sub",icross
     call define_sic_pointing(pcross(icross),varname(1:lenc(varname)),error)
     if (error) return
  enddo
  !
end subroutine init_point_cross
!
subroutine solve_point_cross(guess,verbose,plot,error)
  use telcal_interfaces, except_this=>solve_point_cross
  use pcross_definitions
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing through a cross
  ! Purpose: Solve the telescope pointing parameters through a cross
  !          and plot the results
  !----------------------------------------------------------------------
  type(point_guess_t), intent(in)  :: guess   ! User guesses from command line
  logical,             intent(in)  :: verbose ! Verbose or quiet solve?
  logical,             intent(in)  :: plot    ! Do we plot the results?
  logical,             intent(out) :: error   ! Error flag
  !
  ! Local variables
  integer :: icross
  !
  ! Initialization
  error = .false.
  !
  ! Sanity check
  if ((1.le.ncross).and.(ncross.le.mcross)) then
     ! Loop over the subscans
     do icross=1,ncross
        call solve_pointing(pcross(icross),guess,verbose,error)
        if (error) return
     enddo
     ! Plots results when asked
     if (plot) then
        call exec_program('sic\@ plot-point-cross.telcal')
     endif
  endif
  !
end subroutine solve_point_cross
!
subroutine free_point_cross
  use telcal_interfaces, except_this=>free_point_cross
  use pcross_definitions
  use gildas_def
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for pointing through a cross
  ! Purpose: Free the PCROSS FORTRAN90 and SIC structures
  !----------------------------------------------------------------------
  ! Local
  integer :: icross
  logical :: error
  !
  ! Delete associated SIC structure when needed
  if (sic_varexist('pcross')) then
     call sic_delvariable('pcross',.false.,error)
  endif
  !
  ! Sanity check
  if ((1.le.ncross).and.(ncross.le.mcross)) then
     ! Loop over the subscans
     do icross=1,ncross
        call free_pointing(pcross(icross))
     enddo
  endif
  !
  ! Reset actual number of cross subscans to avoid problem if "POINT /SOLVE" is called again
  ncross = 0
  !
end subroutine free_point_cross
!
subroutine telcal_point(line,error)
  use telcal_interfaces, except_this=>telcal_point
  use gkernel_interfaces
  use pcross_definitions
  use gbl_constant
  use phys_const
  !----------------------------------------------------------------------
  ! @ private
  ! TELCAL support routine for command
  !     POINT
  ! 1        [/INIT  SINGLE|DUAL Ndat Nsol]
  ! 2        [/SOLVE Width [BeamThrow [Area_Ratio Width_Ratio]]]
  !----------------------------------------------------------------------
  character(len=*), intent(in)  :: line  ! Command line
  logical,          intent(out) :: error ! Error flag
  !
  ! Local variables
  type(point_guess_t) :: guess
  character(len=256) :: chain
  logical :: do_init,do_solve
  integer :: nchain
  integer :: ndat,nsol
  integer :: ndats(4),nsols(4),psyss(4)
  character(len=16) :: pdirs(4),ptypes(4)
  !
  integer miptype,niptype ! Input pointing type
  parameter (miptype=2)
  character(len=16) :: iptypes(miptype),iptype
  data iptypes/'SINGLE','DUAL'/
  !
  ! Initialization
  error    = .false.
  do_init  = .false.
  do_solve = .false.
  !
  ! Search for option /INIT or /SOLVE
  do_init  = sic_present(1,0)
  do_solve = sic_present(2,0)
  if (do_init.and.do_solve) then
     call gagout('E-POINT, /INIT and /SOLVE are exclusive from each other')
     error = .true.
     return
  endif
  !
  ! Initialize
  if (do_init) then
     ! Get pointing type
     call sic_ke(line,1,1,chain,nchain,.true.,error)
     call sic_ambigs('POINT',chain,iptype,niptype,iptypes,miptype,error)
     if (error) return
     ! Get length of subscans
     call sic_i4(line,1,2,ndat,.true.,error)
     ! Get length of solution
     call sic_i4(line,1,3,nsol,.true.,error)
     if (error) return
     ! Prepare initialization:
     ! 1. Number of data and solution points
     ndats = ndat
     nsols = nsol
     ! 2. Cartesian coordinate system
     psyss = p_none
     ! 3. Subscan directions
     pdirs(1) = '+LAM'
     pdirs(2) = '-LAM'
     pdirs(3) = '+BET'
     pdirs(4) = '-BET'
     ! 4. Pointing type resulting from scanning direction and chopping mode
     ptypes(1) = iptype
     ptypes(2) = iptype
!     ptypes(3) = 'SINGLE'
!     ptypes(4) = 'SINGLE'
     ptypes(3) = iptype
     ptypes(4) = iptype
     ! Initialize FORTRAN90 and SIC PCROSS associated structures
     call init_point_cross(4,ndats,nsols,psyss,pdirs,ptypes,error)
     if (error) return
  endif
  !
  ! Solve when possible
  if (ncross.ne.0) then
     ! Initialization happened => Continue
     if (do_solve) then
        ! Useful defaults
        call default_pointing_guess(guess)
        if (error) return
        ! Mandatory width guess in any case
        call sic_r8(line,2,1,guess%width%value,.true.,error)
        if (error) return
        ! Check which kind of pointing will be solved
        if (any(pcross(:)%type.eq."DUAL")) then
           iptype = "DUAL"
        else
           iptype = "SINGLE"
        endif
        ! Retrieves possible other arguments
        if (iptype.eq."DUAL") then
           ! Mandatory BeamThrow in case of DUAL beam pointing
           call sic_r8(line,2,2,guess%beam_throw%value,.true.,error)
           if (error) return
           ! Optional area_ratio
           if (sic_present(2,3)) then
              call sic_r8(line,2,3,guess%area_ratio%value,.false.,error)
           endif
           ! Optional width_ratio
           if (sic_present(2,4)) then
              call sic_r8(line,2,4,guess%width_ratio%value,.false.,error)
           endif
        endif
        ! Solve pointing and plot results
        call solve_point_cross(guess,.true.,.true.,error)
        if (error) return
     endif
  else
     ! Initialization is missing => Problem
     call gagout('E-POINT, Pointing must be initialized before solved')
     error = .true.
     return
  endif
  !
end subroutine telcal_point
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
