subroutine reproject_comm(line,error)
  use image_def
  use imager_interfaces, except_this => reproject_comm &
    & , no_interface => s_reproject_do
  use gkernel_interfaces, no_interface1 => gdf_copy_header
  use gkernel_types
  use gbl_message
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for command
  !
  ! REPROJECT Out In 
  !   /BLANKING Bval Eval
  !   /LIKE Template
  !   /PROJECTION Type Cx Cy [Angle]
  !   /SYSTEM Type [Equinox]
  !   /X_AXIS Nx Ref Val Inc
  !   /Y_AXIS Ny Ref Val Inc
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(out) :: error
  !
  integer, parameter :: o_blank=1
  integer, parameter :: o_like=2
  integer, parameter :: o_proj=3
  integer, parameter :: o_syst=4
  integer, parameter :: o_xaxis=5
  integer, parameter :: o_yaxis=6
  real(8), parameter :: pi=3.141592653589793d0
  character(len=1), parameter :: question_mark='?'
  character(len=*), parameter :: rname='REPROJECT'
  !
  character(len=13) :: argum,keywor,projnam_array(0:mproj)
  character(len=64) :: args
  integer(kind=4), parameter :: msys=5
  character(len=13) :: system(msys)
  data system /'UNKNOWN','EQUATORIAL','GALACTIC','HORIZONTAL','ICRS'/
  !
  type(gildas) :: gin, gout, gtemp
  character(len=filename_length) :: fich
  integer :: nsys, nkey
  integer :: sys_code, i
  integer :: n, rank, type, istart, length, nc
  real(kind=4) :: equinox
  real(kind=8) :: ra, dec, ang, convert(3)
  type(sic_descriptor_t) :: desc
  logical :: found, is_image, in_image, out_image, rdonly
  integer(kind=address_length) :: addr, ipin, ipou
  integer(kind=4), save :: memory(2)
  !
  call gildas_null(gin)
  call sic_ch(line,0,2,fich,n,.true.,error)
  in_image = .false.
  call sub_readhead (rname,fich,gin,in_image,error,rdonly,fmt_r4)
  if (error) return
  !
  rank=3
  call gdf_trim_header(gin,rank,error)  
  if (error) return
  !
  ! Template can be a SIC variable or a Gildas file...  !
  if (sic_present(o_like,0)) then
    if (sic_present(o_proj,0).or.sic_present(o_xaxis,0).or. &
        & sic_present(o_yaxis,0).or.sic_present(o_syst,0)) then
      call map_message(seve%e,rname,'/FILE option is incompatible ' &
        & //'with /PROJECTION, /SYSTEM, /X_AXIS and /Y_AXIS')
      error = .true.
      return
    endif
    ! Get shape from Template
    call sic_ch(line,o_like,1,fich,n,.true.,error)
    is_image = .false.
    call sub_readhead(rname,fich,gtemp,is_image,error)
  else
    ! Get shape from Input file, modified by other options
    call gildas_null(gtemp)
    call gdf_copy_header(gin,gtemp,error)
    if (error) return
    !
    if (sic_present(o_proj,0)) then
      call sic_ke(line,o_proj,1,argum,n,.true.,error)
      if (argum.ne.'*') then
        ! Solve the Ambiguity
        ! Set the projection type
        call projnam_list(projnam_array)
        call sic_ambigs(rname,argum,keywor,nkey,projnam_array,mproj+1,error)
        if (error) return
        gtemp%gil%ptyp = nkey-1
      endif
      !
      argum = '*'
      call sic_ke(line,o_syst,1,argum,n,.false.,error)
      if (argum.ne.'*') then
        call sic_ambigs(rname,argum,keywor,nsys,system,msys,error)
        if (error) return
        gtemp%char%syst = keywor
        !
        if (nsys.eq.type_eq) then
          equinox = 2000.0
          call sic_r4(line,o_syst,1,equinox,.false.,error)
          if (error)  return
          gtemp%gil%epoc = equinox
        endif
      endif
      !
      type = gtemp%gil%ptyp
      !
      ! Find input projection center
      if (type.ne.p_none) then
        if (type.ne.p_aitoff) then
          if (sic_present(o_proj,3)) then
            call sic_ke(line,o_proj,3,args,n,.false.,error)
            istart = sic_start(o_proj,3)
            length = sic_len(o_proj,3)
            if (line(istart:istart+2).ne.'*') then
              call sic_sexa(line(istart:),length,dec,error)
              if (error)  return
              gtemp%gil%d0 = dec*pi/180.0d0
            endif
          endif
        elseif (sic_present(o_proj,2)) then
          call map_message(seve%w,rname,'Declination ignored in AITOFF')
          gtemp%gil%d0 = 0.0d0
        endif
        !
        if (sic_present(o_proj,2)) then
          call sic_ke(line,o_proj,2,args,n,.false.,error)
          istart = sic_start(o_proj,3)
          length = sic_len(o_proj,3)
          if (line(istart:istart+2).ne.'*') then
            call sic_sexa(line(istart:),length,ra,error)
            if (error)  return
            gtemp%gil%dec = dec*pi/180.0d0
          endif
          if (gtemp%char%syst.eq.'EQUATORIAL'.or.gtemp%char%syst.eq.'ICRS') then
            ra = ra*pi/12.0d0
          else
            ra = ra*pi/180.0d0
          endif
          gtemp%gil%a0 = ra
        endif
        !
        ! Angle
        if (sic_present(o_proj,4)) then
          if (type.eq.p_aitoff) then
            call map_message(seve%w,rname,'Angle ignored in AITOFF')
            ang = 0.d0
          elseif (type.eq.p_radio) then
            call map_message(seve%w,rname,'Angle ignored in RADIO')
            ang = 0.d0
          else
            istart = sic_start(o_proj,4)
            length = sic_len(o_proj,4)
            call sic_sexa(line(istart:),length,ang,error)
            if (error)  return
            ang = ang*pi/180.0d0
          endif
          gtemp%gil%pang = ang
        endif
      elseif (sic_present(o_proj,1)) then
        call map_message(seve%w,rname,'Projection center ignored in /TYPE NONE')
      endif
      !
    endif
    !
    ! /X_AXIS N Ref Val Inc
    if (sic_present(o_xaxis,0)) then
      call sic_i4(line,o_xaxis,1,nc,.true.,error)
      if (error) return
      ! Set default resampling
      convert = gtemp%gil%convert(:,1)
      !
      call sic_r8(line,o_xaxis,2,convert(1),.false.,error)
      if (error) return
      call sic_r8(line,o_xaxis,3,convert(2),.false.,error)
      if (error) return
      call sic_r8(line,o_xaxis,4,convert(3),.false.,error)
      if (error) return
      gtemp%gil%convert(:,1) = convert
      gtemp%gil%dim(1) = nc
    endif
    ! /Y_AXIS N Ref Val Inc
    if (sic_present(o_yaxis,0)) then
      call sic_i4(line,o_yaxis,1,nc,.true.,error)
      if (error) return
      ! Set default resampling
      convert = gtemp%gil%convert(:,2)
      !
      call sic_r8(line,o_yaxis,2,convert(1),.false.,error)
      if (error) return
      call sic_r8(line,o_yaxis,3,convert(2),.false.,error)
      if (error) return
      call sic_r8(line,o_yaxis,4,convert(3),.false.,error)
      if (error) return
      gtemp%gil%convert(:,2) = convert
      gtemp%gil%dim(2) = nc
    endif
    !
  endif
  !
  call gildas_null(gout)
  call gdf_copy_header(gin,gout,error)
  call s_reproject_init(gin,gtemp,gout,sys_code,error)
  if (error) return
  !
  call sic_ch(line,0,1,fich,n,.true.,error)
  if (error) return
  !
  ! Now handle the Output 
  out_image = .false.
  if (index(fich,'.').eq.0) then 
    out_image = .true.
    ! This must be an existing SIC Image variable
    rdonly = .false.
    call sub_readhead (rname,fich,gtemp,out_image,error,rdonly,fmt_r4)
    if (error) return
    do i=gtemp%gil%ndim+1,gout%gil%ndim
      gtemp%gil%dim(i) = 1
    enddo
    !
    !!Print *,'OUT ',gout%gil%ndim,gout%gil%dim(1:4)
    !!Print *,'Existing ',gtemp%gil%ndim,gtemp%gil%dim(1:4)
    !
    ! With a conforming shape with GOUT slot 
    do i=1,max(gtemp%gil%ndim,gout%gil%ndim) 
      if (gout%gil%dim(i).ne.gtemp%gil%dim(i)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Template data shape')
        error = .true.
        return
      endif
    enddo
    !
    ! OK, they match 
    addr = gtemp%loca%addr
    ipou = gag_pointer(addr,memory)
  else
    out_image = .false.
    ! This is  a file, we must create it
    call sic_parsef(fich,gout%file,' ','.gdf')
    call gdf_allocate(gout,error)
    if (error) return
    addr = locwrd(gout%r3d)
    ipou = gag_pointer(addr,memory)
  endif
  !
  ! Get the IN data pointer
  if (in_image) then
    ipin = gag_pointer(gin%loca%addr,memory)
  else
    call gdf_allocate(gin,error)
    if (error) return
    call gdf_read_data(gin,gin%r3d,error)
    if (error) return
    addr = locwrd(gin%r3d)
    ipin = gag_pointer(addr,memory)
    call gdf_close_image(gin,error) ! I do not need it anymore
  endif
  !
  call s_reproject_do(gin,memory(ipin),gout,memory(ipou),sys_code,error)
  if (error) return
  !
  if (.not.out_image) then
    call gdf_write_image(gout,gout%r3d,error)
    if (error) return
  else  
    ! I need the descriptor as output in this case...
    call sic_descriptor(fich,desc,found)      
    call gdf_copy_header(gout,desc%head)
  endif
  !  
end subroutine reproject_comm
!
subroutine s_reproject_init(in,tem,out,sys_code,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  ! IMAGER
  !     Prepare Spatial resampling of a data cube as specified by 
  !       a Template
  !     Prepare the Ouput header and Code
  !---------------------------------------------------------------------  
  type(gildas), intent(in) :: in      ! Input data cube
  type(gildas), intent(in) :: tem     ! Grid template
  type(gildas), intent(inout) :: out  ! Output data cube
  integer, intent(out) :: sys_code    ! Reprojection code
  logical :: error
  !
  character(len=*), parameter :: pname='REPROJECT'
  !
  sys_code = 0
  call sanity_check(pname,tem,error)
  if (error) return
  !
  ! Copy part of header of Template, but NOT the Resolution section !...
  out%char%syst = tem%char%syst
  out%gil%ra   = tem%gil%ra
  out%gil%dec  = tem%gil%dec
  out%gil%lii  = tem%gil%lii
  out%gil%bii  = tem%gil%bii
  out%gil%epoc = tem%gil%epoc
  out%gil%ptyp = tem%gil%ptyp
  out%gil%a0   = tem%gil%a0
  out%gil%d0   = tem%gil%d0
  out%gil%pang = tem%gil%pang
  out%char%code(out%gil%xaxi) = tem%char%code(tem%gil%xaxi)
  out%char%code(out%gil%yaxi) = tem%char%code(tem%gil%yaxi)
  out%gil%dim(out%gil%xaxi) = tem%gil%dim(tem%gil%xaxi)
  out%gil%dim(out%gil%yaxi) = tem%gil%dim(tem%gil%yaxi)
  out%loca%size = out%gil%dim(1)*out%gil%dim(2)*out%gil%dim(3)*out%gil%dim(4)
  out%gil%proj_words = tem%gil%proj_words
  out%gil%convert(:,out%gil%xaxi) = tem%gil%convert(:,tem%gil%xaxi)
  out%gil%convert(:,out%gil%yaxi) = tem%gil%convert(:,tem%gil%yaxi)
  !
  call get_sys_code(in,out,sys_code, error)
  if (error) return
  !
end subroutine s_reproject_init
!
subroutine s_reproject_do(in,din,out,dout,sys_code,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !     Spatial resampling of a data cube, according to Header and Code
  !     Use s_reproject_init to prepare the Output header
  !---------------------------------------------------------------------  
  type(gildas), intent(in) :: in
  type(gildas), intent(inout) :: out
  real, intent(in) :: din(in%gil%dim(1),in%gil%dim(2),in%gil%dim(3))
  real, intent(out) :: dout(out%gil%dim(1),out%gil%dim(2),out%gil%dim(3))
  integer, intent(in) :: sys_code
  logical :: error
  !
  character(len=*), parameter :: rname='REPROJECT'
  real :: in_blank(2)  ! Input blanking
  !
  ! Set blanking
  in_blank = [in%gil%bval,in%gil%eval] 
  out%gil%blan_words = 2
  if (in%gil%blan_words.eq.0) then
    in_blank = [0.,-1.]
    !!Print *,'Using blanking ',out%gil%bval,out%gil%eval
  endif
  !
  ! Method of solution
  if (in_blank(2).lt.0.0) then
    call map_message(seve%i,rname, &
    & 'Using bilinear gridding method with no input blanking')
  else
    call map_message(seve%i,rname, &
    & 'Using bilinear gridding method with input blanking')
  endif
  !
  call gridlin(                                                     &
    din,in%gil%dim(1),in%gil%dim(2),in%gil%dim(3),                  &
    in%gil%convert,in%gil%ptyp,in%gil%a0,in%gil%epoc,in_blank,      &
    dout,out%gil%dim(1),out%gil%dim(2),                             &
    out%gil%convert,out%gil%ptyp,out%gil%a0,out%gil%epoc,out%gil%bval, &
    sys_code,error)
  !
end subroutine s_reproject_do
!
subroutine sanity_check(rname,x,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------------------
  ! @ private
  ! Sanity check for input or template file
  !-------------------------------------------------------------------
  character(len=*), intent(in) :: rname
  type(gildas), intent(in)    :: x
  logical,      intent(inout) :: error
  !
  ! Check if the 2 first dimensions are spatial. We could support any
  ! order but this is not implemented (and would be unefficient)
  if (x%gil%xaxi*x%gil%yaxi.ne.2) then
    call map_message(seve%e,rname,'Spatial dimensions must be first and second dimensions')
    error = .true.
    return
  endif
  !
end subroutine sanity_check
!
subroutine get_sys_code(in,out,sys_code,error)
  use gbl_format
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! Get old-system to new-system conversion code
  ! Trap illegal/impossible conversions.
  !
  ! Caution: ICRS not yet supported here
  !---------------------------------------------------------------------
  type(gildas),    intent(in)  :: in        ! Input header
  type(gildas),    intent(in)  :: out       ! Desired output header
  integer(kind=4), intent(out) :: sys_code  ! Conversion code
  logical,         intent(out) :: error
  ! Local
  character(len=*), parameter :: pname='REPROJECT'
  integer(kind=4), parameter :: conv_none   = 0
  integer(kind=4), parameter :: conv_equ2gal= 1
  integer(kind=4), parameter :: conv_gal2equ=-1
  integer(kind=4), parameter :: conv_equ2equ=-2
  !
  error = .false.
  select case (out%char%syst)
  case ('GALACTIC')
    if (in%char%syst.eq.'EQUATORIAL') then
      sys_code = conv_equ2gal
    elseif (in%char%syst.eq.'GALACTIC') then
      sys_code = conv_none
    else
      error = .true.
    endif
    !
  case ('EQUATORIAL')
    if (in%char%syst.eq.'EQUATORIAL') then
      if (in%gil%epoc.ne.out%gil%epoc) then
        ! Both Equatorial, not same equinox
        call map_message(seve%i,pname, &
          & 'Converting from equinox '//trim(equinox_name(in%gil%epoc))//  &
          &                     ' to '//trim(equinox_name(out%gil%epoc)))
        sys_code = conv_equ2equ
      else
        ! Both Equatorial, same equinox
        sys_code = conv_none
      endif
    elseif (in%char%syst.eq.'GALACTIC') then
      sys_code = conv_gal2equ
    else
      error = .true.
    endif
    !
  case ('UNKNOWN')
    if (in%char%syst.eq.'GALACTIC') then
      error = .true.
    elseif (in%char%syst.eq.'EQUATORIAL') then
      error = .true.
    else
      sys_code = conv_none
    endif
    !
  case default
    call map_message(seve%w,pname,'Unknown system '//out%char%syst//', no conversion applied')
    sys_code = conv_none
    !
  end select
  !
  if (error) then
    call map_message(seve%e,pname,'Cannot convert from '//in%char%syst//' to '//out%char%syst)
  endif
  return
  !
contains
  function equinox_name(equinox)
    real(kind=4), intent(in) :: equinox
    character(len=10) :: equinox_name
    if (equinox.eq.equinox_null) then
      equinox_name = 'Unknown'
    else
      write(equinox_name,'(F0.2)') equinox
    endif
  end function equinox_name
  !
end subroutine get_sys_code
!
subroutine gridlin(a,mx,my,mz,aconv,atype,aproj,aepoc,ablank,  &
                   b,nx,ny,   bconv,btype,bproj,bepoc,bblank,  &
                   code,error)
  use gildas_def
  use gkernel_interfaces, no_interface1=>abs_to_rel_1dn4,  &
                          no_interface2=>rel_to_abs_1dn4
  use gkernel_types
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !
  !   IMAGER
  !     Extracted from GREG Stand alone subroutine
  !  Regrid an input map in a given projection to an output map in
  !  another projection, bilinear interpolation
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: mx  ! Size of A
  integer(kind=index_length), intent(in) :: my  ! Size of A
  integer(kind=index_length), intent(in) :: mz  ! Size of A
  real(kind=4)    :: a(mx,my,mz)  ! Input map of dimensions MX MY MZ
  real(kind=8)    :: aconv(6)     ! Pixel conversion formulae: CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  integer(kind=4) :: atype        ! Type of projection
  real(kind=8)    :: aproj(3)     ! Projection constants PROJ(1)=A0, PROJ(2)=D0, PROJ(3)=Angle
  real(kind=4)    :: aepoc        ! Epoch if Needed
  real(kind=4)    :: ablank(2)    !
  integer(kind=4) :: nx           !
  integer(kind=4) :: ny           !
  real(kind=4)    :: b(nx,ny,mz)  ! Output map of dimensions NX,NY,MZ
  real(kind=8)    :: bconv(6)     !
  integer(kind=4) :: btype        !
  real(kind=8)    :: bproj(3)     !
  real(kind=4)    :: bepoc        ! Epoch if Needed
  real(kind=4)    :: bblank       ! Blanking value
  integer(kind=4) :: code         ! Galactic to Equatorial (-1) or Equatorial to Galactic (1)
  logical, intent(out) :: error   !
  !
  integer(kind=4), parameter :: conv_none   = 0
  integer(kind=4), parameter :: conv_equ2gal= 1
  integer(kind=4), parameter :: conv_gal2equ=-1
  integer(kind=4), parameter :: conv_equ2equ=-2
  ! Local
  real(kind=4) :: bval,eval
  integer(kind=index_length) :: ia,ja,k
  integer(kind=4) :: ib,jb,ier
  real(kind=8) :: axref,axval,axinc, ayref,ayval,ayinc
  real(kind=8) :: bxref,bxval,bxinc, byref,byval,byinc
  real(kind=8) :: xa,ya
  real(kind=4) :: xr,yr
  ! Work arrays to handle the coordinates conversion
  real(kind=8), allocatable :: axb(:),ayb(:),bxb(:),byb(:)
  real(kind=8), allocatable :: xb(:,:), yb(:,:)
  type(projection_t) :: proj
  integer :: ithread,nthread
  !
  error = .false.
  !
  ! Preliminary processing
  bval=ablank(1)
  eval=ablank(2)
  !
  ! I force the conversion formula for input to be adapted to the
  ! NINT function that will be used below. Now Xref=1.0
  axref = 1.0d0                ! was ACONV(1)
  axval = (1.0d0-aconv(1))*aconv(3)+aconv(2)
  axinc = aconv(3)
  ayref = 1.0d0                ! was ACONV(4)
  ayval = (1.0d0-aconv(4))*aconv(6)+aconv(5)
  ayinc = aconv(6)
  ! the output is unchanged.
  bxref = bconv(1)
  bxval = bconv(2)
  bxinc = bconv(3)
  byref = bconv(4)
  byval = bconv(5)
  byinc = bconv(6)
  !
  ! Setup Output projection
  error = .false.
  call gwcs_projec(bproj(1),bproj(2),bproj(3),btype,proj,error)
  if (error) return
  !
  if (code.ne.conv_none) then
    allocate(xb(nx,ny),yb(nx,ny),axb(nx*ny),ayb(nx*ny),bxb(nx*ny),byb(nx*ny),stat=ier)
  else
    allocate(xb(nx,ny),yb(nx,ny),axb(nx*ny),ayb(nx*ny),stat=ier)
  endif
  if (ier.ne.0) then
    error = .true.
    return
  endif    
  ! Convert Output projection to Absolute coordinates
  do jb=1,ny
    do ib=1,nx
      xb(ib,jb) = (ib-bxref)*bxinc + bxval
      yb(ib,jb) = (jb-byref)*byinc + byval
    enddo
  enddo
  !
  if (code.ne.conv_none) then
    call rel_to_abs_1dn4(proj,xb,yb,bxb,byb,nx*ny)
    !
    ! Change coordinate system. use new epoch also. Warning: codes are
    ! reversed since we start form output map!
    if (code.eq.1) then
      call gal_equ(bxb,byb,axb,ayb,aepoc,nx*ny,error)
    elseif (code.eq.-1) then
      call equ_gal(bxb,byb,bepoc,axb,ayb,nx*ny,error)
    elseif (code.eq.-2) then
      call equ_equ(bxb,byb,bepoc,axb,ayb,aepoc,nx*ny,error)
    endif
    if (error) return
  else
    call rel_to_abs_1dn4(proj,xb,yb,axb,ayb,nx*ny)
  endif
  !
  ! Setup Input projection
  call gwcs_projec(aproj(1),aproj(2),aproj(3),atype,proj,error)
  if (error) return
  !
  ! Convert Absolute coordinates to input projection
  call abs_to_rel_1dn4(proj,axb,ayb,xb,yb,nx*ny)
  !
  ! Interpolate
  !
  ! Take Blanking into account, version #1
  nthread = 0
  !$ nthread = omp_get_max_threads()
  if (eval.lt.0.0) then
    ! Loop over Output data points
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(xb,yb,b,a, mz,mx,my,nx,ny) &
    !$OMP &  SHARED(axinc, axval, axref, ayinc, ayval, ayref,bblank) &
    !$OMP &  PRIVATE(k,ib,jb,xa,ya,xr,yr,ia,ja, nthread, ithread)
    !$OMP DO COLLAPSE (2)
    do k = 1,mz
      do jb = 1,ny
        do ib = 1,nx
          !
          ! Find pixel coordinate in input map
          xa = xb(ib,jb)
          ya = yb(ib,jb)
          xr = (xa-axval)/axinc+axref
          yr = (ya-ayval)/ayinc+ayref
          ia = int(xr)
          ja = int(yr)
          !
          ! Avoid edges
          if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
            b(ib,jb,k) = bblank
          else
            ! Interpolate
            xr = xr-float(ia)
            yr = yr-float(ja)
            b(ib,jb,k) = (1-xr)*(1-yr)*a(ia,ja,k)+   &
                         xr*(1-yr)*a(ia+1,ja,k)+   &
                         xr*yr*a(ia+1,ja+1,k)+   &
                         (1-xr)*yr*a(ia,ja+1,k)
          endif
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  else
    ! Loop over Output data points
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(xb,yb,b,a, mz,mx,my,nx,ny) &
    !$OMP &  SHARED(axinc, axval, axref, ayinc, ayval, ayref, bblank, bval, eval) &
    !$OMP &  PRIVATE(k,ib,jb,xa,ya,xr,yr,ia,ja, nthread, ithread)
    !$OMP DO COLLAPSE (2)
    do k = 1,mz
      do jb = 1,ny
        do ib = 1,nx
          xa = xb(ib,jb)
          ya = yb(ib,jb)
          xr = (xa-axval)/axinc+axref
          yr = (ya-ayval)/ayinc+ayref
          ia = int(xr)
          ja = int(yr)
          if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
            b(ib,jb,k) = bblank
          elseif (abs(a(ia,ja,k)-bval).le.eval) then
            b(ib,jb,k) = bblank
          elseif (abs(a(ia+1,ja,k)-bval).le.eval) then
            b(ib,jb,k) = bblank
          elseif (abs(a(ia,ja+1,k)-bval).le.eval) then
            b(ib,jb,k) = bblank
          elseif (abs(a(ia+1,ja+1,k)-bval).le.eval) then
            b(ib,jb,k) = bblank
          else
            xr = xr-float(ia)
            yr = yr-float(ja)
            b(ib,jb,k) = (1-xr)*(1-yr)*a(ia,ja,k)+  &
                         xr*(1-yr)*a(ia+1,ja,k)+   &
                         xr*yr*a(ia+1,ja+1,k)+   &
                         (1-xr)*yr*a(ia,ja+1,k)
          endif
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
  !
end subroutine gridlin
