subroutine solve_skydip(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !	Support routine for command
  !	SOLVE SKYDIP [TREC|EFF] [/PLOT] [/OUTPUT File [NEW]]
  !	[/Store /Reset /Offset /Closure /Search] Not relevant here
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'clic_display.inc'
  include 'clic_dheader.inc'
  include 'gbl_pi.inc'
  include 'clic_skydip.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: plot, output, end
  character(len=132) :: ch, chain
  character(len=80) :: snam,filnam
  integer(kind=address_length) :: data_in, kin
  integer(kind=data_length)    :: ldata_in
  integer :: p_lun, ier, j, nsky, nch
  real :: c_cal(mnant),c_sky(mnant,mp), elev(mp), elcal
  real :: c_chop(mnant)
  character(len=2) :: argum
  integer(kind=entry_length) :: sky_num
  integer :: p_skydip, sky_scan
  parameter (p_skydip=6)
  save sky_num, sky_scan
  !
  integer :: mvoc2,  mvoc1, nkey, iinput, ninput
  parameter (mvoc1=2, mvoc2=2)
  character(len=12) :: kw, voc1(mvoc1), voc2(mvoc2)
  data voc1/'NEW','OLD'/
  data voc2/'EFFICIENCY','TREC'/
  !------------------------------------------------------------------------
  ! Code:
  call check_input_file(error)
  if (error) goto 999
  call check_index(error)
  if (error) goto 999
  plot = sic_present(1,0)
  output = sic_present(3,0)
  if (output) then
    call sic_ch(line,3,1,snam,nch,.true.,error)
    if (error) goto 999
    ch = 'NEW'
    call sic_ke(line,3,2,ch,nch,.false.,error)
    if (error) goto 999
    call sic_ambigs('SOLVE SKYDIP',ch,kw,nkey,voc1,mvoc1,error)
    if (error) goto 999
    call sic_parsef(snam,filnam,' ','.lis')
    ier = sic_getlun (p_lun)
    if (kw.eq.'NEW') then
      ier = sic_open (p_lun,filnam,'NEW',.false.)
    else
      ier = sic_open (p_lun,filnam,'UNKNOWN',.false.)
    endif
    if (ier.ne.0) then
      call message(6,3,'SOLVE_SKYDIP',   &
        'Cannot open file '//filnam)
      call putios ('        ',ier)
      error = .true.
      call sic_frelun(p_lun)
      return
    endif
    call message(8,2,'SOLVE_SKYDIP',   &
      'Option /OUTPUT not implemented')
  endif
  !
  ! Get mode (solve for TREC or EFF)
  argum = 'EFF'
  call sic_ke(line,0,2,argum,nch,.false.,error)
  if (error) goto 999
  call sic_ambigs('SOLVE SKYDIP',argum,kw,nkey,voc2,mvoc2,error)
  if (error) goto 999
  if (kw.eq. 'TREC') then
    trec_mode   = .true.
  elseif (kw.eq. 'EFFICIENCY') then
    trec_mode = .false.
  endif
  !
  call get_first(.true.,error)
  ninput = r_nbb
  if (error) goto 999
  !
  ! Check if a valid narrow input has been selected
  if (.not.bb_select.and.n_baseband.ne.1.and.l_baseband(1).ne.1) then
    call show_display('BBAND',.false.,error)
    write(chain,'(A)')   &
      'Select a single baseband using SET BBAND command'
    call message(6,3,'SOLVE_RF',chain)
    error = .true.
    return
  else
    iinput = i_baseband(1,1)
  endif
  end = .false.
  nsky = 0                     ! number of sky measurements
  elcal = 0                    ! no cal yet
  do while (.not.end)
    error = .false.
    if (r_proc.ne.p_skydip) then
      call message(8,2,'SOLVE_SKYDIP', 'Scan ignored')
    !
    ! Calibration Scan
    elseif (r_scaty.eq.4) then ! Calibration
      call get_data (ldata_in,data_in,error)
      if (error) goto 200
      kin = gag_pointer(data_in,memory) + r_ndump*r_ldump
      call decode_header (memory(kin))
      kin = kin + r_ldpar
      call load_auto (memory(kin), c_cal(1), iinput, error)
      if (error) goto 200
      elcal = r_el*180./pi +dh_offbet(1)/3600.
    !
    ! Sky scan
    elseif (r_scaty.eq.5 .and. elcal.gt.0) then
      call get_data (ldata_in,data_in,error)
      if (error) goto 200
      nsky = nsky + 1
      kin = gag_pointer(data_in,memory) + r_ndump*r_ldump
      call decode_header (memory(kin))
      kin = kin + r_ldpar
      call load_auto (memory(kin), c_sky(1,nsky), iinput, error)
      if (error) goto 200
      elev(nsky) = 180.*r_el/pi+dh_offbet(1)/3600.
      if (abs(elcal-elev(nsky)) .lt. 0.1) then
        do j = 1, r_nant
          if (r_ceff(iinput,j).gt.0.) then
            c_chop(j) = (c_cal(j)-(1-r_ceff(iinput,j))*c_sky(j   &
              ,nsky))/ r_ceff(iinput,j)
          else
            c_chop(j) = c_cal(j)
          endif
        enddo
      endif
      do j=1, r_nant
        if (trec_mode) then
          c_sky(j,nsky) = (c_sky(j,nsky)-c_chop(j))/c_chop(j)
        else
          c_sky(j,nsky) = (r_tchop(iinput,j)+r_trec(iinput,j))   &
            *c_sky(j,nsky)/c_chop(j) - r_trec(iinput,j)
        endif
      enddo
    endif
    !
    ! Save header here
    sky_num = r_xnum
    sky_scan = r_scan
200 error = .false.
    call get_next(end, error)
    if (error) goto 999
    ! If scan changed, move
    if ((end.or.sky_scan.ne.r_scan) .and. nsky.gt.4) then
      call get_num(sky_num,error)
      call sub_skydip (plot,output,p_lun,nsky,c_sky,elev,iinput,error)
      if (error) goto 999
      nsky = 0                 ! number of sky measurements
      elcal = 0                ! no cal yet
    endif
  enddo
  goto 998
  !
999 error = .true.
998 if (output) then
    close(unit=p_lun)
    call sic_frelun(p_lun)
  endif
end subroutine solve_skydip
!
subroutine load_auto (data, auto_data, iinput, error)
  use gildas_def
  use classic_api  
  !---------------------------------------------------------------------
  ! CLIC 	read a data record for SKYDIP
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  real :: data(*)                   !
  real :: auto_data(mnant)          !
  integer :: iinput                 !
  logical :: error                  !
  ! Global
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: ia, ic, iy, k, jc
  real :: w, my_total2
  !------------------------------------------------------------------------
  ! Code:
  call check_subb(1,.true.,error)
  if (error) goto 999
  iy = i_y(1)
  k = 1
  if (iy.eq.79) then           ! continuum detectors ...
    ! we take ther requested total power...
    do ia=1, r_nant
      auto_data(ia) = my_total2(iinput,ia,error)   !! DH_TOTAL(IA)
    enddo
  else                         ! (auto) correlators  ...
    do ia=1, r_nant
      auto_data(ia) = 0
      w = 0
      do jc = 1, k_subb(1)
        ic = i_subb(jc,1)
        auto_data(ia) = auto_data(ia) + data(k)*r_cfwid(ic)
        w = w + r_cfwid(ic)
        k = k + 1
      enddo
      auto_data(ia) = auto_data(ia) / w
    enddo
  endif
  return
999 error = .true.
  return
end subroutine load_auto
!
subroutine sub_skydip (plot,out,iout,nel,c_sky,c_el,iinput,error)
  use gkernel_interfaces
  use atm_interfaces_public
  use classic_api
  !---------------------------------------------------------------------
  ! Call Tree
  !	SOLVE_SKYDIP
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  logical :: plot                   !
  logical :: out                    !
  integer :: iout                   !
  integer :: nel                    !
  real :: c_sky(mnant,nel)          !
  real :: c_el(nel)                 !
  integer :: iinput
  logical :: error                  !
  ! Global
  include 'clic_par.inc'
  include 'clic_skydip.inc'
  include 'gbl_pi.inc'
  include 'clic_clic.inc'
  include 'clic_fit.inc'
  ! Local
  real :: temi, freqsi, freqim, err1(mnant),err2(mnant)
  integer :: ier, i, j, n
  external :: minsky
  character(len=1) :: answer
  character(len=132) :: ch
  character(len=28) :: mess(3)
  character(len=64) :: cbox(mnant)
  integer :: dummy
  ! Data
  data mess /'Zero atmospheric opacity',   &
    'No oxygen in atmosphere',   &
    'No water in atmosphere'/
  !------------------------------------------------------------------------
  ! Code:
  !
  if (atm_interpolate) then
    call atm_atmosp_i (r_tamb,r_pamb,r_alti)   ! press at ALTI
  else
    call atm_atmosp (r_tamb,r_pamb,r_alti)   ! press at ALTI
  endif
  freqsi = 1d-3*(r_flo1 + r_isb*r_fif1)    ! signal side band
  freqim = 1d-3*(r_flo1 - r_isb*r_fif1)    ! image side band
  if (plot) then
    call gtclear
    call skydip_boxes(r_nant,cbox,error)
    write (ch,1002) r_scan, freqsi, freqim,   &
      r_az*180.d0/pi,'" 8 /BOX 8'
    call gr_exec(ch(1:lenc(ch)))
  endif
  do j=1, r_nant
    tausig = r_taus(iinput,j)
    atmsig = r_tatms(iinput,j)
    tauima = r_taui(iinput,j)
    atmima = r_tatmi(iinput,j)
    if (atm_interpolate) then
      call atm_transm_i (r_h2omm(iinput,j),1.,freqsi,temi,atmsig,   &
        tauoxs,tauws,tausig,ier)
      if (ier.ne.0) call message   &
        (6,3,'SUB_SKYDIP','Stupid calibration '//mess(ier))
      call atm_transm_i (r_h2omm(iinput,j),1.,freqim,temi,atmima,   &
        tauoxi,tauwi,tauima,ier)
      if (ier.ne.0) call message   &
        (6,3,'SUB_SKYDIP','Stupid calibration '//mess(ier))
    else
      call atm_transm (r_h2omm(iinput,j),1.,freqsi,temi,atmsig,   &
        tauoxs,tauws,tausig,ier)
      if (ier.ne.0) call message   &
        (6,3,'SUB_SKYDIP','Stupid calibration '//mess(ier))
      call atm_transm (r_h2omm(iinput,j),1.,freqim,temi,atmima,   &
        tauoxi,tauwi,tauima,ier)
      if (ier.ne.0) call message   &
        (6,3,'SUB_SKYDIP','Stupid calibration '//mess(ier))
    endif
    !
    tamb   = r_tamb
    tchop  = r_tchop(iinput,j)
    feff   = r_feff(iinput,j)
    gainim = r_gim(iinput,j)
    np = nel
    do i=1, nel
      sky(i) = c_sky(j,i)
      el(i) = c_el(i)*pi/180.
    enddo
    if (trec_mode) then
      par(1) = 1./(0.9*r_trec(iinput,j)   &
        +r_tchop(iinput,j))
    endif
    !
    ! Minimize
    call fitsky(minsky,.false.,ier,1.)
    if (ier.ne.0) call message   &
      (6,2,'SUB_SKYDIP','Solution not converged')
    !
    ! Store results
    if (trec_mode) then
      r_trec(iinput,j) = par(1)
    else
      r_feff(iinput,j) = par(1)
    endif
    err1(j) = werr(1)
    err2(j) = werr(2)
    r_h2omm(iinput,j) = par(2)
    ! more accurate when other stuff is included
    ! (do not assume there is only water and oxygen)
    !
    r_taus(iinput,j) = tausig-tauws  +   &
      r_h2omm(iinput,j) * tauws
    r_taui(iinput,j) = tauima-tauwi  +   &
      r_h2omm(iinput,j) * tauwi
    r_tatms(iinput,j) = atmsig
    r_tatmi(iinput,j) = atmima
    ! Display results
    write(ch,*) 'Antenna ',r_kant(j) ,' results :'
    call message(6,1,'SOLVE_SKYDIP',ch(1:lenc(ch)))
    call message(6,1,'SOLVE_SKYDIP',   &
      ' Trec       Tchopper     Tcold')
    write(ch,'(3F10.1)') r_trec(iinput,j),   &
      r_tchop(iinput,j), r_tcold(iinput,j)
    call message(6,1,'SOLVE_SKYDIP',ch(1:lenc(ch)))
    call message(6,1,'SOLVE_SKYDIP',   &
      '   Az      Tamb    Pamb    Humidity '   &
      //'Water  Feff    Rms(K)')
    write(ch,'(7f8.2)') r_az*180./pi, r_tamb,   &
      r_pamb, r_humid, r_h2omm(iinput,j),   &
      r_feff(iinput,j), sigrms
    call message(6,1,'SOLVE_SKYDIP',ch(1:lenc(ch)))
    call message(6,1,'SOLVE_SKYDIP',   &
      '                  '//   &
      'Freq     Tau      O2       H2O      Tatm')
    write(ch,'(a,4F9.3,f9.2)') 'Signal band: ',   &
      freqsi, r_taus(iinput,j), tauoxs,   &
      tauws*r_h2omm(iinput,j), r_tatms(iinput,j)
    call message(6,1,'SOLVE_SKYDIP',ch(1:lenc(ch)))
    write(ch,'(a,4F9.3,f9.2)') ' Image band: ',   &
      freqim, r_taui(iinput,j), tauoxi,   &
      tauwi*r_h2omm(iinput,j), r_tatmi(iinput,j)
    call message(6,1,'SOLVE_SKYDIP',ch(1:lenc(ch)))
    !
    if (plot) then
      call gr_exec(cbox(j))
      call plot_skydip(r_kant(j),r_trec(iinput,j),   &
        r_h2omm(iinput,j), r_feff(iinput,j))
    endif
  enddo
  ! Return error bars on parameter in SIC variables
  if (trec_mode) then
    call sic_delvariable('ERR_TREC',.false.,error)
    call sic_def_real('ERR_TREC',err1,1,r_nant,   &
      .false.,error)
  else
    call sic_delvariable('ERR_FEFF',.false.,error)
    call sic_def_real('ERR_FEFF',err1,1,r_nant,   &
      .false.,error)
  endif
  call sic_delvariable('ERR_H2O',.false.,error)
  call sic_def_real('ERR_H2O',err2,1,r_nant,.false.,error)
  !
  if (plot) then
    if (sic_inter_state(dummy)) then
      answer = ' '
      call sic_wprn('W-SOLVE_SKYDIP, '//   &
        'Press H for Hardcopy, Return to continue',   &
        answer,n)
      call sic_blanc(answer,n)
      if (answer(1:1) .eq. 'H')   &
        call gr_exec( 'HARDCOPY /PRINT')
    endif
  endif
  return
  !
error = .true.
  return
1002 format('DRAW TEXT 0 0 "',i4,'; Signal ',f10.3,   &
    '; Image ',f10.3,' Azimut ',f6.1,a)
end subroutine sub_skydip
!
subroutine plot_skydip(iant,trec,h2o,f_eff)
  use gkernel_interfaces
  integer :: iant                   !
  real :: trec                      !
  real :: h2o                       !
  real :: f_eff                     !
  ! Global
  include 'clic_skydip.inc'
  include 'gbl_pi.inc'
  ! Local
  character(len=80) :: chain
  real :: eps, gamma, hz, ts, tsi, tss, etss, etsi
  real :: xxx, xx(100), yy(100), xxmin, xxmax
  real :: h0,r0
  parameter (h0=5.5,r0=6370.0)
  integer :: i
  logical :: err
  !------------------------------------------------------------------------
  ! Code:
  err = .false.
  xxmin = 100
  xxmax = -100
  do i=1, np
    xxx = el(i)                ! Elevation in radians
    eps = asin(r0/(r0+h0)*cos(xxx))
    gamma = 0.5*pi-xxx-eps
    hz = r0*r0 + (r0+h0)**2 - 2.*r0*(r0+h0)*cos(gamma)
    hz = sqrt(max(hz,h0**2))   ! Avoid floating point errors
    xx(i) = hz/h0              ! the air mass content
    xxmin = min(xxmin,xx(i))
    xxmax = max(xxmax,xx(i))
    if (trec_mode) then
      yy(i) = tchop*(sky(i)+1)
    else
      yy(i) = sky(i)
    endif
  enddo
  call gr4_give('X',np,xx)
  call gr4_give('Y',np,yy)
  call gr_exec1('LIMITS')
  call gr_exec1('BOX')
  call gr_exec1('POINTS')
  call gr_segm ('FIT',err)
  ! Plot fitted curve
  do i=1,100
    xx(i) = xxmin+(i-5.)*(xxmax-xxmin)/90.
    etss = exp(-xx(i)*(par(2)*tauws + tausig-tauws))
    tss = atmsig * (1. - etss)
    etsi = exp(-xx(i)*(par(2)*tauwi + tauima-tauwi))
    tsi = atmima * (1. - etsi)
    ts  = (tss + tsi*gainim) / (1. + gainim)
    if (trec_mode) then
      yy(i) =  tchop/(par(1)+tchop) *   &
        (tamb +par(1) + feff*(ts-tamb))
    else
      yy(i)  = par(1)*ts + (1.-par(1)) * tamb
    endif
  enddo
  call gr4_connect (100,xx,yy,0.0,-1.0)
  call gr_segm_close(err)
  call gr_exec1('LABEL "Air masses" /X')
  call gr_exec1('DRAW TEXT -4 0 "Emission" 5 90 /CHAR 4')
  write(chain,'(A,I2,A,F7.2)') 'Antenna ',iant,   &
    ' : H'//char(92)//'d2O ',h2o
  call gr_exec1('DRAW TEXT  1 -1.5 "'   &
    //chain(1:lenc(chain))//'" 9 /CHAR 7')
  write(chain,'(A,F6.1,A,F6.3)') 'Trec ',trec,';  Feff ',f_eff
  call gr_exec1('DRAW TEXT -1 1.5 "'   &
    //chain(1:lenc(chain))//'" 7 /CHAR 3')
  return
end subroutine plot_skydip
!
subroutine fitsky (fcn,liter,ier,meancho)
  !---------------------------------------------------------------------
  ! RED	Internal routine
  !	Setup and starts a SKYDIP fit minimisation using MINUIT
  ! Arguments :
  !	FCN	Ext.	Function to be mininized	Input
  !	LITER	L	Logical of iterate fit		Input
  !	IER	L	Logical error flag		Output
  ! Created	S.Guilloteau 	5-Nov-1986
  !---------------------------------------------------------------------
  external :: fcn                   !
  logical :: liter                  !
  integer :: ier                    !
  real :: meancho                   !
  ! Global
  include 'clic_fit.inc'
  include 'clic_skydip.inc'
  ! Local
  integer :: i,l
  real :: tau,a1,ap,a2
  real*8 :: dx, al, ba, du1, du2
  ! Code	----------------------------------------------------------------------
  !
  ! Added error Patch for Initialisation
  ier = 0
  isysrd=5
  isyswr=6
  isyspu=7
  maxext=ntot
  maxint=nvar
  !
  ! Initialise values
  ! Note : should put TCABIN instead of OBsTAM...
  a1 = 1./sin(el(1))
  a2 = 1./sin(el(2))
  ap = 1./sin(el(np))
  if (trec_mode) then
    tau = (sky(2)-sky(1))/par(1)/(a2-a1)/(atmsig+gainim*atmima)   &
      * (1+gainim)
    par(2) = max( (tau-tausig+tauws)/tauws,   &
      (tau-tauima+tauwi)/tauwi )
    par(2) = min(20.,max(0.,par(2)))
  else
    par(1) = 1. - (a1*sky(2) - a2*sky(1))/tamb/(a1-a2)
    par(1) = min(1.,max(0.,par(1)))
    tau = (sky(2)-sky(1))/par(1)/(a2-a1)/(atmsig+gainim*atmima)   &
      * (1+gainim)
    par(2) = max( (tau-tausig+tauws)/tauws,   &
      (tau-tauima+tauwi)/tauwi )
    par(2) = min(20.,max(0.,par(2)))
  endif
  par(2) = max(1.0,par(2))
  !
  call midsky (ier,liter)
  if (ier.ne.0) return
  call clic_intoex(x)
  nfcnmx  = 10000
  newmin  = 0
  itaur  = 0
  isw(1)  = 0
  isw(3)  = 1
  nfcn = 1
  vtest  = 0.04
  call fcn(npar,g,amin,u,1)
  sigrms = sqrt(amin/np)
  up = sigrms**2
  epsi  = 0.1d0 * up
  !
  ! Simplex Minimization
  if (.not.liter) then
    call clic_simplx(fcn,ier)
    par(1) = u(1)
    par(2) = u(2)
    if (ier.ne.0) return
  endif
  !
  ! Gradient Minimization
  call clic_intoex(x)
  call fcn(npar,g,amin,u,3)
  sigrms  = sqrt(amin/np)
  write(isyswr,1002) sigrms
  up = sigrms**2
  epsi  = 0.1d0 * up
  apsi  = epsi
  call clic_hesse(fcn)
  call clic_migrad(fcn,ier)
  call clic_intoex(x)
  call fcn(npar,g,amin,u,3)
  sigrms  = sqrt(amin/np)
  up = sigrms**2
  epsi  = 0.1d0 * up
  apsi  = epsi
  ier = 0
  call clic_migrad(fcn,ier)
  !
  ! Iterate once if not converged
  if (ier.eq.3) then
    ier = 0
    call clic_migrad(fcn,ier)
  endif
  !
  ! Compute covariance matrix if bad
  if (ier.eq.1) then
    call clic_hesse(fcn)
    ier = 0
  endif
  !
  ! Print Results
  call clic_intoex(x)
  call fcn(npar,g,amin,u,3)
  sigrms = sqrt(amin/np)
  write(isyswr,1002) sigrms
  up  = sigrms**2
  !
  ! Calculate External Errors
  do 10 i=1,nu
    l  = lcorsp(i)
    if (l .eq. 0)  then
      werr(i)=0.
    else
      if (isw(2) .ge. 1)  then
        dx = dsqrt(dabs(v(l,l)*up))
        if (lcode(i) .gt. 1) then
          al = alim(i)
          ba = blim(i) - al
          du1 = al + 0.5d0 *(dsin(x(l)+dx) +1.0d0) * ba - u(i)
          du2 = al + 0.5d0 *(dsin(x(l)-dx) +1.0d0) * ba - u(i)
          if (dx .gt. 1.0d0)  du1 = ba
          dx = 0.5d0 * (dabs(du1) + dabs(du2))
        endif
        werr(i) = dx
      endif
    endif
10 continue
  !
  par(1) = u(1)
  par(2) = u(2)
  if (trec_mode) then
    werr(1) = werr(1)/par(1)**2*meancho
    par(1) = meancho/par(1) - tchop
    write (isyswr,1004)
    write (isyswr,1003) par(1),werr(1),par(2),werr(2)
  else
    write (isyswr,1001)
    write (isyswr,1000) par(1),werr(1),par(2),werr(2)
  endif
  return
  !
1000 format (4x,f9.3,' (',f8.3,')    ',f10.3,' (',f8.3,')')
1001 format (/,'	SKYDIP Fit Results   ',//,   &
    ' Forward Efficiency        Water vapor (mm) ')
1002 format (' RMS of Residuals : ',1pg10.3)
1003 format (4x,f9.2,' (',f8.2,')    ',f10.3,' (',f8.3,')')
1004 format (/,'	SKYDIP Fit Results   ',//,   &
    ' Trec                      Water vapor (mm) ')
end subroutine fitsky
!
subroutine midsky (ier,liter)
  !---------------------------------------------------------------------
  ! RED	Internal routine
  !	Start a SKYDIP fit by building the PAR array and internal
  !	variable used by Minuit.
  ! 	Parameters are
  !	PAR(1)	= RFOEFF	Forward efficiency
  !	or	  RTREC		Receiver temperature
  !	PAR(2)	= RH2OMM	Water vapor amount (mm)
  !
  ! Arguments
  !	IER	I	Error code 			Output
  !	LITER	L	Iterate a fit			Input
  !
  ! S.Guilloteau 16-Feb-1987
  !---------------------------------------------------------------------
  integer :: ier                    !
  logical :: liter                  !
  ! Global
  include 'clic_fit.inc'
  include 'clic_skydip.inc'
  ! Local
  integer :: ifatal
  integer :: i, ninte, k
  real*8 :: sav, clic_pintf, sav2, vplu, vminu, value
  ! Code	----------------------------------------------------------------------
  ier = 0
  do 10 i= 1, 7
    isw(i) = 0
10 continue
  npfix = 0
  ninte = 0
  nu = 2
  npar = 0
  ifatal = 0
  do 20 i= 1, maxext
    u(i) = 0.0d0
    lcode(i) = 0
    lcorsp (i) = 0
20 continue
  isw(5) = 1
  !
  ! Set up Parameters
  nu=2
  !
  ! Forward Efficiency
  u(1) = par(1)
  if (trec_mode) then
    werr(1) = abs(0.2*par(1))
    lcode(1) = 1
  else
    werr(1) = 0.1              ! 0.04
    alim(1) = 0.45             ! 0.60
    blim(1) = 1.00
    lcode(1) = 0
  endif
  !
  ! Water Vapor
  u(2) = par(2)
  werr(2) = max(2.0,0.2*par(2))
  alim(2) = 0.0                ! No water
  blim(2) = 30.0               ! in mm...
  lcode(2) = 0
  !
  ! Various checks
  do 30 k=1,nu
    if (k.gt.maxext)  then
      ifatal = ifatal + 1
      goto 30
    endif
    ! Fixed parameter
    if (werr(k) .le. 0.0d0)  then
      lcode(k) = 0
      write(6,1010) k,' is fixed'
      goto 30
    endif
    ! Variable parameter
    ninte = ninte + 1
    if (lcode(k).eq.1) goto 30
    lcode(k) = 4
    value = (blim(k)-u(k))*(u(k)-alim(k))
    if (value.lt.0.0d0) then
      ifatal = ifatal+1
      write (isyswr,1011) k
    elseif (value.eq.0.0d0) then
      write(6,1010) k,' is at limit'
    endif
30 continue
  !
  ! End parameter cards
  ! Stop if fatal error
  if (ninte .gt. maxint)  then
    write (isyswr,1008)  ninte,maxint
    ifatal = ifatal + 1
  endif
  if (ninte .eq. 0) then
    write (isyswr,1009)
    ifatal = ifatal + 1
  endif
  if (ifatal .gt. 0)  then
    write (isyswr,1013)  ifatal
    ier = 2
    return
  endif
  !
  ! O.K. Start
  ! Calculate step sizes DIRIN
  npar = 0
  do 40 k= 1, nu
    if (lcode(k) .gt. 0)  then
      npar = npar + 1
      lcorsp(k) = npar
      sav = u(k)
      x(npar) = clic_pintf(sav,k)
      xt(npar) = x(npar)
      sav2 = sav + werr(k)
      vplu = clic_pintf(sav2,k) - x(npar)
      sav2 = sav - werr(k)
      vminu = clic_pintf(sav2,k) - x(npar)
      dirin(npar) = 0.5d0 * (dabs(vplu) +dabs(vminu))
    endif
40 continue
  return
  !
1008 format (' Too many variable parameters.  You request ',i5/,   &
    ' This version of MINUIT is only dimensioned for ',i4)
1009 format (' All input parameters are fixed')
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,g,f,x,iflag)
  !---------------------------------------------------------------------
  ! RED	Internal routine
  !	Function to be minimized in the SKYDIP.
  ! Arguments :
  !	NPAR	I	Number of parameters		Input (2)
  !	G	R*8(1)	Array of derivatives		Output
  !	F	R*8	Function value			Output
  !	X	R*8(1)	Parameter values		Input
  !	IFLAG	I	Code operation			Input
  ! (5-mar-1985)
  !---------------------------------------------------------------------
  integer :: npar                   !
  real*8 :: g(*)                    !
  real*8 :: f                       !
  real*8 :: x(*)                    !
  integer :: iflag                  !
  ! Global
  include 'clic_skydip.inc'
  ! Local
  real :: pi
  parameter (pi=3.141592653)
  real :: eps, gamma, hz, ts, tsi, tss, etss, etsi, dwtss, dwtsi
  real :: dwts, dwyy, deyy, dwf, def, elev, xx, yy, ff, zz, h0, r0, fs
  real :: xh2o, xeff
  parameter (h0= 5.5,r0= 6370.0)
  logical :: dograd
  integer :: i
  !
  ! Code	----------------------------------------------------------------------
  fs = 0.0
  dwf = 0.0
  def = 0.0
  dograd = iflag.eq.2
  xh2o = x(2)
  xeff = x(1)
  !
  ! Compute function and derivative
  do i=1,np
    elev = el(i)               ! Elevation
    !
    !  Curved atmosphere, equivalent height 5.5 KM
    eps = asin(r0/(r0+h0)*cos(elev))
    gamma = 0.5*pi-elev-eps
    hz = r0*r0 + (r0+h0)**2 - 2.*r0*(r0+h0)*cos(gamma)
    hz = sqrt(max(hz,h0**2))   ! Avoid floating point errors
    xx = hz/h0                 ! the air mass content
    !
    etss = exp(-xx*(xh2o*tauws + tausig-tauws))
    tss = atmsig * (1. - etss)
    etsi = exp(-xx*(xh2o*tauwi + tauima-tauwi))
    tsi = atmima * (1. - etsi)
    ts  = (tss + tsi*gainim) / (1. + gainim)
    if (trec_mode) then
      zz = tamb-tchop + feff*(ts-tamb)
      yy = x(1)*zz
    else
      yy  = xeff*ts + (1.-xeff) * tamb
    endif
    !
    ! Compute CHI**2
    ff = yy - sky(i)
    fs = fs + ff*ff
    if (dograd) then
      !
      ! Compute Gradients
      dwtss = atmsig * tauws * etss * xx
      dwtsi = atmima * tauwi * etsi * xx
      dwts = (dwtss + dwtsi*gainim) / (1.+gainim)
      dwyy = xeff * dwts
      if (trec_mode) then
        dwyy = dwyy*feff
        deyy = zz
      else
        deyy = ts - tamb
      endif
      dwf = dwf + 2.0*ff*dwyy
      def = def + 2.0*ff*deyy
    endif
  !
  enddo
  !
  ! Setup values and return
  f = fs
  g(1) = def
  g(2) = dwf
end subroutine minsky
!
subroutine skydip_boxes(n_boxes,c_setbox,error)
  use gkernel_interfaces
  integer :: n_boxes                     !
  character(len=*) :: c_setbox(n_boxes)  !
  logical :: error                       !
  ! Local
  integer :: m, n, j, k, i
  real*4 :: xmax, ymax, ar1, ar2, gx1, gx2, gy1, gy2, bratio, aratio
  !-----------------------------------------------------------------------
  aratio = 2.0
  !
  ! Deal with Title
  call gr_exec('SET VIEWPORT /DEF')
  call sic_get_real('PAGE_X',xmax,error)
  call sic_get_real('PAGE_Y',ymax,error)
  ! Leave a header space of aspect ratio (.08,1)
  ymax = ymax-xmax*.08
  error = .false.
  bratio = abs(aratio)*0.8
  m = min(n_boxes,max(1,nint(sqrt(n_boxes/bratio*xmax/ymax))))
  n = n_boxes/m
  do while (m*n .lt. n_boxes)
    ar1 = (xmax/float(m+1))/(ymax /float(n))
    ar2 = (xmax/float(m))/(ymax /float(n+1))
    if (abs(ar1-bratio).lt.abs(ar2-bratio)) then
      m = m+1
    else
      n = n+1
    endif
  enddo
  k = 0
  xmax = xmax/m
  ymax = ymax/n
  if (aratio.gt.0) then
    if (ymax.gt.xmax/aratio/0.8) then
      ymax = xmax/aratio/0.8
    else
      xmax = ymax*aratio*0.8
    endif
  endif
  do j=1, n
    do i=1, m
      k = k+1
      gx1 = (i-1)*xmax + xmax*.15
      gx2 = i*xmax - xmax*.05
      gy1 = (n-j)*ymax + ymax*.20
      gy2 = (n-j+1)*ymax - ymax*.16
      c_setbox(k) = ' '
      write(c_setbox(k),'(a,4(1x,f7.2))') 'SET BOX',   &
        gx1 ,gx2 ,gy1 ,gy2
    enddo
  enddo
end subroutine skydip_boxes
