!-----------------------------------------------------------------------
! Support file for skydips fit (minimization routines).
!
! In this file, equations can be found from:
!   Memo I: "Amplitude Calibration, IRAM PdBI", S.Guilloteau, v1.0
!   Memo II: "Calibration of spectral line data at the IRAM 30m
!             radiotelescope", C.Kramer, 24-jan-1997, v2.1
!-----------------------------------------------------------------------
module skydip_data
  use chopper_definitions
  !
  ! Atmosphere definition
  real*4 :: tamb,pamb,alti
  !
  integer, parameter :: mmeas=10  ! Maximum number of measurement sets to reduce simultaneously
  integer :: nmeas                ! Number of effective measurement set requested by user
  !
  ! Input receiver(s)
  type(mixer), save :: rec(mmeas)  ! rec%feff & rec%temp: one is in, one is out, depending on mode
  !
  ! Input skydip measurements
  type(skydip_meas), save :: skydip(mmeas)
  !
  ! FITSKY (minimization routine) variables
  real*8 :: sky(msky,mmeas)   ! Unknown (???) (Trec mode)
  real*8 :: temi(msky,mmeas)  ! Temi (Feff mode)
  logical :: trec_mode        ! Fit Trec or Feff
  real*8  :: par(mmeas+2)     ! mmeas*Feff + H2Omm + Tloss
                              ! Feff/Trec are the 1 to nmeas parameters
  integer :: ph2o             ! H2Ommm is the ph2o-th parameter
  logical :: tloss_mode       ! Fit or not one global Tloss
  integer :: ptloss           ! Tloss is the ptloss-th parameter
  integer :: plast            ! Last parameter is the plast-th one
  real*8 :: chi2tot           ! One global chi2 for all fitted measurement set
  real*8 :: rmstot            ! One global RMS for all fitted measurement set
  !
  ! Calibration variables
  type(atm_prop), save :: atm(mmeas)  ! Each measurement set (with its own frequencies)
                                 ! has its own atm% values
  real :: tcal,chot_mean
  !
end module skydip_data
!
subroutine solve_skydip(tamb_in,pamb_in,alti_in,     &
                        nmeas_in,rec_in,skydip_in,   &
                        fit_mode_in,  &
                        params_out,   &
                        error)
  use telcal_interfaces, except_this=>solve_skydip
  use skydip_data
  use chopper_definitions
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !   Main entrance routine to reduce a skydip.
  !   1) Copy input data into the real variables used for the reduction.
  !      These are shared through subroutines thanks to a module.
  !   2) Call the real work routine
  !----------------------------------------------------------------------
  real*4,             intent(in)    :: tamb_in         ! [K]
  real*4,             intent(in)    :: pamb_in         ! [mbar/hPa]
  real*4,             intent(in)    :: alti_in         ! [m]
  integer,            intent(in)    :: nmeas_in        !
  type (mixer),       intent(in)    :: rec_in(nmeas_in)     !
  type (skydip_meas), intent(in)    :: skydip_in(nmeas_in)  !
  logical,            intent(in)    :: fit_mode_in(2)  ! Which values to fit
  real*8,             intent(out)   :: params_out(*)   ! Output fitted parameters
  logical,            intent(inout) :: error           ! Error flag
  !
  ! 1) Copy values into shared variables
  tamb = tamb_in
  pamb = pamb_in
  alti = alti_in
  nmeas = nmeas_in
  rec(1:nmeas) = rec_in
  skydip(1:nmeas) = skydip_in
  trec_mode = fit_mode_in(1)
  tloss_mode = fit_mode_in(2)
  !
  ! 2) Deduce some fitting parameters
  ph2o = nmeas+1
  if (tloss_mode) then
    ptloss = nmeas+2
    plast = ptloss
  else
    plast = ph2o
  endif
  !
  ! 2) Call the reduction routines
  call solve_skydip_sub(error)
  if (error) return
  !
  ! 3) Return fitted parameters
  params_out(1:plast) = par(1:plast)
  !
