program mask_main
  use gildas_def
  use image_def
  use gbl_format
  use gkernel_interfaces
  use gkernel_types
  !---------------------------------------------------------------------
  ! GILDAS
  !  Mask all planes of a data cube according to a given polygon file.
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: name_in,name_out,polyfile
  real(kind=4) :: blank
  integer(kind=4) :: i,j,ier
  logical :: in,error,mblank
  logical, allocatable :: mask(:,:)
  type(gildas) :: x,y
  type(polygon_t) :: poly
  !
  error = .false.
  !
  ! Get parameters
  call gildas_open
  call gildas_char('POLYGON$',polyfile)
  call gildas_char('Y_NAME$',name_in)
  call gildas_char('X_NAME$',name_out)
  call gildas_logi('MASK_IN$',in,1)
  call gildas_logi('MODIFY$',mblank,1)
  if (mblank) call gildas_real('BLANKING$',blank,1)
  call gildas_close
  !
  call greg_poly_load('MASK',.true.,polyfile,poly,error)
  if (error)  goto 100
  !
  ! Read Input Map
  call gildas_null(y)
  y%gil%form = fmt_r4
  call gdf_read_gildas(y,name_in,'.lmv',error) 
  if (error) then
    call gagout('F-MASK,  Cannot read input file '//y%file)
    goto 100
  endif
  if (.not.mblank)  blank = y%gil%bval
  !
  ! Create Output Map
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  x%gil%blan_words = 2
  if (mblank) then
    x%gil%bval = blank
    x%gil%eval = 0.0
  else
    x%gil%eval = max(x%gil%eval,0.0)
  endif
  call sic_parsef(name_out,x%file,' ','.gdf')
  call gdf_create_image(x,error)
  if (error) then
    call gagout('F-MASK,  Cannot create output image')
    goto 100
  endif
  !
  allocate(mask(x%gil%dim(1),x%gil%dim(2)),  &
          y%r2d(x%gil%dim(1),x%gil%dim(2)),stat=ier)
  if (ier.ne.0) goto 100
  !
  ! Scale the polygon to pixel
  call gr8_scalpol(poly,x%gil%convert)
  !
  ! Define the mask once
  call gr4_getmask(mask,x%gil%dim(1),x%gil%dim(2),poly,in)
  !
  ! Mask all channels of the Output Map
  do j = 1,x%gil%dim(4)
    x%blc(4) = j
    x%trc(4) = j
    do i=1,x%gil%dim(3)
      x%blc(3) = i
      x%trc(3) = i
      y%blc = x%blc
      y%trc = x%trc
      call gdf_read_data(y,y%r2d,error)
      if (error) goto 100
      ! Mask
      where (mask) y%r2d = blank
      call gdf_write_data(x,y%r2d,error)
    enddo
  enddo
  call gagout('S-MASK,  Successful completion')
  call sysexi (1)
  !
100 call sysexi (fatale)
end program mask_main
!
subroutine gr8_scalpol(poly,zconv)
  use gkernel_types
  !---------------------------------------------------------------------
  ! GILDAS
  !     Scale a polygon data structure to pixel units
  !---------------------------------------------------------------------
  type(polygon_t), intent(inout) :: poly      !
  real(kind=8),    intent(in)    :: zconv(6)  ! Conversion formula
  ! Local
  real(kind=8) :: xref,xval,xinc,yref,yval,yinc,tmp
  integer(kind=4) :: i
  !
  xref = zconv(1)
  xval = zconv(2)
  xinc = zconv(3)
  yref = zconv(4)
  yval = zconv(5)
  yinc = zconv(6)
  !
  do i=1,poly%ngon
    poly%xgon(i)  = (poly%xgon(i) - xval)/xinc + xref
    poly%ygon(i)  = (poly%ygon(i) - yval)/yinc + yref
    poly%dxgon(i) =  poly%dxgon(i)/xinc
    poly%dygon(i) =  poly%dygon(i)/yinc
  enddo
  !
  poly%xout  = (poly%xout - xval)/xinc + xref
  poly%xgon1 = (poly%xgon1 - xval)/xinc + xref
  poly%xgon2 = (poly%xgon2 - xval)/xinc + xref
  if (xinc.lt.0) then
    tmp = poly%xgon1
    poly%xgon1 = poly%xgon2
    poly%xgon2 = tmp
  endif
  poly%ygon1 = (poly%ygon1 - yval)/yinc + yref
  poly%ygon2 = (poly%ygon2 - yval)/yinc + yref
  if (yinc.lt.0) then
    tmp = poly%ygon1
    poly%ygon1 = poly%ygon2
    poly%ygon2 = tmp
  endif
  poly%xout = poly%xgon1 - 0.05*(poly%xgon2-poly%xgon1)
end subroutine gr8_scalpol
!
subroutine gr4_getmask(z,nx,ny,poly,inside)
  use gkernel_interfaces
  use gkernel_types
  !---------------------------------------------------------------------
  !  Mask part of a regular grid map using a POLYGON, in
  !  PIXEL coordinates (for speed, use GR8_SETPOL before to scale it)
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx        ! Size of Map
  integer(kind=index_length), intent(in)  :: ny        ! Size of Map
  logical,         intent(out) :: z(nx,ny)  ! Mask to be computed
  type(polygon_t), intent(in)  :: poly      !
  logical,         intent(in)  :: inside    ! Mask Inside or Outside
  ! Local
  logical :: blank,good
  real(kind=8) :: x,y
  integer(kind=index_length) :: i,j,imin,imax,jmin,jmax
  !
  ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
  imin = max (1, int(poly%xgon1) )
  imax = min (nx,int(poly%xgon2)+1 )
  jmin = max (1, int(poly%ygon1) )
  jmax = min (ny,int(poly%ygon2)+1 )
  !
  ! Mask the outside or the inside ?
  blank = .not.inside
  good = .not.blank
  !
  ! Test location only when not known
  do j=1,ny
    if (j.lt.jmin .or. j.gt.jmax) then
      do i=1,nx
        z(i,j) = blank
      enddo
    else
      do i=1,nx
        if (i.lt.imin) then
          z(i,j) = blank
        elseif (i.gt.imax) then
          z(i,j) = blank
        else
          x = dble(i)
          y = dble(j)
          if (greg_poly_inside(x,y,poly)) then
            z(i,j) = good
          else
            z(i,j) = blank
          endif
        endif
      enddo
    endif
  enddo
end subroutine gr4_getmask
