subroutine clic_grid_tp(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api  
  use clic_xypar
  !---------------------------------------------------------------------
  ! CLIC
  ! GRID_TOTAL computes a total power map.
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_display.inc'
  include 'gbl_pi.inc'
  include 'gbl_memory.inc'
  include 'clic_panels.inc'
  include 'clic_proc_par.inc'
  ! Local
  logical :: do_plot
  logical :: plot, end
  logical :: err
  integer :: ll
  integer :: iant, nx, ny, lc, i, nxmap, nymap, lsc1, j, if, nn, nd
  real :: dx, dy, vx, vy
  real :: xmin, xmax, ymin, ymax, x1, x2, y1,y2, rx, ry
  integer :: m_work, nmode, nh1, nh2, nvis, mvis
  real :: ix,iy,iz
  integer :: lmap, ivis, niter, narg, k
  real :: rlam, xref, xval, xinc, beamsize
  integer(kind=address_length) :: ipx, ipy, ipw, ipwork, ipwork2
  integer(kind=address_length) :: i_work, addrvis, ipvis, ipp
  character(len=256) :: chain, h1, h2
  real :: tmin, tmax, thres, fudge
  !
  integer :: nk
  character(len=12) :: arg
  real ::      lambda1, lambda2, beta1, beta2, msize
  save  addrvis, mvis
  !
  !------------------------------------------------------------------------
  ! Code:
  plot = sic_present(1,0)
  tmin = 0.
  tmax = 0.
  if (plot) then
    call sic_r4(line,1,1,tmin,.false.,error)
    if (error) goto 999
    call sic_r4(line,1,2,tmax,.false.,error)
    if (error) goto 999
  endif
  ! size in arc seconds (for baseline)
  msize = 0.
  call sic_r4(line,0,1,msize,.false.,error)
  if (error) goto 999
  fudge = 0.
  call sic_r4(line,0,2,fudge,.false.,error)
  if (error) goto 999
  !
  call check_input_file(error)
  if (error) goto 999
  call check_index(error)
  if (error) goto 999
  call get_first(.true.,error)
  if (error) goto 999
  call switch_antenna
  iant = -i_base(1)
  write(6,*) 'I-GRID_TOTAL, Using Antenna ', r_kant(iant)
  !
  ! Count measurement points (`visibilities')
  !
  nvis = 0
  call get_first(.true.,error)
  if (error) goto 999
  end = .false.
  do while (.not.end)
    nvis = nvis + r_ndump
    call get_next(end,error)
    if (error) goto 999
  enddo
  !
  ! Get memory for visibility table (4 columns: lam, beta, weight, tp)
  !
  if (mvis.lt.nvis*4) then
    if (mvis.gt.0) call free_vm(mvis,addrvis)
    mvis= 4*nvis
    if (sic_getvm(mvis,addrvis).ne.1) goto 999
  endif
  ipvis = gag_pointer(addrvis,memory)
  !
  ! Get the visibility table : pointer ipvis
  ! get also map limits
  !
  lambda1 = 1e10
  lambda2 = -1e10
  beta1 = 1e10
  beta2 = -1e10
  ivis = 0
  call get_first(.true.,error)
  if (error) goto 999
  end = .false.
  do while (.not.end)
    call load_tp(iant, nvis, ivis, memory(ipvis),   &
      lambda1, lambda2, beta1, beta2, msize, fudge, error)
    if (error) goto 999
    call get_next(end,error)
    if (error) goto 999
  enddo
  !
  ! Get map size
  if (r_teles.eq.'VTX-ALMATI') then
    write(6,*) 'I-GRID_TOTAL, ALMA Vertex 12m Antenna '
    call set_panels(type_vx12m)
  elseif (r_teles.eq.'AEC-ALMATI') then
    write(6,*) 'I-GRID_TOTAL, ALMA AEC 12m Antenna '
    call set_panels(type_aec12m)
  else
    write(6,*) 'I-GRID_TOTAL, IRAM/Bure 15-m Antenna '
    call set_panels(type_bure)
  endif
  ! this is the half power  beam size
  beamsize = 41*(115000./r_flo1)*(15./diameter)   &
    *pi/180/3600
  dx = beamsize/4.
  dy = beamsize/4.
  nx = (lambda2-lambda1)*pi/180/3600 /dx + 1
  ny = (beta2-beta1)*pi/180/3600  /dy + 1
  rx = (nx+1)/2
  ry = (ny+1)/2
  vx = lambda1*pi/180/3600 +(rx-1.)*dx
  vy = beta1*pi/180/3600 +(ry-1.)*dy
  !
  print 1000, 'I-GRID_TOTAL, Beamsize ',beamsize*180*3600/pi, '"'
1000 format(a,f8.1,a)
  print 1001, 'I-GRID_TOTAL, Map size ', nx,' x ', ny,   &
    '(',nx*dx*180*3600/pi, ' x ',ny*dy*180*3600/pi, '")'
1001 format(a,i3,a,i3,a,f8.1,a,f8.1,a)
  !
  !     Create map file
  call open_tpmap(nx, ny, rx, ry, vx, vy, dx, dy,   &
    r_kant(iant), error)
  if (error) goto 999
  ipx = gag_pointer(xima%loca%addr,memory)
  !
  ! Grid the visibility table into the visibility (beam) map (in X)
  !
  nd = 1+3
  ! Weight Threshold for blanking
  thres = 0.
  call sub_grid(nvis, memory(ipvis), beamsize, nd, thres, error)
  !
  ! formally transpose (note that xima%gil%dim(1) = 1 ...)
  xima%gil%dim(1) = xima%gil%dim(2)
  xima%gil%ref(1) = xima%gil%ref(2)
  xima%gil%val(1) = xima%gil%val(2)
  xima%gil%inc(1) = xima%gil%inc(2)
  xima%gil%dim(2) = xima%gil%dim(3)
  xima%gil%ref(2) = xima%gil%ref(3)
  xima%gil%val(2) = xima%gil%val(3)
  xima%gil%inc(2) = xima%gil%inc(3)
  xima%gil%dim(3) = 1
  xima%gil%ref(3) = 1.0
  xima%gil%val(3) = 0.0
  xima%gil%inc(3) = 1.0
  xima%char%code(1) = xima%char%code(2)
  xima%char%code(2) = xima%char%code(3)
  !
  ! Mask outper parts
  if (msize.gt.0) then
    call mask_tpmap(xima%gil%dim(1), xima%gil%dim(2), memory(ipx), msize)
  endif
  !
  ! Optionally plot
  if (plot) then
    call plot_tpmap(tmin, tmax, error)
  endif
  ll = lenc(line)
  !
  ! Close files and return
  ! call gdf_fris (xima%loca%islo,error)
  call gdf_write_data (xima, xima%r2d, error)
  call gdf_close_image (xima, error)
  return
  !
999 error = .true.
end subroutine clic_grid_tp
!
subroutine load_tp(iant,nvis,ivis,vis,   &
    lambda1, lambda2, beta1, beta2, msize, fudge, error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_xypar
  use clic_rdata
  !---------------------------------------------------------------------
  ! CLIC
  !	Support routine for GRID_TP
  ! Arguments:
  !	IANT	I	antenna used
  !       TIME_MAX R*4    Max. integration time (compression)
  !---------------------------------------------------------------------
  integer :: iant                   !
  integer :: nvis                   !
  integer :: ivis                   !
  real :: vis(4,nvis)               !
  real :: lambda1                   !
  real :: lambda2                   !
  real :: beta1                     !
  real :: beta2                     !
  real :: msize                     !
  real :: fudge                     !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_point.inc'
  include 'gbl_memory.inc'
  include 'gbl_pi.inc'
  include 'clic_number.inc'
  include 'clic_proc_par.inc'
  ! Local
  real :: my_total
  !
  integer(kind=address_length) :: data_in, ipk
  integer(kind=address_length) :: addrvis2, ipvis2,  ipc, ipl, iph
  integer(kind=data_length)    :: ldata_in, h_offset
  logical :: useit
  integer :: mdump, j, i_loop
  integer :: iband, ix, iy, jw1, jw2, ib, ir, iv, im, ja, k
  real :: vt(4,3), wt(4,3), dlam, sign, p_tolerance, msrad
  real :: f
  integer :: pvis, kvis, mvis2, kfudge, i
  save mvis2, addrvis2
  data mvis2/0/
  !
  !------------------------------------------------------------------------
  !
  error = .false.
  p_tolerance=500
  !
  call get_data (ldata_in,data_in,error)
  if (error) goto 999
  !
  ! Loop on records
  print *, 'fudge ',fudge
  kvis = ivis
  ipk = gag_pointer(data_in,memory)
  do i_loop = 1, n_loop
    do ir = rec_1(i_loop), min(r_ndump,rec_2(i_loop)),   &
        rec_3(i_loop)
      iph = ipk + h_offset(ir)
      call decode_header (memory(iph))
      if (ivis.lt.nvis .and.   &
        (max(abs(dh_rmspe(1,iant)),   &
        abs(dh_rmspe(2,iant))).lt. p_tolerance) )   &
        then
        ivis = ivis + 1
        vis(1,ivis) = dh_offlam(iant)   &
          *pi/180/3600
        vis(2,ivis) = dh_offbet(iant)*pi/180/3600
        vis(3,ivis) = dh_integ ! as weight.
        !c               vis(4,ivis) = dh_total(iant)
        vis(4,ivis) = my_total(do_polar,iant)
        !
        lambda1 = min(dh_offlam(iant), lambda1)
        lambda2 = max(dh_offlam(iant), lambda2)
        beta1 = min(dh_offbet(iant), beta1)
        beta2 = max(dh_offbet(iant), beta2)
      endif
    enddo
  enddo
  !
  if (fudge.ne.0) then
    f = fudge*pi/180/3600
    if (abs(vis(1,ivis)-vis(1,kvis+1))   &
      .gt.abs(vis(2,ivis)-vis(2,kvis+1))) then
      kfudge = 1
    else
      kfudge = 2
    endif
    if (vis(kfudge,ivis).gt.vis(kfudge,kvis)) then
      do i = kvis+1, ivis
        vis(kfudge,i) =  vis(kfudge,i) + f
      enddo
    else
      do i = kvis+1, ivis
        vis(kfudge,i) =  vis(kfudge,i) - f
      enddo
    endif
  endif
  !
  if (msize .gt. 0) then
    pvis = ivis-kvis
    if (mvis2.lt.pvis*6) then
      if (mvis2.gt.0) call free_vm(mvis2, addrvis2)
      mvis2= pvis*6
      if (sic_getvm(mvis2,addrvis2) .ne. 1) goto 999
    endif
    ipvis2 = gag_pointer(addrvis2, memory)
    msrad = msize*pi/180/3600
    call do_baseline(pvis, vis(1,kvis+1), msrad,   &
      memory(ipvis2), memory(ipvis2+4*pvis),error)
  endif
  if (error) goto 999
  return
  !
999 error = .true.
  return
end subroutine load_tp
!
subroutine do_baseline(pvis, vis, msize, a, b, error)
  use gildas_def
  integer :: pvis                   !
  real :: vis(4,pvis)               !
  real :: msize                     !
  real*8 :: a(pvis,2)               !
  real*8 :: b(pvis)                 !
  logical :: error                  !
  ! Local
  integer :: nvar, mvis, i, k, ndd, kx
  real*8 :: sigma
  !
  nvar = 2
  i = 0
  if (abs(vis(1,pvis)-vis(1,1)).gt.(abs(vis(1,pvis)-vis(1,1)))) then
    kx = 1
  else
    kx = 2
  endif
  do k=1, pvis
    if ((abs(vis(1,k)).gt.msize/2)   &
      .or. (abs(vis(2,k)).gt.msize/2)) then
      i = i + 1
      a(i,1) = vis(kx,k)
      a(i,2) = 1
      b(i) = vis(4,k)
    endif
  enddo
  ndd = i
  if (ndd.lt.2) then
    call message(8,4,'DO_BASELINE','Too few baseline points')
    error = .true.
    return
  endif
  call mth_fitlin ('DO_BASELINE',ndd,nvar,a,b,pvis,sigma)
  do k=1, pvis
    vis(4,k) = vis(4,k) - b(1)*vis(kx,k) - b(2)
  enddo
end subroutine do_baseline
!
subroutine open_tpmap(nx,ny,rx,ry,vx,vy,dx,dy,iant,error)
  use gildas_def
  use gkernel_interfaces
  use gbl_format
  use classic_api  
  use clic_xypar
  !---------------------------------------------------------------------
  ! Open map GDF files
  ! input:
  !     NX, NY number of pixel on each axis for beam map
  !     DX, DY coordinate increments, in radians!
  !     RX, RY pixel numbers for center (0,0)
  !     IANT   physical number of antenna
  !     ERROR  error return
  !---------------------------------------------------------------------
  integer :: nx                     !
  integer :: ny                     !
  real :: rx                        !
  real :: ry                        !
  real :: vx                        !
  real :: vy                        !
  real :: dx                        !
  real :: dy                        !
  integer :: iant                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_display.inc'
  include 'gbl_pi.inc'
  ! Local
  integer :: iband
  integer :: nxmap, nymap
!  integer(kind=index_length) :: blc(4),trc(4)
  integer :: i
  real :: wvl, factor
  ! Data
!  data blc/4*0/, trc/4*0/
  !-----------------------------------------------------------------------
  error = .false.
  call gildas_null(xima)
  !
  write (xima%file(1:5),'(i4.0,a1)') r_scan,'-'
  call datec (r_dobs,xima%file(6:16),error)
  i = lenc(r_sourc)
  xima%file(17:) = '-'//r_sourc(1:i)//'-beam.tpm'
  i = lenc(xima%file)
  call sic_lower(xima%file(1:i))
  xima%gil%blan_words = 2
  xima%gil%extr_words = 6
  xima%gil%desc_words = 18
  xima%gil%posi_words = 12
  xima%gil%proj_words = 9
  xima%gil%spec_words = 12
  xima%gil%reso_words = 3
  xima%gil%bval = -1000.
  xima%gil%eval = 0.1
  !
  xima%gil%dim(1) = 1
  xima%gil%ref(1) = 1.0
  xima%gil%val(1) = 0.0
  xima%gil%inc(1) = 1.0
  xima%gil%dim(2) = nx
  xima%gil%ref(2) = rx
  xima%gil%val(2) = vx
  xima%gil%inc(2) = dx
  xima%gil%dim(3) = ny
  xima%gil%ref(3) = ry
  xima%gil%val(3) = vy
  xima%gil%inc(3) = dy
  xima%gil%dim(4) = 1
  xima%gil%ndim = 3
  ! Note: could not find the 'recommended' designations
  xima%char%code(2) = 'AZ'             !!!  'RA'
  xima%char%code(3) = 'EL'             !!! 'DEC'
  xima%char%unit = 'Jy'
  xima%char%syst = 'UNKNOWN'           !!! 'EQUATORIAL'
  xima%char%name = r_sourc
  xima%gil%ra = r_az
  xima%gil%dec = r_el
  xima%gil%epoc = r_epoch
  xima%gil%ptyp = p_azimuthal
  xima%gil%a0 = xima%gil%ra
  xima%gil%d0 = xima%gil%dec
  xima%gil%pang = 0.0
  xima%gil%xaxi = 0
  xima%gil%yaxi = 0
  xima%char%line = r_line
  iband = i_band(1)
  if (iband.eq.1) then
    xima%gil%freq = r_flo1+r_fif1
  elseif (iband.eq.2) then
    xima%gil%freq = r_flo1-r_fif1
  else
    xima%gil%freq = r_flo1
  endif
  xima%loca%size = xima%gil%dim(1) * xima%gil%dim(2) * xima%gil%dim(3)
  xima%gil%form = fmt_r4
  xima%char%type = 'GILDAS_IMAGE'
  !
!  call gdf_geis (xima%loca%islo,error)
!  if (error) return
!  call gdf_writ (xima,xima%loca%islo,error)
!  if (error) return
!  call gdf_cris (xima%loca%islo,xima%char%type,xima%file,xima%gil%form,xima%loca%size,error)
!  if (error) return
!  call gdf_gems (xima%loca%mslo,xima%loca%islo,blc,trc,xima%loca%addr,xima%gil%form,error)
!  if (error) return
  call gdf_create_image (xima, error)
  call gdf_allocate(xima, error)
  xima%loca%addr = locwrd (xima%r2d)
  !
  return
end subroutine open_tpmap
!
subroutine plot_tpmap(tmin, tmax, error)
  use gildas_def
  use gkernel_interfaces
  use clic_xypar
  !---------------------------------------------------------------------
  !
  !---------------------------------------------------------------------
  real :: tmin                      !
  real :: tmax                      !
  logical :: error                  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer :: nx, ny, lch, nexpo, n1, n2
  integer(kind=address_length) :: ipx
  real :: range, am, sp
  real*8 :: conv(6)
  character(len=132) :: ch
  !---------------------------------------------------------------------
  nx = xima%gil%dim(1)
  conv(1:3) = xima%gil%convert(:,1)
  ny = xima%gil%dim(2)
  conv(4:6) = xima%gil%convert(:,2)
  ipx = gag_pointer(xima%loca%addr,memory)
  !      print *, 'nx, ny, conv, ipx'
  !      print *, nx, ny, conv, ipx
  if (nx.lt.2) then
    call message(8,3,'plot_tpmap','Only one pixel or less in X')
    error = .true.
    return
  endif
  if (ny.lt.2) then
    call message(8,3,'plot_tpmap','Only one pixel or less in Y')
    error = .true.
    return
  endif
  call gr4_rgive(nx, ny, conv, memory(ipx))
  call gr_exec('DESTROY ALL')
  !
  ! Box and image
  if (tmin.eq.tmax) then
    call t_extr(nx*ny, memory(ipx), xima%gil%bval, xima%gil%eval, tmin, tmax)
  endif
  if (tmin.eq.tmax) then
    error = .true.
    return
  endif
  call gr_exec('LIMITS /RG')
  call gr_exec('SHOW LIMITS')
  ! test limits
  call check_limits(error)
  if (error) return
  call gr_exec('SET BOX MATCH')
  write (ch,'(a, 2e12.4, a, 2e12.4)')   &
    'PLOT /SCALING LINEAR ',tmin, tmax,   &
    ' /BLANKING ',xima%gil%bval, xima%gil%eval
  lch = lenc(ch)
  call gr_exec(ch(1:lch))
  call gr_exec('WEDGE')
  call gr_exec('BOX /UNIT S')
  call gr_exec('LABEL "Az. Offset (`)" /X')
  call gr_exec('LABEL "El. Offset (`)" /Y')
  !
  ! Contours
  range = log10(abs(tmax-tmin))
  nexpo = int(20.+range)-21
  am = range-nexpo-1
  sp = 10.**(nexpo+1)
  if (am.lt.0.25) then
    sp = 2.*10.**nexpo
  elseif (am.lt.0.60) then
    sp = 5.*10.**nexpo
  elseif (am.lt.0.90) then
    sp = 10.*10.**nexpo
  else
    sp = 2.*10.**(nexpo+1)
  endif
  n1 = int(tmin/sp)
  n2 = int(tmax/sp)+1
  if (n1*n2 .gt.0) then
    write (ch,'(3(a,e10.3))') 'LEVEL ',n1*sp,   &
      ' to ',n2*sp,' by ',sp
  else
    write (ch,'(6(a,e10.3))') 'LEVEL ',n1*sp,' to ',-sp,   &
      ' by ',sp,' ',sp,' to ',n2*sp,' by ',sp
  endif
  lch = lenc(ch)
  call gr_exec(ch(1:lch))
  write (ch,'(a, 2e10.3)') 'RGMAP QUIET /BLANK ',   &
    xima%gil%bval, xima%gil%eval
  lch = lenc(ch)
  call gr_exec2(ch(1:lch))
  write (ch,'(a,g10.3)') 'Contour step ',sp
  lch = lenc(ch)
  call gr_exec('DRAW TEXT -0.1 -0.1 "'//ch(1:lch)//'" 1 /BOX 9')
  !
  call out0('Chain',1.,1.,error)
  call titout('Brief',error)
  call out2(ch,error)
  lch = lenc(ch)
  call gr_exec('DRAW TEXT 0. 0.1 "'//ch(1:lch)//'" 9 /BOX 7')
  !
  call gtclal
  call gr_execl('CHANGE DIRECTORY <GREG')
999 return
end subroutine plot_tpmap
!
subroutine t_extr(n, y, bval, eval, ymin, ymax)
  integer :: n                      !
  real :: y(n)                      !
  real :: bval                      !
  real :: eval                      !
  real :: ymin                      !
  real :: ymax                      !
  ! Local
  integer :: i
  !
  ymin = 1e30
  ymax = -1e30
  do i=1, n
    if (abs(y(i)-bval).gt.eval) then
      ymin = min (ymin, y(i))
      ymax = max (ymax, y(i))
    endif
  enddo
end subroutine t_extr
!
subroutine mask_tpmap(nx,ny, tp, size)
  use gildas_def
  use clic_xypar
  integer :: nx                     !
  integer :: ny                     !
  real :: tp(nx,ny)                 !
  real :: size                      !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real :: s
  integer :: i, j
  real :: x, y
  s = size*pi/180./3600./2.
  do j = 1,  ny
    y = (j-xima%gil%ref(2))*xima%gil%inc(2) + xima%gil%val(2)
    do i = 1, nx
      x = (i-xima%gil%ref(1))*xima%gil%inc(1) + xima%gil%val(1)
      if ((abs(y).gt.s).or.(abs(x).gt.s)) then
        tp(i,j) = xima%gil%bval
      endif
    enddo
  enddo
  return
end subroutine mask_tpmap
!
subroutine check_limits(error)
  use gkernel_interfaces
  logical :: error                  !
  ! Local
  real :: uxmin, uymin, uxmax, uymax, bxmin, bxmax, bymin, bymax
  real :: r, scalex, scaley
  character(len=80) :: ch
  integer :: l
  !
  call sic_get_real('USER_XMIN',uxmin,error)
  call sic_get_real('USER_XMAX',uxmax,error)
  call sic_get_real('USER_YMIN',uymin,error)
  call sic_get_real('USER_YMAX',uymax,error)
  call sic_get_real('BOX_XMIN',bxmin,error)
  call sic_get_real('BOX_XMAX',bxmax,error)
  call sic_get_real('BOX_YMIN',bymin,error)
  call sic_get_real('BOX_YMAX',bymax,error)
  if (uxmin.eq.uxmax .or. uymin.eq.uymax) then
    call message(8,3,'CHECK_LIMITS', 'Invalid User limits')
    error = .true.
  endif
  if (bymin.eq.bymax .or. bymin.eq.bymax) then
    call message(8,3,'CHECK_LIMITS', 'Invalid Box limits')
    error = .true.
  endif
end subroutine check_limits