end subroutine solve_skydip
!
subroutine solve_skydip_sub(error)
  use telcal_interfaces, except_this=>solve_skydip_sub
  use skydip_data
  !----------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !   Reduce a skydip. Compute the starting atmospheric model.
  !----------------------------------------------------------------------
  logical, intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname='SKYDIP'
  character(len=*), parameter :: wchain='W-'//rname//',  '
  integer :: ier,imeas
  !
  ! Set the atmosphere
  call atm_atmosp(tamb,  &    ! [K]
                  pamb,  &    ! [mbar]
                  alti*1e-3)  ! [km]
  !
  ! Prepare environment for each skydip to be reduced
  do imeas=1,nmeas
    call solve_skydip_set(imeas,error)
    if (error) return
  enddo
  !
  ! Minimize
  ! ZZZ to be checked in Trec mode
  chot_mean = skydip(1)%hot(1)%count  ! sum(skydip%hot(1:skydip%nhot)%count)/skydip%nhot
  call fitsky(minsky,.false.,ier)
  if (ier.ne.0)  &
     call gagout(wchain//'Solution not converged')
  !
  ! Fitted (and derived) values
  do imeas=1,nmeas
    ! Fitted H2O
    atm(imeas)%h2omm = par(ph2o)  ! Same for all
    atm(imeas)%taus%tot = atm(imeas)%taus%oth + atm(imeas)%h2omm * atm(imeas)%taus%wat
    atm(imeas)%taui%tot = atm(imeas)%taui%oth + atm(imeas)%h2omm * atm(imeas)%taui%wat
    !
    ! Fitted Trec/Feff
    if (trec_mode) then
      rec(imeas)%temp = par(imeas)
    else
      rec(imeas)%feff = par(imeas)
    endif
  enddo
  !
  ! Display results
  call skydip_display()
  !
end subroutine solve_skydip_sub
!
subroutine solve_skydip_set(inmeas,error)
  use atm_interfaces_public
  use telcal_interfaces, except_this=>solve_skydip_set
  use skydip_data
  !---------------------------------------------------------------------
  ! @ private
  ! Prepare the environment (atmosphere...) and calibration variables
  ! for the inmeas-th skydip.
  !---------------------------------------------------------------------
  integer, intent(in)    :: inmeas  ! Skydip number
  logical, intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SKYDIP'
  character(len=*), parameter :: echain='E-'//rname//',  '
  real*4 :: t_emi,freqsig_ghz,freqima_ghz
  real*4 :: tau_dry_s,tau_wet_s,tau_tot_s,t_atm_s
  real*4 :: tau_dry_i,tau_wet_i,tau_tot_i,t_atm_i
  integer :: i,ier
  character(len=*), parameter :: emess(3) = (/  &
                'Zero atmospheric opacity',     &
                'No oxygen in atmosphere ' ,    &
                'No water in atmosphere  '  /)
  !
  ! Set opacities (signal and image)
  freqsig_ghz = 1e-3*skydip(inmeas)%freq%s
  call atm_transm(1.,1.,freqsig_ghz,  &
                  t_emi,t_atm_s,tau_dry_s,tau_wet_s,tau_tot_s,ier)
  if (ier.ne.0)  &
    call gagout(echain//'Stupid calibration: '//emess(ier))
  atm(inmeas)%taus%oth = tau_dry_s  ! R*8 <- R*4
  atm(inmeas)%taus%wat = tau_wet_s
  atm(inmeas)%temp%s   = t_atm_s
  !
  freqima_ghz = 1e-3*skydip(inmeas)%freq%i
  call atm_transm(1.,1.,freqima_ghz,  &
                  t_emi,t_atm_i,tau_dry_i,tau_wet_i,tau_tot_i,ier)
  if (ier.ne.0)  &
    call gagout(echain//'Stupid calibration: '//emess(ier))
  atm(inmeas)%taui%oth = tau_dry_i  ! R*8 <- R*4
  atm(inmeas)%taui%wat = tau_wet_i
  atm(inmeas)%temp%i   = t_atm_i
  !
  if (trec_mode) then
    do i=1,skydip(inmeas)%nsky
      sky(i,inmeas) =  &
        skydip(inmeas)%emiss(i)%count - skydip(inmeas)%hot(i)%count
    enddo
  else
    do i=1,skydip(inmeas)%nsky
      ! Eq.7 Memo I:
      ! Temi = ((Tload+Trec)*Cemi)/Cload - Trec
      temi(i,inmeas) =  &
        (skydip(inmeas)%hot(i)%temp + rec(inmeas)%temp) *  &
        skydip(inmeas)%emiss(i)%count /            &
        skydip(inmeas)%hot(i)%count                &
        - rec(inmeas)%temp
    enddo
  endif
  !
end subroutine solve_skydip_set
!
subroutine skydip_display()
  use telcal_interfaces, except_this=>skydip_display
  use skydip_data
  !---------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !   Display the input and fitted values
  !---------------------------------------------------------------------
  ! Local
  integer :: imeas
  !
  ! Print common parameters
  write(6,'(A)') '=== Summary ====='
  write(6,100) tamb,pamb,alti
  !
  ! Print skydip-per-skydip values
  do imeas=1,nmeas
    write(6,'(A,I2,A)') '--- ',imeas,' -----'
    ! Input
    write(6,101) rec(imeas)%temp,skydip(imeas)%hot(1)%temp,skydip(imeas)%cold(1)%temp
    !
    ! Output
    write(6,'(t20,a,t30,a,t40,a,t50,a,t60,a)')  &
      'Freq','Tau','TauDry','TauWet','Tatm'
    write(6,102)  'Signal band: ',  &
      1d-3*skydip(imeas)%freq%s,atm(imeas)%taus%tot,atm(imeas)%taus%oth,  &
        atm(imeas)%taus%wat*atm(imeas)%h2omm,atm(imeas)%temp%s
    write(6,102)  'Image  band: ',  &
      1d-3*skydip(imeas)%freq%i,atm(imeas)%taui%tot,atm(imeas)%taui%oth,  &
        atm(imeas)%taui%wat*atm(imeas)%h2omm,atm(imeas)%temp%i
    !
    write(6,103)  rec(imeas)%feff
  enddo
  !
  ! Print fitted values shared by all skydips
  write(6,'(A)') '--- Total -----'
  if (tloss_mode) then
    write(6,104) atm(1)%h2omm,par(ptloss)
  else
    write(6,105) atm(1)%h2omm
  endif
  write(6,106) chi2tot,rmstot
  !
100 format(t3,'Tamb:',f8.2,t20,'Pamb:',f8.2,t37,'Alti:',f8.0)
101 format(t3,'Trec:',f8.2,t20,'Thot:',f8.2,t37,'Tcold:',f8.2)
102 format(t3,a,t15,5f10.3)
103 format(t3,'Feff:', f8.3)
104 format(t3,'Water:',f8.3,t20,'Tloss (K):',f8.2)
105 format(t3,'Water:',f8.3)
106 format(t3,'Chi2:',f8.4,t20,'Rms (K):',f8.4)
  !
end subroutine skydip_display
!
subroutine fitsky(fcn,liter,ier)
  use telcal_interfaces, except_this=>fitsky
  use skydip_data
  use gkernel_interfaces
  use fit_minuit
  !----------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !   Setup and starts a SKYDIP fit minimisation using MINUIT
  !----------------------------------------------------------------------
  external             :: fcn      ! Function to be mininized
  logical, intent(in)  :: liter    ! Logical of iterate fit
  integer, intent(out) :: ier      ! Error flag
  ! Local
  type(fit_minuit_t) :: fit
  integer :: npoints,imeas
  real :: tau,a1,ap
  logical :: error
  !
  error = .false.
  ier = 0
  !
  fit%owner = gpack_get_id('telcal',.true.,error)
  if (error)  return
  fit%maxext=ntot
  fit%maxint=nvar
  npoints = sum(skydip(1:nmeas)%nsky)
  !
  write(6,'(A)') 'SKYDIP Fit:'
  !
  ! Initialise values.
  do imeas=1,nmeas
    ! Airmasses: approx but harmless for an initial guess
    a1 = 1./sin(skydip(imeas)%elev(1))
    ap = 1./sin(skydip(imeas)%elev(skydip(imeas)%nsky))
    !
    if (trec_mode) then
      ! ZZZ to be checked in Trec mode
      par(imeas) = skydip(imeas)%hot(1)%count /  &
                   (0.9*rec(imeas)%temp + skydip(imeas)%hot(1)%temp)
      write(6,'(A,I2,A,F8.3)')  &
        ' Starting value of Trec[',imeas,'] (K): ',par(imeas)
      tau = (sky(skydip(imeas)%nsky,imeas)-sky(1,imeas)) /  &
            par(imeas)/(ap-a1)/atm(imeas)%temp%s/rec(imeas)%feff
    else
      par(imeas) = 1. -  &
                  (a1*temi(skydip(imeas)%nsky,imeas) - ap*temi(1,imeas)) /  &
                  tamb/(a1-ap)
      par(imeas) = min(1.,max(0.,par(imeas)))
      write(6,'(A,I2,A,F8.3)')  &
        ' Starting value of Feff[',imeas,']    : ',par(imeas)
      tau = (temi(skydip(imeas)%nsky,imeas)-temi(1,imeas)) /  &
            par(imeas)/(ap-a1)/atm(imeas)%temp%s
    endif
  enddo
  !
  ! Starting value of global H2Omm. Rely on the last measurement set for
  ! initial guess.
  ! tau_tot = tau_dry + Wh2O*tau_wet
  par(ph2o) = (tau-atm(nmeas)%taus%oth)/atm(nmeas)%taus%wat *  &
              (1.0+rec(nmeas)%sbgr) ! ZZZ ! Extra factor?
  par(ph2o) = min(20.,max(0.,par(ph2o)))
  write(6,'(A,F8.3)') ' Starting value of PWV (mm)    :',par(ph2o)
  !
  ! Starting value for global Tloss (if fitted)
  if (tloss_mode) then
    ! Tloss = alpha*Tcab+(1-alpha)*Tamb
    par(ptloss) = tamb  ! Approximation for initial guess
    write(6,'(A,F8.2)') ' Starting value of Tloss (K)   :',par(ptloss)
  endif
  !
  ! Init
  call midsky(fit,ier,liter)
  if (ier.ne.0) return
  call intoex(fit,fit%x)
  fit%nfcnmx = 1000
  fit%newmin = 0
  fit%itaur  = 0
  fit%isw(1) = 0
  fit%isw(3) = 1
  fit%nfcn = 1
  fit%vtest = 0.04
  call fcn(fit%npar,fit%g,fit%amin,fit%u,1)
  chi2tot = fit%amin
  rmstot = sqrt(fit%amin/npoints)  ! RMS with initial values
  fit%up = rmstot**2
  fit%epsi = 0.1d0 * fit%up
  !
  ! Simplex Minimization
  call simplx(fit,fcn,ier)
  if (ier.ne.0) return
  call intoex(fit,fit%x)
  ! Store back results
  par(1:plast) = fit%u(1:plast)
  ! Compute rms
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  chi2tot = fit%amin
  rmstot = sqrt(fit%amin/npoints)
  fit%up = rmstot**2
  write(6,'(A)') '1st step: Simplex minimization'
  call fitsky_print(fit)
  ! Prepare next minimization
  fit%epsi = 0.1d0 * fit%up
  fit%apsi = fit%epsi
  !
  ! Gradient Minimization
  call hesse(fit,fcn)
  call migrad(fit,fcn,ier)
  call intoex(fit,fit%x)
  ! Store back results
  par(1:plast) = fit%u(1:plast)
  ! Compute rms
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  chi2tot = fit%amin
  rmstot = sqrt(fit%amin/npoints)
  fit%up = rmstot**2
  write(6,'(A)') '2nd step: Gradient minimization'
  call fitsky_print(fit)
  ! Prepare next minimization
  fit%epsi = 0.1d0 * fit%up
  fit%apsi = fit%epsi
  ier = 0
  call migrad(fit,fcn,ier)
  !
  ! Iterate once again if not converged
  if (ier.eq.3) then
    ier = 0
    call migrad(fit,fcn,ier)
  endif
  ! Compute covariance matrix if bad
  if (ier.eq.1) then
    call hesse(fit,fcn)
    ier = 0
  endif
  call intoex(fit,fit%x)
  ! Store back results
  par(1:plast) = fit%u(1:plast)
  ! Compute rms
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  chi2tot = fit%amin
  rmstot = sqrt(fit%amin/npoints)
  fit%up = rmstot**2
  write(6,'(A)') '3rd step: Final minimization'
  call fitsky_print(fit)
  !
end subroutine fitsky
!
subroutine fitsky_print(fit)
  use telcal_interfaces, except_this=>fitsky_print
  use skydip_data
  use gkernel_interfaces
  use fit_minuit
  !---------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !  Display fitted values and RMS
  !---------------------------------------------------------------------
  type(fit_minuit_t), intent(inout) :: fit  ! Fitting variables
  ! Local
  integer :: i,l,imeas
  real*8 :: dx,al,ba,du1,du2
  !
  ! External Errors
  do i=1,fit%nu
    l = fit%lcorsp(i)
    if (l.eq.0)  then
      fit%werr(i)=0.
    else
      if (fit%isw(2).ge.1)  then
        dx = dsqrt(dabs(fit%v(l,l)*fit%up))
        if (fit%lcode(i).gt.1) then
          al = fit%alim(i)
          ba = fit%blim(i) - al
          du1 = al + 0.5d0 *(dsin(fit%x(l)+dx) +1.0d0) * ba - fit%u(i)
          du2 = al + 0.5d0 *(dsin(fit%x(l)-dx) +1.0d0) * ba - fit%u(i)
          if (dx.gt.1.0d0)  du1 = ba
          dx = 0.5d0 * (dabs(du1) + dabs(du2))
        endif
        fit%werr(i) = dx
      endif
    endif
  enddo
  !
  do imeas=1,nmeas
    if (trec_mode) then
      fit%werr(imeas) = fit%werr(imeas)/par(imeas)**2*chot_mean
      ! ZZZ to be checked in Trec mode
      par(imeas) = chot_mean/par(imeas) - skydip(imeas)%hot(1)%temp
      write(6,'(A,I2,A,F8.2,A,F7.2,A)')  &
        ' Trec[',imeas,'] (K): ',par(imeas),' (',fit%werr(imeas),')'
    else
      write(6,'(A,I2,A,F8.3,A,F7.3,A)')  &
        ' Feff[',imeas,']    : ',par(imeas),' (',fit%werr(imeas),')'
    endif
  enddo
  !
  ! Fitted water vapor
  write(6,'(A,F8.3,A,F7.3,A)')  &
    ' PWV (mm)    : ',par(ph2o),' (',fit%werr(ph2o),')'
  !
  ! Fitted Tloss
  if (tloss_mode) then
    write(6,'(A,F8.2,A,F7.2,A)')  &
      ' Tloss (K)   : ',par(ptloss),' (',fit%werr(ptloss),')'
  endif
  !
  ! RMS of residuals
  write(6,'(A,F8.5)') ' RMS of Residuals: ',rmstot
  !
  write(6,*)
  !
end subroutine fitsky_print
!
subroutine midsky(fit,ier,liter)
  use telcal_interfaces, except_this=>midsky
  use skydip_data
  use gkernel_interfaces
  use fit_minuit
  !----------------------------------------------------------------------
  ! @ private
  ! SKYDIP Internal routine
  !   Start a SKYDIP fit by building the PAR array and internal
  !    variable used by Minuit.
  !   Parameters are
  !    PAR(1:NMEAS) = FEFF Forward efficiencies
  !     or            TREC Receivers temperature (K)
  !    PAR(PH2O)    = H2OMM Water vapor amount (mm)
  !    PAR(PTLOSS)  = TLOSS (K)   (if fitted)
  !----------------------------------------------------------------------
  type(fit_minuit_t), intent(inout) :: fit    !
  integer,            intent(out)   :: ier    ! Error code
  logical,            intent(in)    :: liter  ! Iterate a fit
  ! Local
  integer :: ifatal
  integer :: ninte,k,imeas
  real(8) :: sav,sav2,vplu,vminu,value
  !
  ! Init the values
  ier = 0
  fit%isw = 0
  fit%npfix = 0
  ninte = 0
  fit%npar = 0
  ifatal = 0
  fit%u = 0.0d0
  fit%lcode = 0
  fit%lcorsp = 0
  fit%isw(5) = 1
  !
  ! Set up Parameters
  fit%nu=plast
  !
  ! Trec / Forward Efficiencies
  do imeas=1,nmeas
    fit%u(imeas) = par(imeas)
    if (trec_mode) then
      fit%werr(imeas) = abs(0.2*par(imeas))
      fit%lcode(imeas) = 1
    else
      fit%werr(imeas) = 0.01
      fit%alim(imeas) = 0.30  ! Lower limit
      fit%blim(imeas) = 1.00  ! Upper limit
      fit%lcode(imeas) = 0    ! ZZZ Check this
    endif
  enddo
  !
  ! Water Vapor
  fit%u(ph2o) = par(ph2o)
  fit%werr(ph2o) = max(0.2,0.1*par(ph2o))
  fit%alim(ph2o) = 0.0   ! Lower limit (no water)
  fit%blim(ph2o) = 20.0  ! Upper limit
  !
  ! Tloss (if fitted)
  if (tloss_mode) then
    fit%u(ptloss) = par(ptloss)
    fit%werr(ptloss) = 0.1    ! ZZZ Check
    fit%alim(ptloss) = 0.0    ! Lower limit
    fit%blim(ptloss) = 500.0  ! Upper limit
  endif
  !
  ! Various checks
  do k=1,fit%nu
    if (k.gt.fit%maxext)  then
      ifatal = ifatal + 1
      cycle ! k
    endif
    ! Fixed parameter
    if (fit%werr(k) .le. 0.0d0)  then
      fit%lcode(k) = 0
      write(6,1010) k,' is fixed'
      cycle ! k
    endif
    ! Variable parameter
    ninte = ninte + 1
    if (fit%lcode(k).eq.1)  cycle ! k
    fit%lcode(k) = 4
    value = (fit%blim(k)-fit%u(k))*(fit%u(k)-fit%alim(k))
    if (value.lt.0.0d0) then
      ifatal = ifatal+1
      write (fit%isyswr,1011) k
    elseif (value.eq.0.0d0) then
      write(6,1010) k,' is at limit'
    endif
  enddo
  !
  ! End parameter cards
  ! Stop if fatal error
  if (ninte .gt. fit%maxint)  then
    write (fit%isyswr,1008)  ninte,fit%maxint
    ifatal = ifatal + 1
  endif
  if (ninte .eq. 0) then
    write (fit%isyswr,'(A)') ' All input parameters are fixed'
    ifatal = ifatal + 1
  endif
  if (ifatal .gt. 0)  then
    write (fit%isyswr,1013)  ifatal
    ier = 2
    return
  endif
  !
  ! O.K. Start
  ! Calculate step sizes DIRIN
  fit%npar = 0
  do k= 1, fit%nu
    if (fit%lcode(k) .gt. 0)  then
      fit%npar = fit%npar + 1
      fit%lcorsp(k) = fit%npar
      sav = fit%u(k)
      fit%x(fit%npar) = pintf(fit,sav,k)
      fit%xt(fit%npar) = fit%x(fit%npar)
      sav2 = sav + fit%werr(k)
      vplu = pintf(fit,sav2,k) - fit%x(fit%npar)
      sav2 = sav - fit%werr(k)
      vminu = pintf(fit,sav2,k) - fit%x(fit%npar)
      fit%dirin(fit%npar) = 0.5d0 * (dabs(vplu) +dabs(vminu))
    endif
  enddo
  return
  !
1008 format(' Too many variable parameters.  You request ',i5/,  &
            ' This version of MINUIT is only dimensioned for ',i4)
1010 format(' Warning - Parameter ',i2,' ',a)
1011 format(' Error - Parameter ',i2,' outside limits')
1013 format(1x,i3,' Errors on input parameters. ABORT.')
end subroutine midsky
!
subroutine minsky(npar,grad,chi2,params,iflag)
  use telcal_interfaces, except_this=>minsky
  use skydip_data
  !----------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! SKYDIP Internal routine
  !   Function to be minimized in the SKYDIP.
  !----------------------------------------------------------------------
  integer, intent(in)  :: npar          ! Number of parameters
  real(8), intent(out) :: grad(npar)    ! Array of derivatives
  real(8), intent(out) :: chi2          ! Chi**2
  real(8), intent(in)  :: params(npar)  ! Parameter values
  integer, intent(in)  :: iflag         ! Code operation
  ! Local
  real*8 :: airmas
  real*8 :: yy,dist
  real*8, allocatable :: dy(:),dy_sqsum(:)
  logical :: dograd
  integer :: ier,imeas,ipoint,ipar
  !
  chi2 = 0.0d0
  dograd = iflag.eq.2
  allocate(dy(npar),dy_sqsum(npar),stat=ier)
  if (ier.ne.0) then
    call gagout('E-MINSKY, Error allocating dy / dy_sqsum')
    return
  endif
  dy_sqsum = 0.d0
  !
  ! Compute function and derivative
  do imeas=1,nmeas
    do ipoint=1,skydip(imeas)%nsky
      !
      call fsky(imeas,skydip(imeas)%elev(ipoint),params,dograd,airmas,yy,dy)
      !
      ! Compute chi**2
      if (trec_mode) then
        dist = yy - sky(ipoint,imeas)
      else
        dist = yy - temi(ipoint,imeas)
      endif
      chi2 = chi2 + dist**2
      !
      if (.not.dograd) cycle  ! ipoint
      !
      ! Compute Gradients
      do ipar=1,npar
        dy_sqsum(ipar) = dy_sqsum(ipar) + 2.0*dist*dy(ipar)
      enddo
      !
    enddo  ! ipoint
    !
  enddo  ! imeas
  !
  ! Setup values and return
  do ipar=1,npar
    grad(ipar) = dy_sqsum(ipar)
  enddo
  !
  deallocate(dy,dy_sqsum)
  !
end subroutine minsky
!
subroutine fsky(inmeas,eleva,params,dograd,airmas,yy,dy)
  use phys_const
  use skydip_data
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument rank mismatch)
  ! SKYDIP Internal routine
  !   Compute sky emission
  !  params(1:nmeas) : Trec
  !       or           Feff (depending on mode, one for each skydips set)
  !  params(ph2o)    : H2O [mm]
  !  params(ptloss)  : Tloss [K]  (if fitted)
  ! Computations are made with double precision floats because of very low
  ! angles (airmass) and sensible exponents (tsky) in this problem.
  !----------------------------------------------------------------------
  integer, intent(in)  :: inmeas     ! Skydip number in use
  real(8), intent(in)  :: eleva      ! Elevation in degrees
  real(8), intent(in)  :: params(*)  ! Values of parameters
  logical, intent(in)  :: dograd     ! Compute the gradient
  real(8), intent(out) :: airmas     ! Number of airmasses
  real(8), intent(out) :: yy         ! Emissivity (Kelvins)
  real(8), intent(out) :: dy(*)      ! Derivate value according to each parameter
  ! Local
  real(8) :: eps,gamma,hz
  real(8), parameter :: h0=5.5d0     ! Atmospheric scale height
  real(8), parameter :: r0=6370.0d0  ! Earth radius
  real(8) :: tsky,           dw_tsky
  real(8) :: tsky_s,e_tsky_s,dw_tsky_s,taus_tot
  real(8) :: tsky_i,e_tsky_i,dw_tsky_i,taui_tot
  real(8) :: zz,tloss
  integer :: imeas
  !
  ! Curved atmosphere, equivalent height 5.5 KM
  eps = asin(r0/(r0+h0)*cos(eleva))
  gamma = 0.5*pi-eleva-eps
  hz = r0*r0 + (r0+h0)**2 - 2.*r0*(r0+h0)*cos(gamma)
  hz = sqrt(max(hz,h0**2))     ! Avoid floating point errors
  airmas = hz/h0
  !
  ! Tsky (signal frequency component)
  taus_tot = params(ph2o) * atm(inmeas)%taus%wat + atm(inmeas)%taus%oth
  e_tsky_s = exp(-airmas * taus_tot)
  tsky_s = atm(inmeas)%temp%s * (1. - e_tsky_s)
  !
  ! Tsky (image frequency component)
  taui_tot = params(ph2o) * atm(inmeas)%taui%wat + atm(inmeas)%taui%oth
  e_tsky_i = exp(-airmas * taui_tot)
  tsky_i = atm(inmeas)%temp%i * (1. - e_tsky_i)
  !
  ! Tsky (total) from paragraph 3.5, Memo II
  tsky  = (tsky_s + tsky_i*rec(inmeas)%sbgr) / (1. + rec(inmeas)%sbgr)
  !
  if (trec_mode) then
    ! ZZZ to be checked in Trec mode
    zz = tamb-skydip(1)%hot(1)%temp + rec(inmeas)%feff*(tsky-tamb)
    yy = params(inmeas) * zz
  else
    if (tloss_mode) then
      tloss = params(ptloss)
    else
      ! Tloss = alpha*Tcab + (1-alpha)*Tamb
      tloss = tamb  ! Approx
    endif
    ! Temi = Feff*Tsky + (1-Feff)*Tloss
    yy = params(inmeas)*tsky + (1.-params(inmeas))*tloss
  endif
  !
  if (.not.dograd) return
  !
  dw_tsky_s = atm(inmeas)%temp%s * atm(inmeas)%taus%wat * e_tsky_s * airmas
  dw_tsky_i = atm(inmeas)%temp%i * atm(inmeas)%taui%wat * e_tsky_i * airmas
  dw_tsky = (dw_tsky_s + dw_tsky_i*rec(inmeas)%sbgr) / (1.+rec(inmeas)%sbgr)
  !
  ! Partial derivate on other params (Trec's/Feff's)
  do imeas=1,nmeas
    if (imeas.ne.inmeas) then
      dy(imeas) = 0.d0  ! No cross-dependency of the different Trec's/Feff's !
    elseif (trec_mode) then
      ! ZZZ to be checked in Trec mode
      dy(imeas) = zz
    else
      dy(imeas) = tsky - tamb
    endif
  enddo
  !
  ! Partial derivate on H2Omm
  if (trec_mode) then
    dy(ph2o) = params(inmeas)*rec(inmeas)%feff*dw_tsky
  else
    dy(ph2o) = params(inmeas)*dw_tsky
  endif
  !
  ! Partial derivate on Tloss (if fitted)
  if (tloss_mode) then
    ! dy/dtloss = 1-Feff
    dy(ptloss) = 1-params(inmeas)
  endif
  !
end subroutine fsky
