program xview_main
  use gildas_def
  use gbl_format
  use gkernel_interfaces
  use gkernel_types
  !---------------------------------------------------------------------
  ! X-Window viewer for GILDAS images
  !     F.Badia - F.Viallefond - S.Guilloteau
  !---------------------------------------------------------------------
  ! Global
  integer :: lenc
  integer(kind=address_length) :: gag_pointer
  include 'gbl_xpar.inc'
  include 'gbl_memory.inc'
  include 'mview.inc'
  ! Local
  character(len=80) :: namex
  character(len=256) :: helpfile,helptxt
  integer*4 :: blc(4), trc(4), pids(3)
  integer :: i,form,n
  real :: blank(2)
  logical :: error
  type(projection_t) :: proj
  external :: user_coord
  !
  data blc /4*0/, trc /4*0/
  !
  write(6,*) 'F-XVIEW,  Tasks has not yet been ported to support large data sets'
  ! In particular blc and trc must be integer(kind=index_length)
  call sysexi(fatale)
  !
  call gildas_open
  call gildas_char('X_NAME$',namex)
  call gildas_inte('BLC$',blc,4)
  call gildas_inte('TRC$',trc,4)
  call gildas_inte('PROCESS_IDS$',pids,3)
  call gildas_close
  !
  call sic_parsef(namex,x_file,' ','.gdf')
  call gdf_geis (x_islo,error)
  if (.not.error) call   &
     &    gdf_reis (x_islo,x_type,x_file,x_form,x_size,error)
  if (error) then
    write(6,*) 'F-XVIEW,  Cannot read input file'
    call sysexi(fatale)
  endif
  call gdf_readx (x_islo,error)
  !
  ! Define projection and axis types.
  if (x_proj.ne.0 .and. x_ptyp.ne.0) then
    if (x_xaxi.eq.0.and.x_yaxi.eq.0) then
      x_xaxi = 1
      x_yaxi = 2
    endif
    call gwcs_projec(x_a0,x_d0,x_pang,x_ptyp,proj,error)
  else
    x_xaxi = 1
    x_yaxi = 2
    call gwcs_projec(x_a0,x_d0,x_pang,0,proj,error)
  endif
  if (x_faxi.eq.0) then
    do i=1,3
      if (i.ne.x_xaxi .and. i.ne.x_yaxi) x_faxi = i
    enddo
  endif
  !
  ! Blanking
  if (x_blan.eq.0) then
    x_bval = 0.0
    x_eval = -1.0
  endif
  !
  ! Define and load subset
  do i=1,4
    blc(i) = max(1,min(blc(i),x_dim(i)))
    if (trc(i).eq.0) then
      trc(i) = x_dim(i)
    else
      trc(i) = min(x_dim(i),trc(i))
    endif
    dim(i) = trc(i)-blc(i)+1
  enddo
  ox = blc(1)
  oy = blc(2)
  oz = blc(3)
  form = fmt_r4
  call gdf_gems (x_mslo,x_islo,blc,trc,x_addr,form,error)
  ipx = gag_pointer(x_addr,memory)
  !
  ! Give to MVIEW
  n = lenc(x_file)+1
  x_file(n:n) = char(0)
  helpfile='mview'
  if (sic_findfile(helpfile,helptxt,'TASK#DIR:','.hlp')) then
    n = lenc(helptxt)
    n = n+1
    helptxt(n:n) = char(0)
  else
    helptxt(n:n) = char(0)
  endif
  blank(1) = x_bval
  blank(2) = x_eval
  call mview (x_file,memory(ipx),dim, user_coord,   &
     &    helptxt,pids,blank)
  call gdf_fris (x_islo,error)
  !
end program xview_main
!
subroutine user_coord(ix,jy,kz,u,chainx,chainy,chainz,chainv)
  use gkernel_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! Return User coordinates corresponding to one pixel, and the
  ! associated pixel value, as well as formatted strings to display
  ! the result
  !---------------------------------------------------------------------
  integer, intent(in) ::  ix                 ! Pixel number
  integer, intent(in) ::  jy                 ! Pixel number
  integer, intent(in) ::  kz                 ! Pixel number
  real(kind=8), intent(out) :: u(3)          ! User coordinates
  character(len=80) , intent(out) :: chainx  ! X string
  character(len=80) , intent(out) :: chainy  ! Y string
  character(len=80) , intent(out) :: chainz  ! Z string
  character(len=80) , intent(out) :: chainv  ! Value string
  ! Global
  integer(kind=address_length) :: gag_pointer
  real*4 :: value
  include 'gbl_xpar.inc'
  include 'gbl_memory.inc'
  include 'mview.inc'
  ! Local
  real*8 :: ux,vy,wz,aux,avy
  real*4 :: r
  character(len=80) :: chain(3)
  !
  data chain/' ',' ',' '/
  !
  ! Get value first
  ipx = gag_pointer(x_addr,memory)
  r = value (memory(ipx),dim(1),dim(2),dim(3),ix,jy,kz)
  write(chainv,'(1PG11.3)') r
  chainv(13:) = x_unit
  !
  ! Convert to original pixels
  u(1) = (dble(ix+ox-1)-x_ref1)*x_inc1+x_val1
  u(2) = (dble(jy+oy-1)-x_ref2)*x_inc2+x_val2
  u(3) = (dble(kz+oz-1)-x_ref3)*x_inc3+x_val3
  !
  ! Compute the various permutations...
  ux = u(x_xaxi)
  vy = u(x_yaxi)
  wz = u(x_faxi)
  !
  ! ZZZ This must be the 'proj' set by gwcs_setproj
  call rel_to_abs (proj,ux, vy, aux, avy, 1)
  !
  call sexag(chain(x_xaxi),aux,24)
  call sexag(chain(x_yaxi),avy,360)
  write(chain(x_faxi),'(F12.3)') wz
  !
  ! Inverse permutation
  chainx = trim(chain(1))//char(0)
  chainy = trim(chain(2))//char(0)
  chainz = trim(chain(3))//char(0)
