subroutine combine_comm(line,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! COMBINE Out Code Line Cont /FACTOR  Fl Fc /THRESHOLD  Tl Tc /BLANKING
  !   Combination with automatic reprojection (and later resampling)
  !   to match the two input data cubes
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(inout) :: error
  !
  ! ' COMBINE', '/BLANKING', '/FACTOR', '/THRESHOLD', 
  character(len=*), parameter :: rname='COMBINE'
  character(len=1024) :: chain
  integer :: ia, n, kopt, ier
  logical :: do_insert
  character(len=filename_length) :: namex,namey,namez
  character(len=20) :: code, argum
  integer, parameter :: mcode=10
  character(len=14) :: scode(mcode)
  data scode/'ADD','DIVIDE','MULTIPLY','OPTICAL_DEPTH','INDEX','SUBTRACT','PLUS','MINUS','OVER','TIMES'/ 
  real :: ay, az, c
  !
  do_insert = sic_lire().eq.0
  !
  call sic_ch(line,0,2,argum,n,.true.,error)
  if (error) return
  az = 1.
  ay = 1.
  if (argum.eq.'=') then
    if (sic_present(2,0)) then
      call map_message(seve%e,rname,'Option /FACTOR is incompatible with free syntax')
      error = .true.
      return
    endif
    call sic_ch(line,0,1,namex,n,.true.,error)
    if (error) return
    ! COMBINE  Out = F*In1 Oper G*In2
    !
    call sic_ke(line,0,4,argum,n,.true.,error)
    if (error) return
    select case (argum)
    case ('+') 
      code = 'ADD'
    case ('-')
      code = 'SUBTRACT'
    case ('*') 
      code = 'MULTIPLY'
    case ('|')
      code = 'DIVIDE'
    case default
      call sic_ambigs (rname,argum,code,n,scode,mcode,error)
      if (error) return
    end select
    !
    call sic_ch(line,0,3,namey,n,.true.,error)
    if (error) return
    n = index(namey,'*')
    if (n.ne.0) then
      read(namey(1:n-1),*,iostat=ier) ay
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 1st factor '//namey(1:n))
        error = .true.
        return
      endif
      namey = namey(n+1:)
    endif
    !
    call sic_ch(line,0,5,namez,n,.true.,error)
    if (error) return
    n = index(namez,'*')
    if (n.ne.0) then
      read(namez(1:n-1),*,iostat=ier) az
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 2nd factor '//namez(1:n))
        error = .true.
        return
      endif
      namez = namez(n+1:)
    endif
    !
    c = 0
    call sic_r4(line,0,6,c,.false.,error)
    if (error) return
    !
    kopt = len_trim(line)
    if (sic_present(1,0)) kopt = sic_start(1,0)
    if (sic_present(3,0)) kopt = min(kopt,sic_start(3,0))
    chain = line(kopt:)
    !
    ! This will not work if any quote is in the arguments...
    if (c.eq.0) then
      write(line,'(6(A,1X),1PG11.4,1X,1PG11.4,1X,A)') 'COMBINE', trim(namex), trim(code), & 
        & trim(namey), trim(namez), '/FACTOR ',ay,az, trim(chain)
    else
      call sic_ch(line,0,6,argum,n,.false.,error)
      write(line,'(7(A,1X),1PG11.4,1X,1PG11.4,1X,A)') 'COMBINE', trim(namex), trim(code), & 
        & trim(namey), trim(namez), trim(argum), '/FACTOR ',ay,az, trim(chain)
    endif
    !
  else
    ! parse 4 /factor 1 2 /threshold 1 2 /blank 1
    error = .false.
    if ((sic_narg(0).lt.4).or.(sic_narg(0).gt.5)) then
      call map_message(seve%e,rname,'command takes 4 or 5 arguments')
      error = .true.
    endif
  endif
  !
  ! parse 4 5 /factor 1 2 /threshold 1 2 /blank 1
  if (sic_present(1,0).and.sic_narg(1).ne.1) then
    call map_message(seve%e,rname,'/BLANKING takes 1 argument')
    error = .true.
  endif
  if (sic_present(2,0).and.((sic_narg(2).lt.1).or.(sic_narg(2).gt.2))) then
    call map_message(seve%e,rname,'/FACTORS takes 1 or 2 arguments')
    error = .true.
  endif
  if (sic_present(3,0).and.((sic_narg(3).lt.1).or.(sic_narg(3).gt.2))) then
    call map_message(seve%e,rname,'/THRESHOLDS takes 1 or 2 arguments')
    error = .true.
  endif
  if (error) return
  !
  ia = index(line,' ')
  chain = "@ p_combine"//line(ia:)
  call exec_program(chain) 
  !
  if (do_insert) call sic_insert_log(line)
end subroutine combine_comm
!
subroutine map_combine_comm(line,error)
  use image_def
  use gkernel_interfaces
  use imager_interfaces, only : do_combine, map_message
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !   IMAGER, from Task COMBINE code
  !
  ! MAP_COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANKING Bval
  !     Combine in different ways two input images
  !        (or data cubes)...
  !
  !     Out can be a file name or an existing Image variable. 
  !         The distinction is made by the existence of a "." in the name
  !         If it is a file, it is created like the In1 Variable
  !         If it is an Image variable, it must match the shape of 
  !           the In1 Variable
  !     In1 can be a file name or an existing Image variable.
  !     In2 can be a file name or an existing Image variable.
  !         The rank of In2 must be smaller than that of In1, and
  !         other dimensions must match          
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: line  ! Input command line
  logical, intent(out) :: error         ! Return error flag
  !
  integer, parameter :: o_blank=1, o_factor=2, o_thre=3
  character(len=*), parameter :: rname='MAP_COMBINE'
  character(len=filename_length) :: namex,namey,namez
  character(len=20) :: code, argum
  integer, parameter :: mcode=10
  character(len=14) :: scode(mcode)
  data scode/'ADD','DIVIDE','MULTIPLY','OPTICAL_DEPTH','INDEX','SUBTRACT','PLUS','MINUS','OVER','TIMES'/ 
  real :: ay,az,ty,tz,b,c
  logical :: do_blank
  integer :: n, ier
  !
  call sic_ch(line,0,1,namex,n,.true.,error)
  if (error) return
  call sic_ch(line,0,2,argum,n,.true.,error)
  if (error) return
  az = 1.
  ay = 1.
  if (argum.eq.'=') then
    if (sic_present(o_factor,0)) then
      call map_message(seve%e,rname,'Option /FACTOR is incompatible with free syntax')
      error = .true.
      return
    endif
    ! COMBINE  Out = F*In1 Oper G*In2
    !
    call sic_ke(line,0,4,argum,n,.true.,error)
    if (error) return
    select case (argum)
    case ('+') 
      code = 'ADD'
    case ('-')
      code = 'SUBTRACT'
    case ('*') 
      code = 'MULTIPLY'
    case ('|')
      code = 'DIVIDE'
    case default    
      call sic_ambigs (rname,argum,code,n,scode,mcode,error)
    end select
    if (error) return
    !
    call sic_ch(line,0,3,namey,n,.true.,error)
    if (error) return
    n = index(namey,'*')
    if (n.ne.0) then
      read(namey(1:n-1),*,iostat=ier) ay
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 1st factor '//namey(1:n))
        error = .true.
        return
      endif
      namey = namey(n+1:)
    endif
    !
    call sic_ch(line,0,5,namez,n,.true.,error)
    if (error) return
    n = index(namez,'*')
    if (n.ne.0) then
      read(namez(1:n-1),*,iostat=ier) az
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 2nd factor '//namez(1:n))
        error = .true.
        return
      endif
      namez = namez(n+1:)
    endif
    !
    c = 0
    call sic_r4(line,0,6,c,.false.,error)
    !
  else
    call sic_ch(line,0,2,argum,n,.true.,error)
    if (error) return
    call sic_ambigs (rname,argum,code,n,scode,mcode,error)
    if (error) return
    call sic_ch(line,0,3,namey,n,.true.,error)
    if (error) return
    call sic_ch(line,0,4,namez,n,.true.,error)
    if (error) return
    c = 0
    call sic_r4(line,0,5,c,.false.,error)
    if (error) return
    call sic_r4(line,o_factor,2,az,.false.,error)
    call sic_r4(line,o_factor,1,ay,.false.,error)
  endif
  !
  tz = -huge(1.0)
  ty = tz
  !
  call sic_r4(line,o_thre,2,tz,.false.,error)
  call sic_r4(line,o_thre,1,ty,.false.,error)
  !
  if ((code.eq.'SUBTRACT').or.(code.eq.'MINUS')) then
    code = 'ADD'
    az = -az
  endif
  !
  if (sic_present(o_blank,0)) then
    call sic_r4(line,o_blank,1,b,.true.,error)
    do_blank = .true.
  else
    do_blank = .false.
  endif
  !
  if (do_blank) then
    call do_combine(namex,namey,namez,code,c,ay,ty,az,tz,error,b)
  else
    call do_combine(namex,namey,namez,code,c,ay,ty,az,tz,error)
  endif
end subroutine map_combine_comm
!
subroutine do_combine(namex,namey,namez,code,c,ay,ty,az,tz,error,b)
  use imager_interfaces, only : sub_readhead, map_message
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use iso_c_binding
  !----------------------------------------------------------------------
  ! @ private-mandatory
  !
  !   IMAGER  Support routine for command
  !
  ! COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANK Bval
  !     Combine in different ways two input images
  !        (or data cubes)...
  !
  !     Out can be a file name or an existing Image variable. 
  !         The distinction is made by the existence of a "." in the name
  !         If it is a file, it is created like the In1 Variable
  !         If it is an Image variable, it must match the shape of 
  !           the In1 Variable
  !     In1 can be a file name or an existing Image variable.
  !     In2 can be a file name or an existing Image variable.
  !         The rank of In2 must be smaller than that of In1, and
  !         other dimensions must match          
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: namex ! Output file
  character(len=*), intent(inout) :: namey ! Input file 1
  character(len=*), intent(inout) :: namez ! Input file 2
  character(len=*), intent(inout) :: code  ! Combination code
  real, intent(in) :: c  ! Offset
  real, intent(in) :: ay ! Y Factor
  real, intent(in) :: ty ! Y Threshold
  real, intent(in) :: az ! Z Factor
  real, intent(in) :: tz ! Z Threshold
  logical, intent(out) :: error
  real, intent(in), optional :: b  ! Blanking
  !
  character(len=*), parameter :: rname='MAP_COMBINE'
  !
  type (sic_descriptor_t) :: desc
  type (gildas) :: hx, hy, hz
  type (c_ptr) :: cptr
  real, pointer :: dx(:,:), dy(:,:), dz(:)
  logical :: x_image, y_image, z_image, found, rdonly
  integer i, j, ier
  integer(kind=index_length) :: n, m
  !
  error = .true.
  !
  n = len_trim(namez)
  if (n.eq.0) return
  n = len_trim(namex)
  if (n.eq.0) return
  n = len_trim(namey)
  if (n.eq.0) return
  error = .false.
  !
  z_image = .false.
  call sub_readhead (rname,namez,hz,z_image,error,rdonly,fmt_r4)
  if (error) return
  !
  y_image = .false.
  call sub_readhead (rname,namey,hy,y_image,error,rdonly,fmt_r4)
  if (error) return  
  !
  if (hz%gil%eval.ge.0.0) hz%gil%eval =   &
    max(hz%gil%eval,abs(hz%gil%bval*1e-7))
  if (hy%gil%eval.ge.0.0) hy%gil%eval =   &
    max(hy%gil%eval,abs(hy%gil%bval*1e-7))
  !
  ! Check input dimensions
  m = max(hy%gil%ndim,hz%gil%ndim)
  do i=1,m
    if (hy%gil%dim(i).ne.hz%gil%dim(i)) then
      n = 1
      do j=i,m
        n = n*hz%gil%dim(j)
      enddo
      if (n.ne.1) then
        call map_message(seve%e,rname,'Input images are non coincident')
        error = .true.
        return
      else
        call map_message(seve%i,rname,'Combining a cube with a plane')
      endif
    endif
  enddo
  !
  !
  ! Allocate the arrays if needed. Note that the allocated arrays do 
  ! not conform to the shape of the images: DZ is allocated as a 1-D 
  ! array, DX,DY as 2-D arrays, possibly of second dimension 1.
  !
  n = hz%loca%size
  m = hy%loca%size/hz%loca%size
  !
  ! Get the Z data pointer
  if (z_image) then
    call adtoad(hz%loca%addr,cptr,1)
    call c_f_pointer(cptr,dz,[n])
  else
    allocate(dz(n),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call map_message(seve%i,rname,'Reading '//trim(hz%file))
    call gdf_read_data(hz,dz,error)
    call gdf_close_image(hz,error) ! I do not need it anymore
  endif
  !
  ! Get the Y data pointer
  if (y_image) then
    call adtoad(hy%loca%addr,cptr,1)
    call c_f_pointer(cptr,dy,[n,m])
  else
    allocate(dy(n,m),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    call map_message(seve%i,rname,'Reading '//trim(hy%file))
    call gdf_read_data(hy,dy,error)
    call gdf_close_image(hy,error) ! I do not need it anymore
  endif
  !
  ! Now handle the Output 
  call gildas_null(hx)
  if (index(namex,'.').eq.0) then 
    x_image = .true.
    ! This must be an existing SIC Image variable
    rdonly = .false.
    call sub_readhead (rname,namex,hx,x_image,error,rdonly,fmt_r4)
    if (error) return
    !
    ! With a conforming shape with Y slot
    do i=1,max(hx%gil%ndim,hy%gil%ndim) 
      if (hy%gil%dim(i).ne.hx%gil%dim(i)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Input data shape')
        error = .true.
        return
      endif
    enddo
    !
    ! OK, they match 
    call adtoad(hx%loca%addr,cptr,1)    
    call c_f_pointer(cptr,dx,[n,m])
    ! But update the Header locally
    call gdf_copy_header(hy,hx,error)
  else
    x_image = .false.
    ! This is  a file, we must create it
    call gdf_copy_header(hy,hx,error)
    call sic_parsef(namex,hx%file,' ','.gdf')
    hx%gil%extr_words = 0
    hx%gil%blan_words = 2
    allocate(dx(n,m),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
  endif
  !
  ! Update Blanking if specified
  if (present(b)) then
    hx%gil%bval = b
    hx%gil%eval = 0.0
  endif
  !
  ! Do the actual job
  call map_message(seve%i,rname,'Combining data')
  call sub_combine(hx,hy,hz,     & ! Headers
    & n,m,                       & ! Sizes
    & dx,dy,dz,                  & ! Data arrays
    & code,ay,ty,az,tz,c,error)    ! Operation 
  !
  ! Write ouput file
  if (.not.x_image) then
    call map_message(seve%i,rname,'Writing '//trim(hx%file))
    call gdf_write_image(hx,dx,error)
  else
    ! Update the original SIC variable header, including Extrema
    error = .false. 
    hx%loca%addr = locwrd(dx)   ! Define the address
    call gdf_get_extrema (hx,error)
    call sic_descriptor(namex,desc,found)
    call gdf_copy_header(hx,desc%head,error)  
  endif
  !
end subroutine do_combine
!
subroutine sub_combine(hx,hy,hz,n,m,dx,dy,dz,code,ay,ty,az,tz,c,error)
  use gkernel_types
  !----------------------------------------------------------------------
  !
  !   IMAGER  Support routine for command
  !
  ! COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANK Bval
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: code  ! Combination code
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  !
  type(gildas), intent(in) :: hx  ! Output header
  type(gildas), intent(in) :: hy  ! Input Cube header
  type(gildas), intent(in) :: hz  ! Input Cube or Plane header
  !
  real, intent(in) :: dx(n,m)     ! Output data
  real, intent(in) :: dy(n,m)     ! Input data
  real, intent(in) :: dz(n)       ! Input data
  real, intent(in) :: c           ! Offset
  real, intent(in) :: ay          ! Y Factor
  real, intent(in) :: ty          ! Y Threshold
  real, intent(in) :: az          ! Z Factor
  real, intent(in) :: tz          ! Z Threshold
  logical, intent(out) :: error
  !
  select case(code)
  case ('ADD','PLUS') 
    call add002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c)
  case ('DIVIDE','OVER') 
    call div002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c)
  case ('MULTIPLY','TIMES') 
    call mul002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c)
  case ('OPTICAL_DEPTH') 
    call opt002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c)
  case ('INDEX')
    Print *,'Spectral Index not yet available'
    error = .true.
  case default
    Print *,code//' not available'
    error = .true.
    return
  end select
  !
end subroutine sub_combine
!
subroutine add002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	  Linear combination of input arrays
  !	X = Ay*Y + Az*Z + C
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      ! Plane array
  real :: y(n,m)                    ! Input Cube
  real :: x(n,m)                    ! Output Cube
  real :: bz                        ! Z Blanking value
  real :: ez                        ! Z Tolerance on blanking
  real :: az                        ! Z factor
  real :: tz                        ! Z threshold
  real :: by                        ! Y Blanking value
  real :: ey                        ! Y Tolerance on blanking
  real :: ay                        ! Y factor
  real :: ty                        ! Y Threshold
  real :: bx                        ! X Blanking
  real :: c                         ! Constant Offset
  ! Local
  integer(kind=index_length) :: i,k
  !
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,az,ay,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).gt.ez .and. abs(y(i,k)-by).gt.ey   &
     &        .and. z(i).gt.tz .and. y(i,k).gt.ty) then
        x(i,k) = ay*y(i,k) + az*z(i)  +  c
      else
        x(i,k) = bx
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine add002
!
subroutine div002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	  Division of 2 input arrays
  !	X = Ay*Y / Az*Z + C
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      ! Plane array
  real :: y(n,m)                    ! Input Cube
  real :: x(n,m)                    ! Output Cube
  real :: bz                        ! Z Blanking value
  real :: ez                        ! Z Tolerance on blanking
  real :: az                        ! Z factor
  real :: tz                        ! Z threshold
  real :: by                        ! Y Blanking value
  real :: ey                        ! Y Tolerance on blanking
  real :: ay                        ! Y factor
  real :: ty                        ! Y Threshold
  real :: bx                        ! X Blanking
  real :: c                         ! Constant Offset
  ! Local
  integer(kind=index_length) :: i,k
  real :: ayz
  !
  ayz = ay/az
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).gt.ez .and. abs(y(i,k)-by).gt.ey   &
     &        .and. z(i).gt.tz .and. y(i,k).gt.ty) then
        x(i,k) = ayz * y(i,k) / z(i)  +  c
      else
        x(i,k) = bx
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine div002
!
subroutine mul002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	Multiplication of input arrays
  !	  X = Ay*Y * Az*Z + C
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      ! Plane array
  real :: y(n,m)                    ! Input Cube
  real :: x(n,m)                    ! Output Cube
  real :: bz                        ! Z Blanking value
  real :: ez                        ! Z Tolerance on blanking
  real :: az                        ! Z factor
  real :: tz                        ! Z threshold
  real :: by                        ! Y Blanking value
  real :: ey                        ! Y Tolerance on blanking
  real :: ay                        ! Y factor
  real :: ty                        ! Y Threshold
  real :: bx                        ! X Blanking
  real :: c                         ! Constant Offset
  ! Local
  integer(kind=index_length) :: i,k
  real :: ayz
  !
  ayz = ay*az
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).gt.ez .and. abs(y(i,k)-by).gt.ey   &
     &        .and. z(i).gt.tz .and. y(i,k).gt.ty) then
        x(i,k) = ayz * z(i) * y(i,k) +  c
      else
        x(i,k) = bx
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine mul002
!
subroutine opt002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	Optical depth from input arrays
  !	X = - LOG ( Ay*Y / Az*Z + C )
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      ! Plane array
  real :: y(n,m)                    ! Input Cube
  real :: x(n,m)                    ! Output Cube
  real :: bz                        ! Z Blanking value
  real :: ez                        ! Z Tolerance on blanking
  real :: az                        ! Z factor
  real :: tz                        ! Z threshold
  real :: by                        ! Y Blanking value
  real :: ey                        ! Y Tolerance on blanking
  real :: ay                        ! Y factor
  real :: ty                        ! Y Threshold
  real :: bx                        ! X Blanking
  real :: c                         ! Constant Offset
  ! Local
  real :: v
  integer(kind=index_length) :: i,k
  real :: ayz
  !
  ayz = ay/az
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k,v)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).gt.ez .and. abs(y(i,k)-by).gt.ey   &
     &        .and. z(i).gt.tz .and. y(i,k).gt.ty) then
        v = ayz * y(i,k) / z(i)  +  c
        if (v.gt.0.0) then
          x(i,k) = - log( v )
        else
          x(i,k) = bx
        endif
      else
        x(i,k) = bx
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine opt002
!
subroutine sub_readhead(rname,namez,hz,z_image,error,rdonly,fmt,type)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !     IMAGER
  !   Return the Header of a GILDAS File or SIC Image variable
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname   ! Caller name
  character(len=*), intent(in) :: namez   ! Name of File or Variable
  type(gildas), intent(out) :: hz         ! GILDAS Header
  logical, intent(inout) :: z_image       ! Is it an image ?
  logical, intent(out) :: error           ! Error flag
  logical, intent(out), optional :: rdonly
  integer, intent(in), optional :: fmt
  character(len=*), intent(in), optional :: type
  !
  logical :: found
  type (sic_descriptor_t) :: desc
  integer :: i
  character(len=16) :: atype
  !
  ! Search if any SIC variable like this one...
  call sic_descriptor(namez,desc,found)
  if (found) then
    if (.not.associated(desc%head)) then
      call map_message(seve%e,rname,  &
        'Variable '//trim(namez)//' does not provide a header')
      found = .false.
    else if (present(fmt)) then
      if (desc%type.ne.fmt) then
        call map_message(seve%e,rname,  &
          'Variable '//trim(namez)//' is of wrong type')
        found = .false.
      endif
    endif
    if (found) then
      if (abs(desc%head%gil%type_gdf) .eq. code_gdf_uvt) then
        call gildas_null(hz,type='UVT')
      else
        call gildas_null(hz)
      endif
      call gdf_copy_header(desc%head,hz,error)
      if (error) return
      hz%loca%addr = desc%addr
      z_image = .true.
      if (present(rdonly)) rdonly = desc%readonly
      hz%loca%size = 1
      do i=1,hz%gil%ndim
        hz%loca%size = hz%loca%size * hz%gil%dim(i)
      enddo
    endif
  endif
  !
  ! If not, fall back on File, unless Image mode is specified
  if (.not.found) then
    if (z_image) then
      call map_message(seve%e,rname, 'No such Variable '//trim(namez))
      error = .true.
      return
    else
      if (present(type)) then
        atype = type
      else
        atype = '.gdf'
      endif
      !
      call sic_parse_file(namez,' ',atype,hz%file)
      call gdf_read_header(hz,error)
      if (error) then
        call map_message(seve%e,rname,'Cannot read input file '//trim(hz%file))
        return
      endif
    endif
  endif
end subroutine sub_readhead
