subroutine solve_panels(niter,gain,amp,phas,phfit,phres,nxap,   &
    rlam,xref,xval,xinc,nmode,kant,h1,h2,work1,work2,nxbeam,nybeam,   &
    plot,scale,lprint,rwork1,rwork2, npm, pm, numscrew, screwname,   &
    screwmotion, screwmotionerror, phasrms, threshold, error)
  use gildas_def
  use gkernel_interfaces
  use clic_xypar
  !---------------------------------------------------------------------
  !	from map of aperture phase distribution ,calculates 5 modes for
  !	each panel of 15m telescopes,then gives the screw adjustements.
  !
  !	return fitted aperture plane phase and residuals
  !
  !     niter   nombre d'iterations
  !     gain    gain
  !     rlam    wavelength (mm)
  !     xref    index of reference point in x
  !     xval    x coord of ref point (mm)
  !     xinc    sampling interval (mm)
  !     ( assumed the same for y coord)
  !---------------------------------------------------------------------
  integer :: niter                          !
  real :: gain                              !
  integer :: nxap                           !
  real :: amp(nxap,nxap)                    !
  real :: phas(nxap,nxap)                   !
  real :: phfit(nxap,nxap)                  !
  real :: phres(nxap,nxap)                  !
  real :: rlam                              !
  real :: xref                              !
  real :: xval                              !
  real :: xinc                              !
  integer :: nmode                          !
  integer :: kant                           !
  character(len=*) :: h1                    !
  character(len=*) :: h2                    !
  complex :: work1(nxap,nxap)               !
  complex :: work2(nxap,nxap)               !
  integer :: nxbeam                         !
  integer :: nybeam                         !
  ! logical :: plot, rigging, error                  !
  logical :: plot, error                  !
  real :: scale(3)                          !
  integer :: lprint                         !
  real :: rwork1(nxap,nxap)                 !
  real :: rwork2(nxap,nxap)                 !
  integer :: npm                            !
  character(len=5) :: pm(npm)               !
  integer :: numscrew                       !
  character(len=12) :: screwname(numscrew)  !
  real :: screwmotion(numscrew)             !
  real :: screwmotionerror(numscrew)        !
  real(kind=4), intent(out) :: phasrms      !
  real :: threshold(2)
  ! Global
  include 'gbl_pi.inc'
  include 'clic_panels.inc'
  ! Local
  integer :: typant
  !      equivalence (work1,rwork1), (work2,rwork2)
  logical :: mask
  external :: mask
  !
  real :: am(5,mring,mpan), dam(5,mring,mpan), ae(5,mring,mpan)
  real :: znrms, zarms, rmsres, r0, x, y
  integer :: i, j, iter, k, km
  !      CHARACTER CHAIN*10
  !---------------------------------------------------------------------
  !
  write(lprint,*) 'Output from CLIC\SOLVE HOLO ',nmode   &
    ,' panel modes. '
  write(lprint,*) h1(1:lenc(h1))
  write(lprint,*) h2(1:lenc(h2))
  if (kant.eq.3 .or. kant.eq.5) then
    c2 = 0.70
  else
    c2 = 0.50
  endif
  !
  ! Modes to zero:
  do i=1, nring
    do j=1, npan(i)
      do k=1, 5
        am(k,i,j) = 0
      enddo
    enddo
  enddo
  if (niter.eq.0) then
    !
    ! calculate modes
    r0 = 10.                   ! no windowing
    call mode(amp,phas,nxap,xref,xval,xinc,rlam,am,ae,nmode,r0)
    !     $        diameter,focus)
    !
    ! compute map of panel phases
    call modemap(phfit,nxap,rlam,xref,xval,xinc,am,ae,nmode)
    call resmap(phas,phfit,phres,nxap,rlam,   &
      xref,xval,xinc,znrms,zarms,rmsres,phasrms,   &
      amp,work1,work2,nxbeam,nybeam, npm, pm)
    !
    ! Substract fitted phases
    do j=1, nxap
      do i=1, nxap
        phas(i,j) = phas(i,j) - phfit(i,j)
      enddo
    enddo
    !
    ! update plots of panel map and residual map
    if (plot) then
      !            CALL PLOT_MAPS(PHFIT,PHAS,NXAP,SCALE,SCALE,DIAMETER)
      do j=1, nxap
        y = xval+xinc*(j-xref)
        do i=1, nxap
          x = xval+xinc*(i-xref)
          !
          ! get path errors in meters
          if (mask(x,y,.1,0,' ')) then
            rwork1(i,j) = yima%gil%bval
            rwork2(i,j) = yima%gil%bval
          else
            rwork1(i,j) = 1e6*rlam*0.125/pis*phfit(i,j)   &
              *sqrt(4.*focus**2+x**2+y**2)   &
              /focus
            rwork2(i,j) = 1e6*rlam*0.125/pis*phas(i,j)   &
              *sqrt(4.*focus**2+x**2+y**2)   &
              /focus
          endif
        enddo
      enddo
      !            print *, 32,64,PHFIT(32,64),rwork1(32,64),
      !     $           PHAS(32,64),rwork2(32,64)
      call plot_maps(rwork1,rwork2,nxap,scale,scale)
    endif
  else
    !
    ! Iterate
    do iter = 1, niter
      r0 = 2.0*iter
      !
      ! calculate incremental modes from PHAS (measured phases - already fitted)
      call mode(amp,phas,nxap,xref,xval,xinc,rlam,   &
        dam,ae,nmode,r0)
      !
      ! compute map of panel phases in incremental modes
      call modemap(phfit,nxap,rlam,xref,xval,xinc,dam,ae,nmode)
      call resmap(phas,phfit,phres,nxap,rlam,   &
        xref,xval,xinc,znrms,zarms,rmsres,phasrms,   &
        amp,work1,work2,nxbeam,nybeam, npm, pm)
      !
      ! Substract fitted phases
      do j=1, nxap
        do i=1, nxap
          phas(i,j) = phas(i,j) - gain * phres(i,j)
        enddo
      enddo
      !
      ! Increment modes
      do i=1, nring
        km = min(nmode, mmode(i))
        !               IF (I.GT.1) THEN
        !                  KM = MAX(NMODE,3)
        !               ELSE
        !                  KM = NMODE
        !               ENDIF
        do j=1, npan(i)
          do k=1, km
            am(k,i,j) = am(k,i,j)+gain*dam(k,i,j)
          enddo
        enddo
      enddo
      call modemap(phfit,nxap,rlam,xref,xval,xinc,am,ae,nmode)
      ! update plots of panel map and residual map
      if (plot) then
        do j=1, nxap
          y = xval+xinc*(j-xref)
          do i=1, nxap
            x = xval+xinc*(i-xref)
            !
            ! get path errors
            if (mask(x,y,.1,0,' ')) then
              rwork1(i,j) = yima%gil%bval
              rwork2(i,j) = yima%gil%bval
            else
              rwork1(i,j) = 1e6*rlam*0.125/pis*phfit(i,j)   &
                *sqrt(4.*focus**2+x**2+y**2)   &
                /focus
              rwork2(i,j) = 1e6*rlam*0.125/pis*phas(i,j)   &
                *sqrt(4.*focus**2+x**2+y**2)   &
                /focus
            endif
          enddo
        enddo
        !               print *, 32,64,PHFIT(32,64),rwork1(32,64),
        !     $              PHAS(32,64),rwork2(32,64)
        call plot_maps(rwork1,rwork2,nxap,scale,scale)
      !               CALL PLOT_MAPS(PHFIT,PHAS,NXAP,SCALE,SCALE)
      endif
    enddo
    !
    ! Substract fitted phases
    do j=1, nxap
      do i=1, nxap
        phres(i,j) = phas(i,j)
      enddo
    enddo
  endif
  !
  ! calculate screw settings and list results
  !
  call screws(am,ae,nmode,lprint, numscrew, screwname, screwmotion,   &
       screwmotionerror, threshold, error)
    ! screwmotionerror, rigging, elevation, riggingElevation, error)
!
end subroutine solve_panels
!
!
subroutine mode (amp,phas,nxap,xref,xval,xinc,rlam,   &
    am, ae, nmode, r0)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  !	takes aperture phase distribution phas,interpolates values
  !	onto fine grid on actual aperture.those values falling on a
  !	particular panel are used in the cal of least squares sums
  !	for that panel.
  !	output are amplitudes of 5 modes per panel
  !
  !	phas	"map" of phase of aperture distribution
  !	nxap	nxap x nxap is dimension of phas
  !       xref    index of reference point in x
  !       xval    x coord of ref point (mm)
  !       xinc    sampling interval (mm)
  !       ( assumed the same for y coord)
  !	rlam	wavelength in mm
  !	ng2	ng2 x nxap is number of interpolated values across antenna
  !	mpan	max no of panels per ring (32 for 15m tel.)
  !	nr	no of rings (6 for 15m tel.)
  !	aa	array of "tilt" modal amplitudes in x direction
  !	bb	array of "tilt" modal amplitudes in y direction
  !	dd	array of "piston"  modal amplitudes
  !	tt	array of "torsion" modal amplitudes
  !	cc	array of "boss"    modal amplitudes (assumed spherical)
  !---------------------------------------------------------------------
  include 'clic_panels.inc'
  integer :: nxap                   !
  real :: amp(nxap,nxap)            !
  real :: phas(nxap,nxap)           !
  real :: xref                      !
  real :: xval                      !
  real :: xinc                      !
  real :: rlam                      !
  real :: am(mm,mring,mpan)         !
  real :: ae(mm,mring,mpan)         !
  integer :: nmode                  !
  real :: r0                        !
  ! Global
  real :: fmode
  include 'gbl_pi.inc'
  ! Local
  integer :: i, j, nd, k, ir, ip, im, ier
  integer :: npts(mring,mpan),mpts, nm
  parameter (mpts=1000)
  real :: y, x, phase, xx, yy, zz, rr2
  real :: wamp, foyer
