subroutine greg3_spectrum_compute(line,error)
  use image_def
  use sic_types
  use greg_interfaces, except_this=>greg3_spectrum_compute
  use greg_dependencies_interfaces
  use greg_poly
  use gbl_message
  !-----------------------------------------------------------------
  ! @ public  
  !
  ! SPECTRUM OutVar Invar [Mask] /MEAN  [Mean|Sum]
  !     /CORNER Blc Trc /Plane First Last
  !
  !   Compute the mean spectrum over the specified region,
  !   bounded by the GreG polygon.
  !
  ! Invar is a SIC Image Variable
  ! Return this in the specified Outvar SIC variable
  !
  ! The idea is that this routine will be callable by GO VIEW as
  !   SPECTRUM MSPECTRE &1 /CORNER IBLC[1] IBLC[2] ITRC[1] ITRC[2]
  !     /PLANE MIPLANE[1] MIPLANE[2 [/MEAN] [/SUM]
  ! Invar will then be VUE, while for command VIEW in Mapping, Invar
  ! is  W. Outvar is MSPECTRE in the GO VIEW application.
  ! Loops can be parallelized for speed.
  !------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SPECTRUM'
  type(gildas) :: hin
  integer(kind=address_length) :: ipin,ipou,ipma,ip
  type(sic_descriptor_t) :: descr, desco, descm
  integer(kind=4) :: ibound(6),ier,nm,n,m,nc
  character(len=varname_length) :: invar,ouvar
  integer(kind=4) :: memory(2)
  integer(kind=size_length), allocatable :: ngood(:)
  real(kind=4), allocatable :: mask(:,:)
  logical :: found
  real(kind=4), save, target :: aire
  integer(kind=4), parameter :: opt_corner=1
  integer(kind=4), parameter :: opt_mean=2
  integer(kind=4), parameter :: opt_plane=3
  integer(kind=4), parameter :: opt_sum=4
  logical :: do_sum
  character(len=message_length) :: mess
  !
  if (greg_poly_isnull()) then
    call greg_message(seve%e,rname,'Greg polygon is not defined')
    error = .true.
    return
  endif
  !
  if (sic_present(opt_mean,0)) then
    if (sic_present(opt_sum,0)) then
      call greg_message(seve%e,rname,'Conflicting option /MEAN and /SUM')
      error = .true.
      return
    endif
    do_sum = .false.
  else if (sic_present(opt_sum,0)) then
    do_sum = .true.
  else
    call greg_message(seve%e,rname,'Missing option /MEAN or /SUM')
    error = .true.
    return
  endif
  !
  call gildas_null(hin)
  !
  invar = 'W'
  call sic_ch(line,0,2,invar,n,.false.,error)
  m = len_trim(invar)
  call sic_upper(invar)
  ! Allow the name to have the %data postfix
  if (m.gt.5 .and. invar(m-4:m).eq."%DATA") then
    n = m-5
  else
    n = m
  endif
  !
  ! Get dimensions
  error = .true.
  hin%gil%ndim = 3
  call sic_descriptor(invar(1:n)//'%DIM',descr,found)
  if (.not.found) then
    call greg_message(seve%e,rname,'Input variable '//invar(1:m)//' not found')
    return
  endif
  ip = gag_pointer(descr%addr,memory)
  if (index_length.eq.4) then
    call i4toi4(memory(ip),hin%gil%dim,3)
  else
    call i8toi8(memory(ip),hin%gil%dim,3)
  endif
  !
  ! Get conversion formula
  call sic_descriptor(invar(1:n)//'%CONVERT',descr,found)
  if (.not.found) return
  ip = gag_pointer(descr%addr,memory)
  call r8tor8(memory(ip),hin%gil%convert,12)
  !
  ! Get Blanking
  call sic_descriptor(invar(1:n)//'%BLANK',descr,found)
  if (.not.found) return
  ip = gag_pointer(descr%addr,memory)
  call r4tor4(memory(ip),hin%gil%bval,2)
  !
  ! Get input array
  call sic_descriptor(invar(1:m),descr,found)
  if (.not.found) return
  ipin = gag_pointer(descr%addr,memory)
  !
  ! Get output array
  call sic_ch(line,0,1,ouvar,n,.true.,error)
  if (error) return
  call sic_descriptor(ouvar(1:n),desco,found)
  if (.not.found) then
    call greg_message(seve%e,rname,'Output variable not found')
    error = .true.
    return
  endif
  ipou = gag_pointer(desco%addr,memory)
  !
  ! Get mask if any
  if (sic_present(0,3)) then
    call sic_ch(line,0,3,ouvar,n,.true.,error)
    if (error) return
    call sic_descriptor(ouvar(1:n),descm,found)
    if (.not.found) then
      call greg_message(seve%e,rname,'Mask variable not found')
      error = .true.
      return
    endif
    ipma = gag_pointer(descm%addr,memory)
    nm = max(descm%dims(3),1)
  else
    allocate(mask(hin%gil%dim(1),hin%gil%dim(2)),stat=ier)
    if (ier.ne.0) then
      call greg_message(seve%e,rname,'Mask allocation error')
      error = .true.
      return
    endif
    mask = 1.0
    nm = 1
    ipma = gag_pointer(locwrd(mask),memory)
  endif
  !
  ! /CORNER option handling
  ibound(1:2) = 0
  call sic_i4(line,opt_corner,1,ibound(1),.false.,error)
  if (error) return
  call sic_i4(line,opt_corner,2,ibound(3),.false.,error)
  if (error) return
  ier = gdf_range(ibound(1:2),hin%gil%dim(1))
  !
  ibound(3:4) = 0
  call sic_i4(line,opt_corner,3,ibound(3),.false.,error)
  if (error) return
  call sic_i4(line,opt_corner,4,ibound(4),.false.,error)
  if (error) return
  ier = gdf_range(ibound(3:4),hin%gil%dim(2))
  !
  ! /PLANE option handling
  ibound(5:6) = 0
  call sic_i4(line,opt_plane,1,ibound(5),.false.,error)
  if (error) return
  call sic_i4(line,opt_plane,2,ibound(6),.false.,error)
  if (error) return
  ier = gdf_range(ibound(5:6),hin%gil%dim(3))
  !
  nc = ibound(6)-ibound(5)+1
  if (nc.ne.desco%size) then
    call greg_message(seve%e,rname,'Spectrum dimension mismatch')
    !!Print *,'nc ',nc,ibound(5:6),desco%size
    error = .true.
    return
  endif
  write(mess,'(A,I0)') 'Output number of channels ',nc
  call greg_message(seve%i,rname,mess)
  write(mess,'(A,I0,1X,I0)') 'Number of pixels ',hin%gil%dim(1),hin%gil%dim(2)
  call greg_message(seve%i,rname,mess)
  !
  allocate(ngood(nc),stat=ier)
  if (ier.ne.0) then
    call greg_message(seve%e,rname,'Allocation error')
    error = .true.
    return
  endif
  !
  call greg_drive_spectre(nc,memory(ipou),ngood,aire,hin,memory(ipin),ibound, &
       memory(ipma),nm,gpoly,do_sum,error)
  if (error) return
  if (all(ngood.eq.ngood(1))) then
    write(mess,'(A,I0)') 'Number of selected pixels ',ngood(1)
    call greg_message(seve%i,rname,mess)
  endif
  if (sic_varexist('POLY%AREA')) call sic_delvariable('POLY%AREA',.false.,error)
  call sic_def_real ('POLY%AREA',aire,0,1,.true.,error)
  !
end subroutine greg3_spectrum_compute
!
subroutine greg_drive_spectre(nc,spectrum,ngood,aire,hin,din,ibound,rmask,nm,poly,do_sum,error)
  use image_def
  use greg_interfaces
  use greg_types
  use greg_dependencies_interfaces
  use gbl_message
  !$ use omp_lib
  !
  ! @ no-interfaces
  !
  integer(kind=4),            intent(in)    :: nc               ! Number of channels
  real(kind=4),               intent(out)   :: spectrum(nc)     ! Integrated area per plane
  integer(kind=size_length),  intent(out)   :: ngood(nc)        ! Area of valid pixels per plane
  real(kind=4),               intent(out)   :: aire             ! Area of support
  type(gildas),               intent(inout) :: hin              ! Image header
  real(kind=4),               intent(in)    :: din(hin%gil%dim(1),hin%gil%dim(2),hin%gil%dim(3)) ! Cube
  integer(kind=4),            intent(inout) :: ibound(6)        ! Cube boundaries
  integer(kind=4),            intent(in)    :: nm               ! Mask last dim
  real(kind=4),               intent(in)    :: rmask(hin%gil%dim(1),hin%gil%dim(2),nm) ! Real mask (0 or 1)
  type (polygon_t),           intent(in)    :: poly             ! Polygon
  logical,                    intent(in)    :: do_sum           ! Sum or Mean
  logical,                    intent(inout) :: error            ! Error flag
  !                           
  integer(kind=size_length) :: i,j,imin,imax,jmin,jmax,kmin,kmax,nk
  real(kind=8) :: x,y
  integer(kind=4) :: k
  !
  real(kind=8), allocatable :: t_spec(:,:), ouspec(:)
  integer(kind=size_length),allocatable :: t_good(:,:),t_nk(:)
  integer(kind=4) :: nt, ithread, ier
  character(len=message_length) :: mess
  !
  character(len=*), parameter :: rname = "GREG>DRIVE>SPECTRE"
  !
  if (poly%ngon.gt.0) then
    !
    ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
    if (hin%gil%inc(1).gt.0.) then
      imin = max (1,    int((poly%xgon1-hin%gil%val(1))/hin%gil%inc(1)+hin%gil%ref(1)) )
      imax = min (hin%gil%dim(1),int((poly%xgon2-hin%gil%val(1))/hin%gil%inc(1)+hin%gil%ref(1))+1 )
    else
      imin = max (1,    int((poly%xgon2-hin%gil%val(1))/hin%gil%inc(1)+hin%gil%ref(1)) )
      imax = min (hin%gil%dim(1),int((poly%xgon1-hin%gil%val(1))/hin%gil%inc(1)+hin%gil%ref(1))+1 )
    endif
    if (hin%gil%inc(2).gt.0.) then
      jmin = max (1,    int((poly%ygon1-hin%gil%val(2))/hin%gil%inc(2)+hin%gil%ref(2)) )
      jmax = min (hin%gil%dim(2),int((poly%ygon2-hin%gil%val(2))/hin%gil%inc(2)+hin%gil%ref(2))+1 )
    else
      jmin = max (1,    int((poly%ygon2-hin%gil%val(2))/hin%gil%inc(2)+hin%gil%ref(2)) )
      jmax = min (hin%gil%dim(2),int((poly%ygon1-hin%gil%val(2))/hin%gil%inc(2)+hin%gil%ref(2))+1 )
    endif
    ibound(1) = max(ibound(1),imin)
    ibound(2) = min(ibound(2),imax)
    ibound(3) = max(ibound(3),jmin)
    ibound(4) = min(ibound(4),jmax)
  endif
  !
  !
  ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
  imin = ibound(1)
  imax = ibound(2)
  jmin = ibound(3)
  jmax = ibound(4)
  kmin = ibound(5)
  kmax = ibound(6)
  !
  nt = 1
  !$ nt = omp_get_max_threads()
  allocate(t_spec(nc,nt),t_good(nc,nt),t_nk(nt),ouspec(nc),stat=ier)
  if (failed_allocate(rname,"Spectrum per thread",ier,error)) return
  t_nk(:) = 0
  t_spec(:,:) = 0.0
  t_good(:,:) = 0
  ithread = 1
  !
  !$OMP PARALLEL DEFAULT(none) SHARED(t_good,t_spec,poly,rmask,din,nt) &
  !$OMP  & SHARED(kmin,kmax,jmin,jmax,imin,imax) &
  !$OMP  & PRIVATE(i,j,x,y,ithread) &
  !$OMP  & SHARED(nm, hin, t_nk, mess,nc)
  !$  ithread = omp_get_thread_num()+1
  !$  if (ithread.eq.1) then
  !$    nt = omp_get_num_threads()
  !$    if (nt.gt.1) then
  !$      write(mess,'(A,I0,A)') 'Using ',nt,' threads'
  !$      call greg_message(seve%d,'T_SPECTRUM',mess)
  !$    endif
  !$  endif
  !
  ! Now explore a reasonable part of the map
  if (hin%gil%eval.lt.0.0) then ! No blanking value, using nans
     if (nm.le.1) then
        ! Global mask
        !$OMP DO COLLAPSE(2)
        do j=jmin,jmax
           do i=imin,imax
              x = (i-hin%gil%ref(1))*hin%gil%inc(1) + hin%gil%val(1)
              y = (j-hin%gil%ref(2))*hin%gil%inc(2) + hin%gil%val(2)
              if (greg_poly_inside(x,y,poly).and.rmask(i,j,1).gt.0.0) then
                 t_nk(ithread) = t_nk(ithread)+1
                 do k=1,nc
                    if (din(i,j,kmin+k-1).eq.din(i,j,kmin+k-1)) then  ! Not NaN
                       t_good(k,ithread) = t_good(k,ithread) + 1
                       t_spec(k,ithread) = t_spec(k,ithread) + din(i,j,kmin+k-1)
                    endif
                 enddo
              endif
           enddo
        enddo
        !$OMP END DO
     else
        ! Per plane mask
        !$OMP DO COLLAPSE(2)
        do j=jmin,jmax
           do i=imin,imax
              x = (i-hin%gil%ref(1))*hin%gil%inc(1) + hin%gil%val(1)
              y = (j-hin%gil%ref(2))*hin%gil%inc(2) + hin%gil%val(2)
              if (greg_poly_inside(x,y,poly)) then
                 t_nk(ithread) = t_nk(ithread)+1
                 do k=1,nc
                    if (din(i,j,kmin+k-1).eq.din(i,j,kmin+k-1) .and. &  ! Not NaN
                        rmask(i,j,kmin+k-1).gt.0.0) then
                       t_good(k,ithread) = t_good(k,ithread) + 1
                       t_spec(k,ithread) = t_spec(k,ithread) + din(i,j,kmin+k-1)
                    endif
                 enddo
              endif
           enddo
        enddo
        !$OMP END DO
     endif
  else
    if (nm.le.1) then
        ! Global mask
        !$OMP DO COLLAPSE(2)
        do j=jmin,jmax
           do i=imin,imax
              x = (i-hin%gil%ref(1))*hin%gil%inc(1) + hin%gil%val(1)
              y = (j-hin%gil%ref(2))*hin%gil%inc(2) + hin%gil%val(2)
              if (greg_poly_inside(x,y,poly).and.rmask(i,j,1).gt.0.0) then
                 t_nk(ithread) = t_nk(ithread)+1
                 do k=1,nc
                    if (abs(din(i,j,kmin+k-1)-hin%gil%bval).gt.hin%gil%eval) then
                       t_good(k,ithread) = t_good(k,ithread) + 1
                       t_spec(k,ithread) = t_spec(k,ithread) + din(i,j,kmin+k-1)
                    endif
                 enddo
              endif
           enddo
        enddo
        !$OMP END DO
     else
        ! Per plane mask
        !$OMP DO COLLAPSE(2)
        do j=jmin,jmax
           do i=imin,imax
              x = (i-hin%gil%ref(1))*hin%gil%inc(1) + hin%gil%val(1)
              y = (j-hin%gil%ref(2))*hin%gil%inc(2) + hin%gil%val(2)
              if (greg_poly_inside(x,y,poly)) then
                 t_nk(ithread) = t_nk(ithread)+1
                 do k=1,nc
                    if (abs(din(i,j,kmin+k-1)-hin%gil%bval).gt.hin%gil%eval.and.rmask(i,j,kmin+k-1).gt.0.0) then
                       t_good(k,ithread) = t_good(k,ithread) + 1
                       t_spec(k,ithread) = t_spec(k,ithread) + din(i,j,kmin+k-1)
                    endif
                 enddo
              endif
           enddo
        enddo
        !$OMP END DO
     endif
  endif
  !$OMP END PARALLEL
  !
  ! Post treatment
  ngood(:)  = 0
  ouspec(:) = 0.
  nk        = 0
  do i=1,nt
     nk = nk + t_nk(i)
     ouspec(:) = ouspec(:) + t_spec(:,i)
     ngood(:)  = ngood(:)  + t_good(:,i)
  enddo
  !
  if (.not.do_sum) then
     where (ngood.ne.0) ouspec = ouspec/ngood
  endif
  !
  if (do_sum) ouspec(:) = ouspec(:) * abs(hin%gil%inc(1) * hin%gil%inc(2))
  aire = nk * abs(hin%gil%inc(1) * hin%gil%inc(2))
  !
  spectrum(:) = real(ouspec(:),kind=4)
  !
end subroutine greg_drive_spectre