end subroutine user_coord
!
function value(z,nx,ny,nz,ix,iy,iz)
  real :: value                     !
  integer :: nx                     !
  integer :: ny                     !
  integer :: nz                     !
  real :: z(nx,ny,nz)               !
  integer :: ix                     !
  integer :: iy                     !
  integer :: iz                     !
  value = z(ix,iy,iz)
end function value
!
subroutine spectre(np,poly,s1)
  use gkernel_interfaces
  use gildas_def
  integer :: np                     !
  real :: poly(2,np)                !
  real :: s1(*)                     !
  ! Global
  real*4 :: value
  integer(kind=address_length) :: gag_pointer
  include 'gbl_xpar.inc'
  include 'gbl_memory.inc'
  include 'mview.inc'
  ! Local
  integer(kind=address_length) :: addr, ipa
  integer :: mp, ier
  integer :: imin,imax,jmin,jmax,i,j,k
  real*8 :: x,y,bound(5)
  real*4 :: val, bb, eb
  integer, allocatable :: s0(:)
  !
  allocate (s0(dim(3)),stat=ier)
  do i=1,dim(3)
    s0(i) = 0
    s1(i) = 0.
  enddo
  mp = np+1
  ier = sic_getvm(8*mp,addr)
  ipa = gag_pointer(addr,memory)
  call define_poly(poly,np,mp,memory(ipa),bound)
  !
  ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
  imin = max (1, int(bound(2)) )
  imax = min (dim(1),int(bound(3))+1 )
  jmin = max (1, int(bound(4)) )
  jmax = min (dim(2),int(bound(5))+1 )
  !
  ! Now explore a reasonable part of the map
  ipx = gag_pointer(x_addr,memory)
  if (x_eval.lt.0.0) then
    do j=jmin,jmax
      do i=imin,imax
        x = dble(i)
        y = dble(j)
        if (gr8_in(x,y,np,memory(ipa),bound)) then
          do k=1,dim(3)
            s0(k) = s0(k) + 1
            s1(k) = s1(k) + value (memory(ipx),   &
     &              dim(1),dim(2),dim(3),   &
     &              i,j,k)
          enddo
        endif
      enddo
    enddo
  else
    eb = x_eval
    bb = x_bval
    do j=jmin,jmax
      do i=imin,imax
        x = dble(i)
        y = dble(j)
        if (gr8_in(x,y,np,memory(ipa),bound)) then
          do k=1,dim(3)
            val = value (memory(ipx),   &
     &              dim(1),dim(2),dim(3),   &
     &              i,j,k)
            if (abs(val-bb).gt.eb) then
              s0(k) = s0(k) + 1
              s1(k) = s1(k) + val
            endif
          enddo
        endif
      enddo
    enddo
  endif
  !
  x = abs(x_inc1*x_inc2)
  do k=1,dim(3)
    if (s0(k).ne.0) then
      s1(k) = s1(k) / float(s0(k)) * x
    endif
  enddo
  deallocate (s0)
end subroutine spectre
!
subroutine define_poly (poly,np,mp,gons,bound)
  integer :: np                     !
  real*4 :: poly(2,np)              !
  integer :: mp                     !
  real*8 :: gons(mp,4)              !
  real*8 :: bound(5)                !
  ! Local
  integer :: i,ngon
  real*8 :: xgon1,xgon2,ygon1,ygon2
  !
  ! Setup the polygon data structure
  ngon = np
  do i=1,ngon
    gons(i,1) = poly(1,i)
    gons(i,2) = poly(2,i)
  enddo
  !
  gons(ngon+1,1) = gons(1,1)
  gons(ngon+1,2) = gons(1,2)
  xgon1 = gons(1,1)
  xgon2 = gons(1,1)
  ygon1 = gons(1,2)
  ygon2 = gons(1,2)
  do i=1,ngon
    gons(i,3) = gons(i+1,1)-gons(i,1)
    if (gons(i+1,1).lt.xgon1) then
      xgon1 = gons(i+1,1)
    elseif (gons(i+1,1).gt.xgon2) then
      xgon2 = gons(i+1,1)
    endif
    gons(i,4) = gons(i+1,2)-gons(i,2)
    if (gons(i+1,2).lt.ygon1) then
      ygon1 = gons(i+1,2)
    elseif (gons(i+1,2).gt.ygon2) then
      ygon2 = gons(i+1,2)
    endif
  enddo
  bound(1) = xgon1-0.01*(xgon2-xgon1)
  bound(2) = xgon1
  bound(3) = xgon2
  bound(4) = ygon1
  bound(5) = ygon2
end subroutine define_poly