!  real*8 :: a(mpts,mm,mring,mpan), b(mpts,mring,mpan)
  real*8,allocatable :: a(:,:,:,:), b(:,:,:)
  logical :: error
  logical :: mask
  external :: mask
  real*8 :: sig
  character(len=6) :: pch
  !----------------------------------------------------------------------
  !
  allocate(a(mpts,mm,mring,mpan),stat=ier)
  if (failed_allocate('SOLVE_PANELS','a',ier,error)) return
  allocate(b(mpts,mring,mpan),stat=ier)
  if (failed_allocate('SOLVE_PANELS','b',ier,error)) return
  do ir=1,mring
    do ip=1,npan(ir)
      npts(ir,ip) = 0
    enddo
  enddo
  !
  do j=1, nxap
    y = xval+xinc*(j-xref)
    do i=1, nxap
      x = xval+xinc*(i-xref)
      if (.not.mask(x,y,.1,0,' '))   &
        then
        !
        ! Get panel number and relative coordinates in panel
        call xypanel(x,y,ir,ip,xx,yy)
        if (npts(ir,ip).lt.mpts) then
          npts(ir,ip)=npts(ir,ip)+1
          k = npts(ir,ip)
          rr2 = xx**2+yy*2
          wamp = 10**(amp(i,j)/10.)*exp(-rr2/r0**2)
          do im=1, min(nmode,mmode(ir))
            a(k,im,ir,ip) = fmode(im,ir,xx,yy)*wamp
          enddo
          !
          ! Resolve path error perpendicular to surface
          ! Set in [-PI,PI[ range
          phase = sin(phas(i,j))
          !               phase = MOD(phase+21D0*PI,2D0*PI)-PI
          !               ZZ=RLAM*0.125/PIS*PHASE*SQRT(4.*FOYER*FOYER+X*X+Y*Y)
          !     $         /FOYER
          zz=rlam*0.125/pis*phase*sqrt(4.*focus**2+x**2+y**2)   &
            /focus
          b(k,ir,ip) = zz*wamp
        else
          print *, 'ignoring data in panel ',ir,ip
        endif
      endif
    enddo
  enddo
  !
  ! calculate modes
  !      print *, 'mm, mring, mpan'
  !      print *, mm, mring, mpan
  !      print *, 'mring, nring, (npan(ir),ir=1,nring)'
  !      print *, mring, nring, (npan(ir),ir=1,nring)
  !      PRINT *, 'IR, IP, K, AM(K,IR,IP), AE(K,IR,IP)'
  do ir=1, nring
    nm = min(nmode,mmode(ir))
    do ip=1, npan(ir)
      nd = npts(ir,ip)
      if (nd.ne.0) then
        call mth_fitlin ('MODE',nd,nm,   &
             a(1,1,ir,ip),b(1,ir,ip),mpts,sig)
        do k=1, nm
          am(k,ir,ip) = b(k,ir,ip)
          ! NOte : the errors are not the same under lapack and nag.
          ! should be looked into (actually works with nag, not lapack). RL.
          ae(k,ir,ip) = sqrt(abs(a(k,k,ir,ip)))
        enddo
      else
        write (6,*) 'No data for panel ',ip,' ring ',ir
      endif
    enddo
  enddo
!      print *, 'end mode'
end subroutine mode
!
function fmode(jm,ir,xx,yy)
  real :: fmode                     !
  integer :: jm, im                     !
  integer :: ir                     !
  real :: xx                        !
  real :: yy                        !
  ! Global
  include 'clic_panels.inc'
  !
  if (jm.gt.mmode(ir)) then
    fmode = 0
    return
  endif
  im = modes(jm,ir)
!  if (ir.eq.4 .or. ir.eq.2) then
!    if (im.eq.1) then
!      fmode = 1d0
!    elseif (im.eq.2) then
!      fmode = xx
!    elseif (im.eq.3) then
!      fmode = yy
!    elseif (im.eq.4) then
!      fmode = c2*(xx**2+yy**2) + (1-c2)*yy**2
!    endif
!    return
!  endif
  if (im.eq.1) then
    fmode = 1d0
  elseif (im.eq.2) then
    fmode = xx
  elseif (im.eq.3) then
    fmode = yy
  elseif (im.eq.4) then
    fmode = xx*yy
  elseif (im.eq.5) then
    fmode = c2*(xx**2+yy**2) + (1-c2)*yy**2
  endif
  return
end function fmode
!
subroutine screws(am,ae,nmode,lprint, numscrew, screwname,   &
     screwmotion, screwmotionerror, threshold, error)                          
     !    rigging, elevation, riggingElevation, error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  !     calculates screw adjustments for 15m telescope given 5 modes for
  !     each panel-- aa,bb,dd,tt,cc.
  !
  !     z=dd + aa*(x-xxm) + bb*y + tt*y*(x-xx2)
  !     + cc*[ c2*(x-xc)**2 + s2*y**2 - c2*xxm2 - s2*yy2 ]
  !
  !     calculation as for 30m telescope but screw nos changed for output
  !
  !     x local panel coord is directed radially outwards
  !     y local panel coord is directed in azimuth in direction of
  !     panel counting in each ring.
  !     xxm  mean x coord of panel
  !     xx2  rms  x coord of panel
  !     xc       x coord for "boss" calculation
  !     xxm2 mean square (x-xc)
  !     yy2  mean square y
  !     c2   cos(phi)**2 (0.5 as first approx.)
  !     s2   sin(phi)**2 (0.5 as first approx.)
  !     phi  angle specifying ratio of curvature of "boss" in x and y
  !     =45 degrees as first approximation
  !---------------------------------------------------------------------
  include 'clic_panels.inc'
  real :: am(mm,mring,mpan)                 !
  real :: ae(mm,mring,mpan)                 !
  integer :: nmode                          !
  integer :: lprint                         !
  integer :: numscrew                       ! screw results for CalDM
  character(len=12) :: screwname(numscrew)  !
  real :: screwmotion(numscrew)           !
  ! real :: screwmotion(numscrew), elevation, riggingElevation(2)             !
  real :: screwmotionerror(numscrew)
  real :: threshold(2)                      ! Threshold for listing
  logical error
  ! logical rigging, error
  !
  ! Global
  character(len=5) :: cpanel
  include 'gbl_pi.inc'
  ! Local
  integer :: iscrew
  !
  integer :: ipage, mlines, lines
  parameter (mlines=58)        ! 58 lines per page of listing
  integer ::  nscrew(mm), it(mm), iet(mm)
  real :: total(mm), etotal(mm), qt(mm), qet(mm)
  character(len=1) :: apage
  character(len=5) :: chp
  character(len=100) :: chain
  character(len=11) :: blan11
  integer :: ir, ip, j, is, lc
  real :: x, y, r1, r0, r, t0, phi
  real, allocatable :: correction(:,:,:)
  !
  lines = mlines-3
  iscrew = 0
  blan11 = "           "
  !if (rigging) then
  !  allocate(correction(mring, mpan, mm))
  !  call get_rigging(elevation, riggingElevation, correction, &
  !       error)
  !  if (error) then
  !    write(6,*) 'No gravitational deformation available.'
  !    return
  !  endif
  !  write(6,*) 'Found gravitational deformation data.'
  !endif
  do ir = 1,nring
    if (ant_type.eq.type_iram30m) then  ! special 30m case
      iscrew = 0
      if (npan(ir)+3.gt.lines) then
        apage = char(012)        ! new page
        lines = mlines
      else
        apage = ' '
      endif
      write(lprint,1003) apage, (ir-1)*2+1
1003  format(a1,/,'Screw ring n0. ',i2,':',   &
        /,' Screw     Screw settings  [mum]')
      do ip=1,npan(ir)           !LOOP AROUND A FRAME RING
        do is = 1, 2             !INNER SCREWS
          x = xscr(is,ir)
          y = yscr(is,ir)
          !
          ! (Do not apply gravitational corrections to screw settings)
          call zpanel(x,y,ir,ip,am,ae,total(is),etotal(is),   &
            nmode)
          ! correction now done before plotting ... in res_holo.
          !! if (rigging) total(is) = total(is)+correction(ir, ip, is)
          it(is) = nint(1e6*total(is))
          iet(is) = nint(1e6*etotal(is))
          ! now write results
          chp = cpanel(ir,ip)
          iscrew = iscrew+1
          if (abs(it(is)).gt.threshold(1).and. &
              abs(it(is)).gt.threshold(2)*iet(is)) then
            write(lprint,1002) (ir-1)*2+1,iscrew, it(is),iet(is)
          endif
1002      format(3x,i2,'.',i2.2,5x,i6,2x,'(',i3,')')
        enddo
      enddo
      iscrew = 0
      write(lprint,1003) apage, (ir-1)*2+2
      do ip=1,npan(ir)           !LOOP AROUND A FRAME RING
        do is = 3, nscr(ir)      !OUTER SCREWS
          x = xscr(is,ir)
          y = yscr(is,ir)
          !
          ! (Do not apply gravitational corrections to screw settings)
          call zpanel(x,y,ir,ip,am,ae,total(is),etotal(is),   &
            nmode)
          ! correction now done before plotting ... in res_holo.
          !! if (rigging) total(is) = total(is)+correction(ir, ip, is)
          it(is) = nint(1e6*total(is))
          iet(is) = nint(1e6*etotal(is))
          iscrew = iscrew+1
          if (abs(it(is)).gt.threshold(1).and. &
              abs(it(is)).gt.threshold(2)*iet(is)) then
            write(lprint,1002) (ir-1)*2+2,iscrew, it(is),iet(is)
          endif
        enddo
      enddo
    else
      if (npan(ir)+3.gt.lines) then
        apage = char(012)        ! new page
        lines = mlines
      else
        apage = ' '
      endif
      write(lprint,1001) apage, ir, nscr(ir)
1001  format(a1,/,'Panel ring n0. ',i2,':',   &
        /,' Sec/Pan     Screw settings (1-',i1,'), [mum]')
      lines = lines-3
      do ip=1,npan(ir)           !LOOP AROUND A RING
        lc = 0
        chain = ''
        do is = 1, nscr(ir)
          x = xscr(is,ir)
          y = yscr(is,ir)
          !
          ! (Do not apply gravitational corrections to screw settings)
          call zpanel(x,y,ir,ip,am,ae,total(is),etotal(is),   &
            nmode)
          ! correction now done before plotting ... in res_holo.
          !! if (rigging) total(is) = total(is)+correction(ir, ip, is)
          it(is) = nint(1e6*total(is))
          iet(is) = nint(1e6*etotal(is))
          if (abs(it(is)).gt.threshold(1).and. &
              abs(it(is)).gt.threshold(2)*iet(is)) then
            write(chain(lc+1:lc+12),1010) it(is), iet(is)
          else
            write(chain(lc+1:lc+12),1011) blan11
          endif
          lc = lc+11
1010  format(i6,'(',i3,')')
1011  format(a11)
        enddo
        ! now write results
        chp = cpanel(ir,ip)
        lc = lenc(chain)
        if (lc.gt.0) then
          write(lprint,1000) chp, chain(1:lc)
        endif
1000    format(3x,a5,5x,a)
        !
        ! Save screw results for CalDM:
        do is = 1, nscr(ir)
          iscrew = iscrew + 1
          write(screwname(iscrew),'(a5,2h-S,i1)')  chp, is
          screwmotion(iscrew) = total(is)
          screwmotionerror(iscrew) = etotal(is)
        !$$$               print *, ip, is, iscrew, screwName(iscrew),
        !$$$     &              screwMotion(iscrew), screwMotionError(iscrew)
        enddo
        lines = lines-1
      enddo
    endif
  enddo
  return
end subroutine screws
!
subroutine modemap(phfit,nxap,rlamda,   &
    xref, xval, xinc,am,ae,nmode)
  !---------------------------------------------------------------------
  !	makes an aperture plane map of 15m telescope using up to 5 modes
  !	makes residal map also,using phas map
  !
  !	fills a complex aperture array psi from data given by the modes
  !	am
  !	takes measured phases and makes a residual complex map
  !
  !	number of modes used defined by nmode 1,3,4,5
  !	wavelength rlamda,relative sampling interval relsampi and power
  !	taper is taperdb (+ve)
  !	returns rms deflection normally,and axially,and no points used
  !---------------------------------------------------------------------
  include 'clic_panels.inc'
  integer :: nxap                   !
  real :: phfit(nxap,nxap)          !
  real :: rlamda                    !
  real :: xref                      !
  real :: xval                      !
  real :: xinc                      !
  real :: am(5,mring,mpan)          !
  real :: ae(5,mring,mpan)          !
  integer :: nmode                  !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  !      REAL RMAX2,RMIN2, X, Y,RAD2,XPANEL,YPANEL,
  real ::  x, y,rad2,xpanel,ypanel
  real ::  cosa, zpan, epan
  integer :: m, n, ir, ip
  !
  logical :: mask
  external :: mask
  character(len=6) :: pch
  !----------------------------------------------------------------------
  !
  ! fill array point by point
  do  m = 1,nxap
    x = xval+xinc*(m-xref)
    do  n = 1,nxap
      y = xval+xinc*(n-xref)
      rad2 = x**2+y**2
      if (.not.mask(x,y,.1,0,' '))   &
        then
        ! Identify panel and local coords in this panel
        call xypanel(x,y,ir,ip,xpanel,ypanel)
        ! Calculate normal deflection
        call zpanel(xpanel,ypanel,ir,ip,am,ae,zpan,epan,   &
          nmode)
        cosa  =  1./sqrt(1.+rad2/4/focus**2)
        phfit(m,n) = 4.*pis*zpan*cosa/rlamda   !aperture phase
      else
        phfit(m,n) = 0
      endif
    enddo
  enddo
  return
end subroutine modemap
!
subroutine resmap(phas,phfit,phres,nxap,rlamda,   &
    xref, xval, xinc, znrms, zarms, rmsres, phasrms,   &
    amp,work1,work2,nxbeam,nybeam, npm, pm)
  !---------------------------------------------------------------------
  ! Using the phase of Fitted panels PHFIT, compute the residuals
  ! from the input phase map PHAS
  !---------------------------------------------------------------------
  integer :: nxap                   !
  real :: phas(nxap,nxap)           !
  real :: phfit(nxap,nxap)          !
  real :: phres(nxap,nxap)          !
  real :: rlamda                    !
  real :: xref                      !
  real :: xval                      !
  real :: xinc                      !
  real :: znrms                     !
  real :: zarms                     !
  real :: rmsres                    !
  real :: phasrms                   !
  real :: amp(nxap,nxap)            !
  complex :: work1(nxap,nxap)       !
  complex :: work2(nxap,nxap)       !
  integer :: nxbeam                 !
  integer :: nybeam                 !
  integer :: npm                    !
  character(len=5) :: pm(200)       !
  ! Global
  include 'clic_panels.inc'
  include 'gbl_pi.inc'
  ! Local
  integer :: npts
  real :: w, wamp, ptoz
  real :: resmean,res2,phasmean,phas2, x, y,rad2
  real :: cosa
  integer :: m, n
  logical :: mask
  external :: mask
  !----------------------------------------------------------------------
  !      foyer = focus*1000.
  !
  ! Compute true residuals (substitute panel fit to aperture phase, FFT back to
  ! beam map, cutoff, and recompute aperture phase)
  call fitres(phres,   &       !
    amp,   &                   ! input map amplitude
    phfit,   &                 ! phase of panel fit
    work1,   &                 ! complex work space
    work2,   &                 ! complex work space
    nxbeam,nybeam,   &         ! size of observed beam map
    nxap,nxap)                 ! size of aperture map.
  !
  ! calculate rms of screw deflections-rmss,no of screws-ntot
  ! zeroes for statistics
  !
  npts = 0                     !no points in aperture
  w = 0
  resmean = 0.
  res2 = 0.
  phasmean = 0.
  phas2 = 0.
  !      RMAX2 = (DIAM/2.)**2               !max radius (mm) squared
  !      RMIN2 = (DBLOCK/2.)**2             !min radius (mm) squared
  do  m = 1,nxap
    x = xval+xinc*(m-xref)
    do  n = 1,nxap
      y = xval+xinc*(n-xref)
      rad2 = x**2+y**2
      wamp = 10**(amp(m,n)/10.)
      !
      !            IF (.NOT. MASK(X,Y,.001,0,' '))
      if (.not. mask(x,y,.1,npm,pm))   &
        then
        cosa  =  1./sqrt(1.+rad2/4/focus**2)
        ! from radians to micrometers
        ptoz = rlamda/(4*pis*cosa)
        resmean = resmean+phres(m,n)*ptoz*wamp
        res2 = res2+(phres(m,n)*ptoz)**2*wamp
        phasmean = phasmean+phas(m,n)*ptoz*wamp
        phas2 = phas2+(phas(m,n)*ptoz)**2*wamp
        w = w+wamp
        npts = npts+1
      endif
    enddo
  enddo
  if (w.gt.0) then
    resmean = resmean/w
    rmsres =  sqrt((res2-w*resmean**2)/w)
    phasmean = phasmean/w
    phasrms = sqrt((phas2-w*phasmean**2)/w)
  endif
  write (6,'(a,f6.2,a,f6.2,a)') 'rms of res. map:', phasrms*1e6,   &
    ';  rms of fitted pan. ',rmsres*1e6,' mum'
  return
end subroutine resmap
!
!
subroutine xypanel(x,y,ir,ip,xpanel,ypanel)
  !---------------------------------------------------------------------
  !     takes x,y,coords in aperture (mm)  for each call
  !     identifies corresponding panel(i3,i1) and calculates
  !     local coords xpanel,ypanel
  !
  !     outside radius of rings (inner section being 0),and average
  !---------------------------------------------------------------------
  real :: x                         !
  real :: y                         !
  integer :: ir                     !
  integer :: ip                     !
  real :: xpanel                    !
  real :: ypanel                    !
  ! Global
  include 'clic_panels.inc'
  include 'gbl_pi.inc'
  ! Local
  real :: phi
  real :: alpha, phi0, tana, alpha3
  real :: tan0, dphi, z, z0, r, rphi, r0, t0
  integer :: typant, i, nsector, ninsector
  !
  !----------------------------------------------------------------------
  if (diameter.le.0 .or. focus.le.0) then
    print *, 'x,  y,diameter,focus'
    print *, x,y,diameter,focus
    stop
  endif
  ir = 0
  ip = 0
  !
  ! phi is used for counting panels,
  ! but we start from the left side of the antenna, as seen from back,
  ! and go clockwise.
  !
  if (x.eq.0..and.y.eq.0.) then
    phi = 0.
  else
    if (ant_type.ge.type_melco12m_1 .and. ant_type.le.type_melco12m_4) then
      phi = atan2(-x,y)
    elseif (ant_type.eq.type_iram30m) then
      phi = -atan2(x,y)
    else
      phi = atan2(x,y)+pi/2.
    endif
  endif
  r = sqrt(x**2+y**2)
  if (r.gt.ray(nring) .or. (r.lt.ray(0))) then
    return
  endif
  !
  !  find ring number
  ir = 1
  do while (r .gt. ray(ir))
    ir = ir + 1
  enddo
  phi = mod(phi+4*pi,2*pi)
  !
  ! loop around looking for azimuth
  !      ip = int(phi/2./pi*npan(ir)) !  0 to npan-1
  !      ip = mod(ip+npan(ir),,npan(ir))+1
  ip = mod(int(phi/2./pi*npan(ir)) + npan(ir),npan(ir)) + 1
  ! x referred to zero defined by mean slope alpham
  ! y referred to zero in panel center
  dphi =  phi-(ip-0.5)*2.*pi/npan(ir)
  r0 = (ray(ir-1)+ray(ir))/2.
  t0 = r0/2/focus
  xpanel = (r*cos(dphi)-r0+(r**2-r0**2)/4/focus*t0)   &
    /sqrt(1+t0**2)
  ypanel = r*sin(dphi)
  if (ant_type.ge.type_melco12m_1 .and. ant_type.le.type_melco12m_4) then
    ypanel = -ypanel
  endif
  !      if (ir.eq.3) then
  !         print '(4f7.3)', x, y, xpanel, ypanel
  !      endif
  return
end subroutine xypanel
!
function cpanel(ir,ip)
  character(len=5) :: cpanel        !
  integer :: ir                     !
  integer :: ip                     !
  ! Global
  include 'clic_panels.inc'
  ! Local
  integer :: nsector, ninsector, k
  ! Find sector number
  if (ant_type.ne.type_iram30m) then
    k = npan(ir) / npan(1)
    nsector = (ip-1)/k  + 1
    ninsector = ip - k*(nsector-1)
    write (cpanel,1000) nsector, ir, ninsector
1000 format(i2,'-',i1,i1)
  else
    write (cpanel,1001) ir,ip
1001 format(i2,'-',i2.2)
  endif
end function cpanel
!
!
subroutine zpanel(x,y,ir,ip,am,ae,zpan,epan,nmode)
  include 'clic_panels.inc'
  real :: x                         !
  real :: y                         !
  integer :: ir                     !
  integer :: ip                     !
  real :: am(mm,mring,mpan)         !
  real :: ae(mm,mring,mpan)         !
  real :: zpan                      !
  real :: epan                      !
  integer :: nmode                  !
  ! Global
  real :: fmode
  ! Local
  integer :: k, km
  !----------------------------------------------------------------------
  zpan = 0
  epan = 0
  km = min(nmode,mmode(ir))
  !      IF (IR.EQ.1) KM = MIN(3,NMODE)
  do k=1, km
    zpan = zpan + am(k,ir,ip)*fmode(k,ir,x,y)
    epan = epan + (ae(k,ir,ip)*fmode(k,ir,x,y))**2
  enddo
  epan = sqrt(epan)
  return
end subroutine zpanel
!
subroutine fitres(phres,am_obs,phfit,work,zap,   &
    nxbeam,nybeam,nxap,nyap)
  !---------------------------------------------------------------------
  ! compute the effect of fitted panels (phfit) on the observed phase
  ! phres is in fact the response to phfit by the observing process.
  ! one uses the observed amplitude as a weight.
  !---------------------------------------------------------------------
  integer :: nxap                   ! dimensions in aperture plane
  integer :: nyap                   ! dimensions in aperture plane
  real :: phres(nxap,nyap)          !
  real :: am_obs(nxap,nyap)         !
  real :: phfit(nxap,nyap)          !
  complex :: work(nxap,nyap)        !
  complex :: zap(nxap,nyap)         !
  integer :: nxbeam                 ! dimensions in beam map plane
  integer :: nybeam                 ! dimensions in beam map plane
  ! Local
  integer :: i,j,ii,jj, nn(2)
  real :: amp, faz, pha
  !-----------------------------------------------------------------------
  !
  ! Fill in zap with the panel fit phase ant the amplitudes
  do j=1, nyap
    do i=1, nxap
      amp = 10**(am_obs(i,j)/10.)
      zap(i,j) =   &
        cmplx(amp*cos(phfit(i,j)),amp*sin(phfit(i,j)))
    enddo
  enddo
  !
  ! FFT of zap
  nn(1) = nxap
  nn(2) = nyap
  call fourt(zap,nn,2,-1,1,work)
  !
  ! Cut off in beam map plane (ii and jj are the spatial offsets)
  do j=1, nyap
    jj = mod(j+nyap/2-1,nyap)-nyap/2
    do i=1, nxap
      ii = mod(i+nxap/2-1,nxap)-nxap/2
      if (ii.le.-nxbeam/2 .or. ii.ge.nxbeam/2 .or.   &
        jj.le.-nybeam/2 .or. jj.ge.nybeam/2) then
        zap(i,j) = 0
      endif
    enddo
  enddo
  !
  ! FFT back of zap
  call fourt(zap,nn,2,1,1,work)
  !
  ! get phases residuals
  do j=1, nyap
    do i=1, nxap
      zap(i,j) = zap(i,j)/nxap/nyap
      amp = abs(zap(i,j))
      if (amp.gt.0) then
        pha = faz(zap(i,j)/amp)
      else
        pha = 0
      endif
      phres(i,j) = pha
    enddo
  enddo
  return
end subroutine fitres
!
subroutine set_panels(type)
  !---------------------------------------------------------------------
  ! Set panels info according to antenna type
  !---------------------------------------------------------------------
  integer :: type                   !
  ! Global
  include 'clic_panels.inc'
  include 'gbl_pi.inc'
  ! Local
  integer :: i, j, ip, is, ir, im
  real :: x, y, r1, r0, r, phi, t0
  !-------------------------------------------------------
  ! Bure screw positions (offset from nearest corner, in panel frame)
  ! (sign of offset indicates which is the corner)
  real :: xoscr(5,6), yoscr(5,6)
  data xoscr/   &
    0.071, -0.049, -0.049,  0.754, 0,   &
    0.049,  0.049, -0.049, -0.049, 0,   &
    0.049,  0.049, -0.049, -0.049, 0,   &
    0.049,  0.049, -0.049, -0.049, 0,   &
    0.049,  0.049, -0.049, -0.049, 0,   &
    0.049,  0.049, -0.049, -0.049, 0/
  data yoscr/   &
    0, -0.110,  0.110,      0, 0,   &
    0.110, -0.110, -0.110,  0.110, 0,   &
    0.110, -0.110, -0.110,  0.110, 0,   &
    0.110, -0.110, -0.110,  0.110, 0,   &
    0.110, -0.110, -0.110,  0.110, 0,   &
    0.110, -0.110, -0.110,  0.110, 0/
  ! 30-m screw positions 
  ! panel corners : 1, 2 inner; 3, 4 outer
!!!   DATA XP1/-1093.6,-1176.5,-1177.1,-1195.3,-1142.6,-1139.1,-1251.1/
!!!   DATA XP2/-1093.6,-1176.5,-1177.1,-1195.3,-1142.6,-1139.1,-1251.1/
!!!   DATA XP3/707.6,990.5,890.8,1114.7,1036.2,1008.7,1100.5/
!!!   DATA XP4/707.6,990.5,890.8,1114.7,1036.1,1008.7,1100.5/
!!!   DATA YP1/-309.0,-451.3,-788.4,-553.1,-722.6,-876.8,-1023.1/
!!!   DATA YP2/309.0,451.3,788.4,553.1,722.6,876.8,1023.1/
!!!   DATA YP3/-891.5,-788.4,-1102.9,-722.6,-876.8,-1023.1,-1176.9/
!!!   DATA YP4/891.5,788.4,1102.9,722.6,876.8,1023.1,1176.9/
!!!   ! delX, delY offsets from nearest corner
!!!   DATA DELX1/ 58., 37., 30., 31., 43., 32., 34./
!!!   DATA DELX2/ 58., 37., 30., 31., 43., 32., 34./
!!!   DATA DELX3/-61.,-35.,-34.,-43.,-44.,-34.,-67./
!!!   DATA DELX4/-61.,-35.,-34.,-43.,-44.,-34.,-67./
!!!   DATA DELY1/27.,  25., 43., 24., 31., 38., 45./
!!!   DATA DELY2/-27.,-25.,-43.,-24.,-31.,-38.,-45./
!!!   DATA DELY3/45.,  48., 58., 31., 38., 45., 51./
!!!   DATA DELY4/-45.,-48.,-58.,-31.,-38.,-45.,-51./
  ! 30m values 
  real :: xoscr30(5,7), yoscr30(5,7)
  data xoscr30/ &
       0.058, 0.058, -0.061, -0.061, -0.061, & ! Five screws in ring 1
       0.037, 0.037, -0.035, -0.035, 0., &
       0.030, 0.030, -0.034, -0.034, -0.034, & ! Five screws in ring 3
       0.031, 0.031, -0.043, -0.043, 0., &       
       0.043, 0.043, -0.044, -0.044, 0., &
       0.032, 0.032, -0.034, -0.034, 0., &
       0.034, 0.034, -0.067, -0.067, 0./
  data yoscr30/ &
       0.027, -0.027, 0.045,  0.,    -0.045, &
       0.025, -0.025, 0.048, -0.048, 0., &
       0.043, -0.043, 0.058,  0.,    -0.058, &
       0.024, -0.024, 0.031, -0.031, 0., &
       0.031, -0.031, 0.038, -0.038, 0., &
       0.038, -0.038, 0.045, -0.045, 0., &
       0.045, -0.045, 0.051, -0.051, 0./

  !-------------------------------------------------------
  ! Vertex screw positions (radius rscr in m,
  !                         angle tscr in radians, from panel edge)
  !     in projection on aperture, 8 panel types and 5 screws/panel)
  real :: rscr_vx(5,8), tscr_vx(5,8)
  data rscr_vx/   &
    0.53575, 0.53571, 1.19778, 1.19748, 0.91389,   &
    1.33569, 1.33558, 1.75305, 1.75236, 1.52073,   &
    1.88914, 1.88910, 2.53827, 2.53777, 2.22333,   &
    2.67233, 2.67224, 3.15428, 3.15358, 2.84699,   &
    3.28574, 3.28572, 3.97528, 3.97495, 3.64196,   &
    4.10355, 4.10351, 4.71701, 4.71656, 4.41408,   &
    4.84148, 4.84142, 5.37366, 5.37312, 5.10640,   &
    5.49460, 5.49453, 5.94013, 5.93954, 5.71265/
  data tscr_vx/   &
    0.393121, 0.131047, 0.465744, 0.059062, 0.339018,   &
    0.471476, 0.052519, 0.484501, 0.040838, 0.308473,   &
    0.224936, 0.037136, 0.235189, 0.028524, 0.131539,   &
    0.235820, 0.026304, 0.240634, 0.023193, 0.131440,   &
    0.109715, 0.021375, 0.114162, 0.018454, 0.065981,   &
    0.113972, 0.017143, 0.117015, 0.015770, 0.066018,   &
    0.116580, 0.014554, 0.118844, 0.013974, 0.066021,   &
    0.118303, 0.012843, 0.120040, 0.012685, 0.065991/
  ! Blockage due to feed legs, from ALMA Antenna Group Report #40 (2002-03-28)
  real :: rblock_vx(9), hblock_vx(9)
  data rblock_vx/   &
    0.3750, 3.8970, 4.1970, 4.4970, 4.7970,   &
    5.0970, 5.3970, 5.6970, 6.0000/
  data hblock_vx/   &
    0.0400, 0.0400, 0.0461, 0.0489, 0.0587,   &
    0.0608, 0.0665, 0.0724, 0.0783/
  ! Temperature coefficients. 
  ! nPol, mPol are the ZernikePolynomial indices; 
  ! coeffPol are the corresponding temperature coefficients in mum/K
  real :: coeffPol_vx(10)
  integer :: mPol_vx(10), nPol_vx(10)
  data nPol_vx / 2,  2,  3,  4,  4,  4,  5,  6,  6,  7/
  data mPol_vx / 2, -2,  3,  4,  2,  0, -1,  2,  0,  1/
  ! DV03 only
  !  data coeffPol_vx / -0.61186, -0.50031, -0.17588, -0.43920, 0.222851, & 
  !       0.353557, +0.1353, -0.1625, -0.17316/
  ! final 10-coefficient formula from Fred Schwab
  !  Note that odd-n terms have a reversed sign due to the different orientation 
  ! of axes in CLIC.
  data coeffPol_vx /-0.592547, -0.453756, -0.175091, -0.434967, 0.211509, & 
       0.353752, +0.122604, -0.172922, -0.176978, -0.0946602/
  
       
  !-------------------------------------------------------
  ! AEC screw positions (radius rscr in mm,
  !                         angle tscr in degrees, from panel edge)
  !     in projection on aperture, 5 panel types and 5 screws/panel)
  real :: rscr_aec(5,5), tscr_aec(5,5)
  data rscr_aec/   &
    558.6,    558.6,   1372.04,  1372.04,  1027.95,   &
    1674.97,  1674.97,  2478.96,  2478.96,  2107.97,   &
    2809.24,  2809.24,  3601.2,   3601.2,   3221.96,   &
    3939.14,  3939.14,  4724.21,  4724.21,  4356.03,   &
    5066.21,  5066.21,  5847.87,  5847.87,  5484.97/
  data tscr_aec/   &
    33.5414,  11.4586, 37.8486,  7.1516,  22.5000,   &
    19.9097,   2.5903, 19.5129,  2.9871,  11.2500,   &
    9.9589,   1.2911,  9.7972,  1.4527,   5.6250,   &
    9.7458,   1.5042,  9.6582,  1.5918,   5.6250,   &
    9.6333,   1.6167,  9.5780,  1.6720,   5.6250 /
  ! Blockage due to feed legs, from ALMA Antenna Group Report #40 (2002-03-28)
  ! Rather approximate
  ! updated for production antenna (Oct. 2010)
  real :: rblock_aec(2), hblock_aec(2)
  data rblock_aec/   &
    0.3750, 6.0000/
  data hblock_aec/   &
    0.04925, 0.04925/
  !-------------------------------------------------------
  ! MELCO screw positions (radius rscr in mm,
  !                         angle tscr in digree, from antenna center!!)
  !     in projection on aperture, 7 panel types and 4or5 screws/panel)
  real :: rscr_melco(5,7), tscr_melco(5,7)
  data rscr_melco/   &
    527.710,  683.622,  683.822,  471.728, 471.728,   &
    1255.335, 1545.837, 1545.837, 969.017, 0.0,   &
    2146.294, 2457.902, 2457.902, 1855.426, 1855.426,   &
    3066.465, 3366.928, 3366.928, 2766.561, 0.0,   &
    3951.072, 4244.137, 4244.137, 3663.266, 3663.266,   &
    4807.951, 5092.371, 5092.371, 4528.556, 4528.556,   &
    5626.556, 5895.681, 5895.681, 5365.692, 5365.692 /
  data tscr_melco/   &
    36.000,    63.154577, 8.845423, 16.173171, 55.826829,   &
    9.000000,  13.786896, 4.213104, 9.000000,  0.0,   &
    9.000000,  15.377019, 2.622981, 3.463847,  14.536153,   &
    4.500000,  7.121568,  1.878432, 4.500000,  0.0,   &
    4.500000,  7.457810,  1.542190,  1.777506, 7.222494,   &
    4.500000, 7.584345,  1.415655,  2.348636, 6.651364,   &
    4.500000, 7.562711,  1.437289,  1.572908, 7.427092 /
  ! Blockage due to feed legs, from ALMA Antenna Group Report #40 (2002-03-28)
  real :: rblock_melco(5), hblock_melco(5)
  data rblock_melco/   &
    0.375, 0.620, 0.625, 1.470, 6.000/
  data hblock_melco/   &
    0.0485, 0.0485, 0.0390, 0.0390, 0.0765/

  ! Temperature coefficients. 
  ! nPol, mPol are the ZernikePolynomial indices; 
  ! coeffPol are the corresponding temperature coefficients in mum/K
  integer :: mPol_melco(69), nPol_melco(69)
  data nPol_melco / &
       2,  2,  2, &
       3,  3,  3,  3, &
       4,  4,  4,  4,  4, &
       5,  5,  5,  5,  5,  5,  &
       6,  6,  6,  6,  6,  6,  6,  &
       7,  7,  7,  7,  7,  7,  7,  7,  &
       8,  8,  8,  8,  8,  8,  8,  8,  8,  &
       9,  9,  9,  9,  9,  9,  9,  9,  9,  9,  &
      10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, &
      11, 11, 11, 11, 11, 11 /
  data mPol_melco / &
       2,  0, -2,  &
       3,  1, -1, -3, &
       4,  2,  0, -2, -4, &
       5,  3,  1, -1, -3, -5, &
       6,  4,  2,  0, -2, -4, -6, &
       7,  5,  3,  1, -1, -3, -5, -7, &
       8,  6,  4,  2,  0, -2, -4, -6, -8, &
       9,  7,  5,  3,  1, -1, -3, -5, -7, -9, &
       10, 8,  6,  4,  2,  0, -2, -4, -6, -8,-10, &
       11, 9,  7,  5,  3,  1 /
       
  !?  Note that odd-n terms have a reversed sign due to the different orientation 
  !? of axes in CLIC.
  real :: coeffPol_melco_1(33)
  data coeffPol_melco_1 / &
       0.06, -0.03, -0.06, &
       0.47, -0.01, -0.04, 0.65, &
       0.70, -0.04, 0.33, -0.50, 0.20, &
       0.13, -0.34, 0.03, 0.07, -0.20, -0.03, &
       0.05, -0.32, -0.13, 0.11, 0.32, -0.06, -0.03, &
       -0.08, -0.04, 0.02, 0.18, 0.17, -0.16, -0.17, 0.20 /
       
  real :: coeffPol_melco_2(69)
  data coeffPol_melco_2 / &
       0.29, -0.02, 0.59, &
       0.11, -0.04, -0.02, 0.35, &
       1.14, -0.11, -0.29, -0.09, -0.05, &
       -0.13, -0.19, 0.12, 0.02, -0.23, 0.18, &
       0.17, -0.66, 0.11, 0.21, -0.09, -0.01, 0.23, &
       -0.22, 0.03, 0.13, 0.06, 0.10, 0.18, -0.14, -0.25, &
       0.08, -0.04, -0.09, -0.11, -0.03, -0.02, 0.04, -0.12, 0.30, &
       0.05, 0.13, 0.10, 0.00, -0.09, -0.06, -0.17, -0.02, 0.08, 0.02, &
       0.25, -0.14, -0.10, -0.07, -0.05, 0.14, -0.10, 0.07, -0.07, -0.21, -0.10, &
       -0.08, -0.07, 0.03, 0.00, -0.08, -0.09 /
  real :: coeffPol_melco_3(33)
  data coeffPol_melco_3 / &
       -0.51, +0.03, -0.11,  &
       +0.15, -0.02, -0.01, +0.42, &
       +1.11, +0.17, -0.03, -0.08, +0.08, &
       +0.14, -0.07, +0.00, +0.28, -0.42, -0.01, &
       -0.02, -0.59, +0.06, +0.12, +0.31, +0.02, -0.18, &
       -0.21, -0.02, +0.01, +0.16, +0.10, +0.19, +0.05, -0.14 /
  !-----------------------------------------------------------
  !
  ant_type = type
  ! by default
  numPol = 0
  !
  ! Bure 15m antenna
  if ((ant_type.eq.type_bure).or.(ant_type.eq.type_bure2)) then
    diameter = 15.
    focus = 4.875
    nring = 6
    npan(1) = 16
    mmode(1) = 3
    if (ant_type.eq.type_bure2) then
       mmode(1) = 4   ! 4 screws on first ring
       call message(8,2,'SET PANELS','Using four screws on ring 1') 
    endif
    do i = 2, 6
      npan(i) = 32
      mmode(i) = 5
    enddo
    front_view = .false.
    ! external radius of each ring
    ray(0) = 0.744145782
    ray(1) = 1.971513790
    ray(2) = 3.169878381
    ray(3) = 4.326778338
    ray(4) = 5.435213519
    ray(5) = 6.492736021
    ray(6) = 7.500
    ! blockage
    nblock = 3
    rblock(1) = ray(0)
    rblock(2) = 5.3
    rblock(3) = 7.5
    hblock(1) = 0.040
    hblock(2) = 0.040
    hblock(3) = 0.200
    vblock = .false.           ! crossed (multiply shape) quadrupod.
    ! screws
    do ir = 1, nring
      nscr(ir) = mmode(ir)
      r1 = (ray(ir)-ray(ir-1))/2
      r0 = (ray(ir)+ray(ir-1))/2
      t0 = r0 / 2 / focus
      do is = 1, nscr(ir)
        ! coordinates of corner (or center if offset is zero)
        r = r0
        phi = 0
        if (xoscr(is,ir).lt.0) then
          r = ray(ir)
        elseif (xoscr(is,ir).gt.0) then
          r = ray(ir-1)
        endif
        if (yoscr(is,ir).lt.0) then
          phi = pi/npan(ir)
        elseif (yoscr(is,ir).gt.0) then
          phi = -pi/npan(ir)
        endif
        xscr(is,ir) = (r*cos(phi)-r0+(r**2-r0**2)/4/focus*t0)   &
          /sqrt(1+t0**2) + xoscr(is,ir)
        yscr(is,ir) = r*sin(phi) + yoscr(is,ir)
1999    format (a,i1,a,i1,a,f10.6)
      enddo
    enddo
    ! no hole whatsoever
    nhole = 0
    do ir = 1, nring
       do im = 1, mmode(ir)
          modes(im,ir) = im
       enddo
    enddo
    if (ant_type.eq.type_bure2) then
       modes(4,1) = 5 ! ring1: use mode 5 instead of 4
    endif
  !
  ! IRAM 30m antenna
  elseif (ant_type.eq.type_iram30m) then
    diameter = 30.
    focus = 10.500 
    nring = 7
    npan(1) = 10
    mmode(1) = 5  ! Five screws in ring 1 
    npan(2) = 20
    mmode(2) = 4
    npan(3) = 20
    mmode(3) = 5  ! Five screws in ring 3
    do i = 4, 7
      npan(i) = 40
      mmode(i) = 4
    enddo
    front_view = .false.
    ! external radius of each ring
    ray(0) =  1.000
    ray(1) =  2.885
    ray(2) =  5.040
    ray(3) =  7.050
    ray(4) =  9.210
    ray(5) = 11.175
    ray(6) = 13.040
    ray(7) = 15.000
    ! blockage ## TBD ## : this is the 15m values multiplied by 2 (!).
    ! updated to follow Baars (2013: http://jacobbaars.de/Start/Welcome_files/BlockingPaper.pdf)
    nblock = 3
    rblock(1) = ray(0)
    rblock(2) = 10.
    rblock(3) = 15.
    hblock(1) = 0.20
    hblock(2) = 0.45
    hblock(3) = 2.00 ! 0.80
    vblock = .false.           ! crossed (multiply shape) quadrupod.
    ! screws
    do ir = 1, nring
      nscr(ir) = mmode(ir)
      r1 = (ray(ir)-ray(ir-1))/2
      r0 = (ray(ir)+ray(ir-1))/2
      t0 = r0 / 2 / focus
      do is = 1, nscr(ir)
        ! coordinates of corner (or center if offset is zero)
        r = r0
        phi = 0
        if (xoscr30(is,ir).lt.0) then
          r = ray(ir)
        elseif (xoscr30(is,ir).gt.0) then
          r = ray(ir-1)
        endif
        if (yoscr30(is,ir).lt.0) then
          phi = pi/npan(ir)
        elseif (yoscr30(is,ir).gt.0) then
          phi = -pi/npan(ir)
        endif
        xscr(is,ir) = (r*cos(phi)-r0+(r**2-r0**2)/4/focus*t0)   &
          /sqrt(1+t0**2) + xoscr30(is,ir)
        yscr(is,ir) = r*sin(phi) + yoscr30(is,ir)
      enddo
    enddo
    ! no hole whatsoever
    nhole = 0
    do ir = 1, nring
       do im = 1, mmode(ir)
          modes(im,ir) = im
       enddo
    enddo
  !
  ! ALMA Test Interferometer Vextex 12m antenna
  elseif (ant_type.eq.type_vx12m) then
    diameter = 12.
    focus = 4.8
    nring = 8
    do i=1, nring
      mmode(i) = 5
    enddo
    do i = 1, 2
      npan(i) = 12
    enddo
    do i = 3, 4
      npan(i) = 24
    enddo
    do i = 5, 8
      npan(i) = 48
    enddo
    ray(0) = 0.375
    ray(1) = 1.265
    ray(2) = 1.821
    ray(3) = 2.605
    ray(4) = 3.221
    ray(5) = 4.041
    ray(6) = 4.781
    ray(7) = 5.435
    ray(8) = 6.000
    front_view = .true.
    ! blockage
    nblock = 9
    do i=1, nblock
      rblock(i) = rblock_vx(i)
      hblock(i) = hblock_vx(i)
    enddo
    vblock = .true.            ! vertical (plus shape)  quadrupod.
    ! screws
    ! 5 screws, ar radius rscr_vx and angle tscr_vx
    do ir = 1, nring
      nscr(ir) = mmode(ir)
      r0 = (ray(ir)+ray(ir-1))/2
      t0 = r0 / 2 / focus
      do is = 1, nscr(ir)
        r = rscr_vx(is,ir)
        phi = tscr_vx(is,ir)-pi/npan(ir)
        xscr(is,ir) = (r*cos(phi)-r0+(r**2-r0**2)/4/focus*t0)   &
          /sqrt(1+t0**2)
        yscr(is,ir) = r*sin(phi)
      !               print 1999, '     xscr(',is,',',ir,')=',xscr(is,ir)
      !               print 1999, '     yscr(',is,',',ir,')=',yscr(is,ir)
      enddo
    enddo
    ! Hole for Optical Telescope
    nhole = 1
    ! for this one the hole in on the left side when looking at the surface.
    xhole(1) = 3.530
    yhole(1) = 0.290
    rhole(1) = 0.140
    do ir = 1, nring
      do im = 1, mmode(ir)
        modes(im,ir) = im
      enddo
    enddo
    ! temperature coefficients
    numPol = 10
    do i = 1, numPol
      mPol(i) = mpol_vx(i)
      nPol(i) = npol_vx(i)
      coeffPol(i) = coeffPol_vx(i)*1e-6 ! in meters/kelvin
    enddo
    ! test
    !numPol = 1
    !nPol(1) = 4
    !mPol(1) = 0
    !coeffPol(1) = 1.0e-6
  !
  ! ALMA Test Interferometer AEC 12m antenna
  elseif (ant_type.eq.type_aec12m) then
    diameter = 12.
    focus = 4.8
    nring = 5
    do i=1, nring
      mmode(i) = 5
    enddo
    npan(1) = 8
    npan(2) = 16
    do i = 3, 5
      npan(i) = 32
    enddo
    ! approximate values for now
    ray(0) = 0.37500
    ray(1) = 1.50626
    ray(2) = 2.63028
    ray(3) = 3.75430
    ray(4) = 4.87833
    ray(5) = 6.00000
    front_view = .true.
    ! blockage
    nblock = 2
    do i=1, nblock
      rblock(i) = rblock_aec(i)
      hblock(i) = hblock_aec(i)
    enddo
    vblock = .false.           ! crossed (multiply shape)  quadrupod.
    ! screws
    ! 5 screws, ar radius rscr_vx and angle tscr_vx
    do ir = 1, nring
      nscr(ir) = mmode(ir)
      r0 = (ray(ir)+ray(ir-1))/2
      t0 = r0 / 2 / focus
      do is = 1, nscr(ir)
        r = rscr_aec(is,ir)/1000.
        phi = (tscr_aec(is,ir)/180.-1./npan(ir))*pi
        xscr(is,ir) = (r*cos(phi)-r0+(r**2-r0**2)/4/focus*t0)   &
          /sqrt(1+t0**2)
        yscr(is,ir) = r*sin(phi)
      !               print 1999, '     xscr(',is,',',ir,')=',xscr(is,ir)
      !               print 1999, '     yscr(',is,',',ir,')=',yscr(is,ir)
      enddo
    enddo
    ! hole for optical telescope
    nhole = 1
    ! for this one the hole in on the right side when looking at the surface.
    xhole(1) = -3.46*cos((5.625-1.45)/180*pi)
    yhole(1) = 3.46*sin((5.625-1.45)/180*pi)
    rhole=0.145
    do ir = 1, nring
      do im = 1, mmode(ir)
        modes(im,ir) = im
      enddo
    enddo

  ! ALMA Test Interferometer MELCO 12m antenna
  elseif (ant_type.eq.type_melco12m_1 .or. ant_type.eq.type_melco12m_2 .or. &
       ant_type.eq.type_melco12m_3 .or. ant_type.eq.type_melco12m_4) then
    diameter = 12.
    focus = 4.8
    nring = 7
    !
    ray(0) = 0.375
    mmode(1) = 5
    npan(1) =  5
    ray(1) = 0.770582
    !
    mmode(2) = 4
    npan(2) =  20
    ray(2) = 1.715753
    !
    mmode(3) = 5
    npan(3) =  20
    ray(3) = 2.621734
    !
    mmode(4) = 4
    npan(4) =  40
    ray(4) = 3.521014
    !
    mmode(5) = 5
    npan(5) =  40
    ray(5) = 4.393722
    !
    mmode(6) = 5
    npan(6) =  40
    ray(6) = 5.237261
    !
    mmode(7) = 5
    npan(7) =  40
    ray(7) = 6.0000
    !
    ! do this for other types as well...
    do ir = 1, 7
      do im = 1, mmode(ir)
        modes(im,ir) = im
      enddo
      if (ir.eq.2 .or. ir.eq.4) then
        modes(4,ir) = 5
      endif    
    enddo
    !
    front_view = .true.
    ! blockage
    nblock = 5
    do i=1, nblock
      rblock(i) = rblock_melco(i)
      hblock(i) = hblock_melco(i)
    enddo
    vblock = .true.            ! vertical (plus shape)  quadrupod.
    ! screws
    ! 4 or 5 screws, ar radius rscr_vx and angle tscr_vx
    do ir = 1, nring
      nscr(ir) = mmode(ir)
      r0 = (ray(ir)+ray(ir-1))/2
      t0 = r0 / 2 / focus
      do is = 1, nscr(ir)
        r = rscr_melco(is,ir)/1000.
        phi = ( tscr_melco(is,ir)/180. -1./npan(ir) )*pi
        xscr(is,ir) = (r*cos(phi)-r0+(r**2-r0**2)/4/focus*t0)   &
          /sqrt(1+t0**2)
        yscr(is,ir) = r*sin(phi)
      !               print 1999, '     xscr(',is,',',ir,')=',xscr(is,ir)
      !               print 1999, '     yscr(',is,',',ir,')=',yscr(is,ir)
      enddo
    enddo
    ! Hole for Optical Telescope
    nhole = 1
    ! for this one the hole in on the left side when looking at the surface.
    xhole(1) = 3.572951*sin(85.5/180*pi)
    yhole(1) = 3.572951*cos(85.5/180*pi)
    rhole(1) = 0.145
    !
    ! temperature coefficients
    if (ant_type.eq.type_melco12m_1) then
      numPol = 33
      do i = 1, numPol
        mPol(i) = mpol_melco(i)
        nPol(i) = npol_melco(i)
        !!      coeffPol(i) = coeffPol_melco(i)*1e-6 ! in meters/kelvin
        ! there is an ad-hoc normalization factor (0.5) here to reproduce the melco results.
        coeffPol(i) = coeffPol_melco_1(i)*1e-6*0.5
      enddo
    elseif (ant_type.eq.type_melco12m_2) then
      numPol = 69
      do i = 1, numPol
        mPol(i) = mpol_melco(i)
        nPol(i) = npol_melco(i)
        !!      coeffPol(i) = coeffPol_melco(i)*1e-6 ! in meters/kelvin
        ! there is an ad-hoc normalization factor (0.5) here to reproduce the melco results.
        coeffPol(i) = coeffPol_melco_2(i)*1e-6*0.5
      enddo
    elseif (ant_type.eq.type_melco12m_3) then
      numPol = 33
      do i = 1, numPol
        mPol(i) = mpol_melco(i)
        nPol(i) = npol_melco(i)
        !!      coeffPol(i) = coeffPol_melco(i)*1e-6 ! in meters/kelvin
        ! there is an ad-hoc normalization factor (0.5) here to reproduce the melco results.
        coeffPol(i) = coeffPol_melco_3(i)*1e-6*0.5
      enddo
    endif
  endif
  return
end subroutine set_panels
!
subroutine get_rigging(elevation, riggingElevation, correction, error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  !
  !---------------------------------------------------------------------
  include 'clic_panels.inc'
  real :: elevation, riggingElevation(2), correction(mring, mpan, mm)
  logical error
  ! Global
  include 'gbl_pi.inc'
  ! Local
  integer ::  lun, ier, iring, ipanel, iscrew, i
  real :: def_bias, def_elev, dy, dz, x, y, cz, cy
  character :: infile*256, chain*256, file*256
  !
  error = sic_getlun(lun).ne.1
  if (error) then
    call message(8,4,'Get_rigging','No logical unit left')
    return
  endif
  ! get data from file
  if (ANT_TYPE.eq.TYPE_VX12M) then 
    infile = 'gravDef_VERTEX_12.dat'
  elseif (ANT_TYPE.eq.TYPE_AEC12M) then
    infile = 'gravDef_AEC_12.dat'
  elseif (ant_type.ge.type_melco12m_1 .and. ant_type.le.type_melco12m_4) then
    infile = 'gravDef_MITSUBISHI_12.dat'
  elseif (ant_type.eq.type_iram30m) then
    infile = 'gravDef_30m.dat'
  endif
  if (.not.sic_query_file(infile,'data#dir:','',file)) then
    call message(8,4,'Get_rigging','Deformation file not found')
    error = .true.
    return
  endif



  open (lun, file=file(1:lenc(file)), err=999)
  read(lun,'(a)', err=999) chain
  read(lun,'(a)', err=999) chain
  i = 1
10 read (lun, *, end=20, err=999) iring, ipanel, iscrew, x, y, dy, dz
  ! the deformation are tabulated in micrometers...
  dy = dy/1e6
  dz = dz/1e6
  
  ! deformation bias set to be:
  def_bias = dz*(sin(riggingElevation(1)) + sin(riggingElevation(2)))/2.   &
       + dy*(cos(riggingElevation(1)) + cos(riggingElevation(2)))/2.
          
  ! deformation at observed elevation:
  def_elev = (dz*sin (elevation) + dy*cos(elevation)) 
  ! compute correction in meters.
  ! The correction to be added to screw motions is the opposite of the
  ! differential gravitational deformation.
  correction(iring, ipanel, iscrew) = def_elev - def_bias

  i = i+1
  goto 10
20 close(lun)
  call sic_frelun(lun)
  return
999 error = .true.
  call message(8,4,'Get_rigging','No logical unit left')
  
  return


end subroutine get_rigging


subroutine rigging_mode(phas,nxap,xref,xval,xinc,rlam,   &
     elevation, riggingElevation, error)
  include 'clic_panels.inc'
  logical :: error
  integer :: nxap                   !
  real :: phas(nxap,nxap)           !
  real, allocatable :: correction(:,:,:)
  real :: xref                      !
  real :: xval                      !
  real :: xinc                      !
  real :: rlam, xx, yy, fmode                      !
  real :: am(mm,mring,mpan)         !
  real :: ae(mm,mring,mpan)         !
  real :: elevation, riggingElevation(2)             !  
  integer :: nmode 
  integer :: ir, ip, is, i, j, k, im, nm
  real*8 :: a(mm, mm), b(mm), sig

  allocate(correction(mring, mpan, mm))
  call get_rigging(elevation, riggingElevation, correction, &
       error)
  if (error) then
    write(6,*) 'No gravitational deformation available.'
    return
  endif
  write(6,*) 'Found gravitational deformation data.'
  do ir = 1, nring
    do ip=1,npan(ir)
      k = 0
      do is = 1, nscr(ir)
        xx = xscr(is,ir)
        yy = yscr(is,ir)
        nm = mmode(ir)
        do im=1, nm
          a(is,im) = fmode(im,ir,xx,yy)
        enddo
        b(is) = correction(ir, ip, is)
      enddo
      call mth_fitlin ('MODE',nscr(ir),nm,a,b,mm,sig)
      do k=1, nscr(ir)
        am(k,ir,ip) = b(k)
      enddo
    enddo
  enddo
  nmode = 5
  call modemap(phas,nxap,rlam, xref, xval, xinc, am, ae, nmode)
  ! 
  !print *, '*** rigging_mode OK ***'
      
end subroutine rigging_mode

subroutine temperature_mode(phTemp, nxap, xref, xval, xinc, rlam,   &
     temperature, biasTemperature, error)
  ! should we fit panbel shapes in the modeled temp deformation or use it
  !  directly...
  ! Global
  include 'gbl_pi.inc'
  include 'clic_panels.inc'
  logical :: error
  integer :: nxap                   !
  real :: phTemp(nxap,nxap)           !
  real :: xref, xval, xinc                      !
  real :: rlam, temperature, biasTemperature
 
  ! local variables:
  integer :: ix, iy, k
  real*8 :: x, y, phi, rad2, rho, zpol, apol, pol, cosa, radius
  !
  radius = diameter/2
  do  iy = 1, nxap
    y = xval+xinc*(iy-xref)
    do ix = 1, nxap
      x = xval+xinc*(ix-xref)
      phi = atan2(y, x)
      rad2 = x**2 + y**2
      rho = sqrt(rad2) /radius
      zpol = 0
      do k=1, numPol
        call zernike_poly ( abs(mPol(k)), nPol(k),  rho, apol )
        if (mPol(k).gt.0) then
          pol = apol*cos(mPol(k)*phi)* sqrt(2*(nPol(k)+1)/pis)
        elseif (mPol(k).lt.0) then
          pol = apol*sin(mPol(k)*phi)* sqrt(2*(nPol(k)+1)/pis)
        else
          pol = apol*sqrt((nPol(k)+1)/pis)
        endif
        zpol = zpol + pol * coeffpol(k) * (biasTemperature-temperature)
      enddo
      cosa  =  1./sqrt(1.+rad2/4/focus**2)
      ! they have defined the pol expansion in half pathlength, 
      ! not normal displacement.
      !! phTemp(ix,iy) = 4.*pis*zpol*cosa/rlam   !aperture phase
      phTemp(ix,iy) = 4.*pis*zpol/rlam   !aperture phase
      !! phTemp(ix,iy) = phTemp(ix,iy) * sqrt(pis) ! ad hoc ?
    enddo
  enddo
end subroutine temperature_mode

!------------------------------------------------------------------------- 
subroutine zernike_poly ( m, n, rho, z )

  !*****************************************************************************80
  !
  !! ZERNIKE_POLY evaluates a Zernike polynomial at RHO.
  !
  !  Discussion:
  !
  !    This routine uses the facts that:
  !
  !    *) R^M_N = 0 if M < 0, or N < 0, or N < M.
  !    *) R^M_M = RHO^M
  !    *) R^M_N = 0 if mod ( N - M ) = 1.
  !
  !    and the recursion:
  !
  !    R^M_(N+2) = A * [ ( B * RHO**2 - C ) * R^M_N - D * R^M_(N-2) ]
  !
  !    where 
  !
  !    A = ( N + 2 ) / ( ( N + 2 )**2 - M**2 )
  !    B = 4 * ( N + 1 )
  !    C = ( N + M )**2 / N + ( N - M + 2 )**2 / ( N + 2 )
  !    D = ( N**2 - M**2 ) / N
  !
  !    I wish I could clean up the recursion in the code, but for
  !    now, I have to treat the case M = 0 specially.
  !
  !  Licensing:
  !
  !    This code is distributed under the GNU LGPL license. 
  !
  !  Modified:
  !
  !    11 November 2005
  !
  !  Author:
  !
  !    John Burkardt
  !
  !  Reference:
  !
  !    Eric Weisstein,
  !    CRC Concise Encyclopedia of Mathematics,
  !    CRC Press, 2002,
  !    Second edition,
  !    ISBN: 1584883472,
  !    LC: QA5.W45
  !
  !  Parameters:
  !
  !    Input, integer ( kind = 4 ) M, the upper index.
  !
  !    Input, integer ( kind = 4 ) N, the lower index.
  !
  !    Input, real ( kind = 8 ) RHO, the radial coordinate.
  !
  !    Output, real ( kind = 8 ) Z, the value of the Zernike 
  !    polynomial R^M_N at the point RHO.
  !
  ! 
  implicit none

  real    ( kind = 8 ) a
  real    ( kind = 8 ) b
  real    ( kind = 8 ) c
  real    ( kind = 8 ) d
  integer ( kind = 4 ), parameter :: i4_2 = 2
  integer ( kind = 4 ) m
  integer ( kind = 4 ) n
  integer ( kind = 4 ) nn
  real    ( kind = 8 ) rho
  real    ( kind = 8 ) z
  real    ( kind = 8 ) zm2
  real    ( kind = 8 ) zp2
  !
  !  Do checks.
  !
  if ( m < 0 ) then
    z = 0.0D+00
    return
  end if

  if ( n < 0 ) then
    z = 0.0D+00
    return
  end if

  if ( n < m ) then
    z = 0.0D+00
    return
  end if

  if ( mod ( n - m, i4_2 ) == 1 ) then
    z = 0.0D+00
    return
  end if

  zm2 = 0.0D+00
  z = rho**m

  if ( m == 0 ) then

    if ( n == 0 ) then
      return
    end if

    zm2 = z
    z = 2.0D+00 * rho**2 - 1.0D+00

    do nn = m+2, n-2, 2

      a = real ( nn + 2, kind = 8 ) / real ( ( nn + 2 )**2 - m**2, kind = 8 )
      b = real ( 4 * ( nn + 1 ), kind = 8 )
      c = real ( ( nn + m )**2, kind = 8 ) / real ( nn, kind = 8 ) &
           + real ( ( nn - m + 2 )**2, kind = 8 ) / real ( nn + 2, kind = 8 )
      d = real ( nn**2 - m**2, kind = 8 ) / real ( nn, kind = 8 )

      zp2 = a * ( ( b * rho**2 - c ) * z - d * zm2 ) 
      zm2 = z
      z = zp2

    end do

    

  else

    do nn = m, n-2, 2

      a = real ( nn + 2, kind = 8 ) / real ( ( nn + 2 )**2 - m**2, kind = 8 )
      b = real ( 4 * ( nn + 1 ), kind = 8 )
      c = real ( ( nn + m )**2, kind = 8 ) / real ( nn, kind = 8 ) &
           + real ( ( nn - m + 2 )**2, kind = 8 ) / real ( nn + 2, kind = 8 )
      d = real ( nn**2 - m**2, kind = 8 ) / real ( nn, kind = 8 )

      zp2 = a * ( ( b * rho**2 - c ) * z - d * zm2 ) 
      zm2 = z
      z = zp2

    end do

  end if

  return
end subroutine zernike_poly

