subroutine greg_extrema(line,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_extrema
  use greg_kernel
  use greg_pen
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  [GREG2\]EXTREMA
  !  1       [/BLANKING Bval Eval]
  !  2       [/PLOT]
  !  3       [/COMPUTE]
  !  4       [/LOCAL PLOT|TERMINAL|FileName]
  ! Find the extrema of regular grid array loaded
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='EXTREMA'
  real(kind=4) :: zmin,zmax,bval,eval
  logical :: forced,dolocal,toplot,toterm
  integer(kind=4) :: icode,nc,tolun,iarg,ier
  character(len=filename_length) :: argum,filename
  character(len=*), parameter :: plot='PLOT'
  character(len=*), parameter :: terminal='TERMINAL'
  !
  if (rg%status.eq.code_pointer_null) then
    call greg_message(seve%w,'EXTREMA','No map loaded')
    error = .true.
    return
  endif
  !
  ! EXTREMA /BLANK
  bval = cblank
  call sic_r4 (line,1,1,bval,.false.,error)
  if (error) return
  eval = eblank
  call sic_r4 (line,1,2,eval,.false.,error)
  if (error) return
  !
  ! EXTREMA /COMPUTE
  forced = sic_present(3,0)
  !
  ! EXTREMA /PLOT
  ! EXTREMA /LOCAL
  dolocal = .false.
  toplot = .false.
  toterm = .false.
  tolun = 0
  if (sic_present(2,0)) then  ! /PLOT
    ! Obsolescent since 10-jul-2013 (SB)
    ! call greg_message(seve%w,rname,  &
    !   'Option /PLOT is obsolescent. Use /LOCAL PLOT instead')
    dolocal = .true.
    toplot = .true.
  elseif (sic_present(4,0)) then  ! /LOCAL PLOT|TERMINAL|FileName
    dolocal = sic_narg(4).gt.0
    do iarg=1,sic_narg(4)
      call sic_ke(line,4,iarg,argum,nc,.true.,error)
      if (error)  return
      !
      if (argum(1:nc).eq.plot(1:min(nc,4))) then
        toplot = .true.
      elseif (argum(1:nc).eq.terminal(1:min(nc,8))) then
        toterm = .true.
      elseif (tolun.eq.0) then  ! Assume a filename
        call sic_ch(line,4,iarg,argum,nc,.true.,error)
        if (error)  return
        call sic_parse_file(argum,'','.dat',filename)
        ier = sic_getlun(tolun)
        if (ier.ne.1) then
          error = .true.
          return
        endif
        ier = sic_open(tolun,filename,'NEW',.false.)
        if (ier.ne.0) then
          error = .true.
          return
        endif
      else
        call greg_message(seve%w,rname,  &
          'Ignoring argument '''//trim(argum)//''' (not understood)')
      endif
    enddo
  endif
  !
  if (dolocal) then
    if (toplot)  call gtsegm('EXTREMA',error)
    if (penupd)  call setpen(cpen)
    call rgextr_local(rg%data,toplot,toterm,tolun,error)  ! Calls SETDAS in PUTLABEL
    if (toplot)  call gtsegm_close(error)
    if (tolun.ne.0) then
      ier = sic_close(tolun)
      call sic_frelun(tolun)
    endif
    !
  else
    if (sic_present(0,1)) then
      icode = 0
    else
      icode = 1
    endif
    call rgextr(icode,zmin,zmax,rg%data,bval,eval,forced)
  endif
  !
end subroutine greg_extrema
!
subroutine rgextr(itype,zmin,zmax,z,bval,eval,forced)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>rgextr
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  Finds the maxima and minima for Regular Grid array and writes on
  ! screen the values and corresponding position if ITYPE = 1
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: itype   ! Type values on screen
  real(kind=4)                :: zmin    ! Minimum map value (output)
  real(kind=4)                :: zmax    ! Maximum map value (output)
  real(kind=4),    intent(in) :: z(*)    ! RG map array
  real(kind=4),    intent(in) :: bval    ! Blanking value
  real(kind=4),    intent(in) :: eval    ! Tolerance on blanking
  logical,         intent(in) :: forced  ! Force computation
  ! Local
  character(len=*), parameter :: rname='EXTREMA'
  real(kind=4) :: tmin,tmax,oldbval,oldeval
  integer(kind=size_length) :: kmin,kmax
  integer(kind=4):: i,j
  integer(kind=4) :: imin,imax,jmin,jmax
  logical :: compute
  character(len=80) :: chain
  integer(kind=size_length) :: nelem
  !
  save oldbval,oldeval
  ! Data
  data oldeval/1e18/, oldbval/0/
  !
  if (forced) then
    compute = .true.
  elseif (.not.rg%minmax) then
    compute = .true.
  elseif (eval.lt.0 .and. oldeval.lt.0) then
    compute = .false.
  elseif (oldeval.ne.eval .or. abs(bval-oldbval).gt.eval) then
    compute = .true.
  else
    compute = .false.  ! Do not recompute if already done
  endif
  !
  if (compute) then
    nelem = rg%nx*rg%ny
    call gr4_minmax (nelem,z,bval,eval,tmin,tmax,kmin,kmax)
    rg%minmax = .true.
    oldbval = bval
    oldeval = eval
    !
    ! Compute coordinates corresponding to KZ1
    i = mod(kmin,rg%nx)
    if (i.eq.0) i = rg%nx
    j = (kmin-i)/rg%nx + 1
    rg%zxmin = rg%xval + (i-rg%xref)*rg%xinc
    rg%zymin = rg%yval + (j-rg%yref)*rg%yinc
    rg%zmin = tmin
    !
    ! Compute coordinates corresponding to KZ2
    i = mod(kmax,rg%nx)
    if (i.eq.0) i = rg%nx
    j = (kmax-i)/rg%nx + 1
    rg%zxmax = rg%xval + (i-rg%xref)*rg%xinc
    rg%zymax = rg%yval + (j-rg%yref)*rg%yinc
    rg%zmax = tmax
  endif
  zmax = rg%zmax
  zmin = rg%zmin
  !
  ! Output results
  if (itype .ne. 0) then
    write(chain,100) 'Xmin = ',rg%xval+(1-rg%xref)*rg%xinc,  &
                   '  Xmax = ',rg%xval+(rg%nx-rg%xref)*rg%xinc
    call greg_message(seve%r,rname,chain)
    !
    write(chain,100) 'Ymin = ',rg%yval+(1-rg%yref)*rg%yinc,  &
                   '  Ymax = ',rg%yval+(rg%ny-rg%yref)*rg%yinc
    call greg_message(seve%r,rname,chain)
    !
    write(chain,100) 'Zmin = ',zmin,'  at X = ',rg%zxmin,'  Y = ',rg%zymin
    call greg_message(seve%r,rname,chain)
    !
    write(chain,100) 'Zmax = ',zmax,'  at X = ',rg%zxmax,'  Y = ',rg%zymax
    call greg_message(seve%r,rname,chain)
  endif
100 format(a,1pg12.5,a,1pg12.5,a,1pg12.5)
  return
  !
entry gr4_egive(zmin,zmax,imin,jmin,imax,jmax,bval,eval)
  !----------------------------------------------------------------------
  ! @ private
  !	Give extremas of the Regular Grid array and their positions
  !----------------------------------------------------------------------
  !
  rg%minmax = .true.
  oldbval = bval
  oldeval = eval
  rg%zxmin = rg%xval + (imin-rg%xref)*rg%xinc
  rg%zymin = rg%yval + (jmin-rg%yref)*rg%yinc
  rg%zmin = zmin
  rg%zxmax = rg%xval + (imax-rg%xref)*rg%xinc
  rg%zymax = rg%yval + (jmax-rg%yref)*rg%yinc
  rg%zmax = zmax
end subroutine rgextr
!
subroutine rgextr_local(z,toplot,toterm,tolun,error)
  use greg_interfaces, except_this=>rgextr_local
  use greg_kernel
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  Finds local extrema of the Regular Grid array
  !---------------------------------------------------------------------
  real(kind=4),    intent(in)    :: z(rg%nx,rg%ny)  ! Regular grid array
  logical,         intent(in)    :: toplot          ! Display on plot
  logical,         intent(in)    :: toterm          ! Display on terminal
  integer(kind=4), intent(in)    :: tolun           ! Output lun, if defined
  logical,         intent(inout) :: error           ! Logical error flag
  ! Local
  integer(kind=4) :: i,ist,ied,imin,imax,irg
  integer(kind=4) :: j,jst,jed,jmin,jmax,jrg
  real(kind=4) :: cur,val
  real(kind=8) :: x,y,x1,x2,y1,y2
  !
  if (toterm)      write(6,    '(A)')  '!   Value           Xoffset          Yoffset'
  if (tolun.ne.0)  write(tolun,'(A)')  '!   Value           Xoffset          Yoffset'
  !
  x1 = min(gux1,gux2)
  x2 = max(gux1,gux2)
  y1 = min(guy1,guy2)
  y2 = max(guy1,guy2)
  if (rg%xinc.gt.0.) then
    imin = max (1,    int((x1-rg%xval)/rg%xinc+rg%xref) )
    imax = min (rg%nx,int((x2-rg%xval)/rg%xinc+rg%xref)+1 )
  else
    imin = max (1,    int((x2-rg%xval)/rg%xinc+rg%xref) )
    imax = min (rg%nx,int((x1-rg%xval)/rg%xinc+rg%xref)+1 )
  endif
  if (rg%yinc.gt.0.) then
    jmin = max (1,    int((y1-rg%yval)/rg%yinc+rg%yref) )
    jmax = min (rg%ny,int((y2-rg%yval)/rg%yinc+rg%yref)+1 )
  else
    jmin = max (1,    int((y2-rg%yval)/rg%yinc+rg%yref) )
    jmax = min (rg%ny,int((y1-rg%yval)/rg%yinc+rg%yref)+1 )
  endif
  !
  irg = min(15,max(3,int(float(rg%nx)/8.0)))
  jrg = min(15,max(3,int(float(rg%ny)/8.0)))
  !
  do j=jmin,jmax
    do i=imin,imax
      val = z(i,j)
      !
      if (i.eq.imin) then
        if (val.ge.z(i+1,j))  goto 130
        if (val.ge.z(i+2,j))  goto 130
      elseif (i.eq.imax) then
        if (val.ge.z(i-1,j))  goto 140
        if (val.ge.z(i-2,j))  goto 140
      else
        if (val.ge.z(i-1,j))  goto 150
        if (val.ge.z(i+1,j))  goto 150
      endif
      !
      ! Candidate for a minimum, look in neighbourhood in
      ! range [i-irg:i+irg,j-jrg:j+jrg]
      jst = max(jmin,j-jrg)
      jed = min(jmax,j+jrg)
70    ist = max(imin,i-irg)
      ied = min(imax,i+irg)
      !
100   cur = z(ist,jst)
      if (val.lt.cur)  goto 110  ! Found a higher value in neighbourhood: continue
      if (val.gt.cur)  cycle     ! Found a lower value in neighbourhood: not a minimum
      if (i.eq.ist .and. j.eq.jst) goto 110  ! Looking at same pixel: continue
      cycle                      ! Found an equal value: not a lower minimum
      !
110   ist = ist+1                ! Iterate on next pixel in neighbourhood
      if (ist.le.ied) goto 100
      jst = jst+1                ! Iterate on next pixel in neighbourhood
      if (jst.le.jed) goto 70
      !
      ! Finished iterating in neighbourhood: val is a local minimum
      x = (i-rg%xref)*rg%xinc+rg%xval
      y = (j-rg%yref)*rg%yinc+rg%yval
      call uwrite(val,x,y)
      cycle
      !
      ! Maximum
      !
130   if (val.le.z(i+1,j))  cycle
      if (val.le.z(i+2,j))  cycle
      goto 160
      !
140   if (val.le.z(i-1,j))  cycle
      if (val.le.z(i-2,j))  cycle
      goto 160
      !
150   if (val.le.z(i+1,j))  cycle
      if (val.le.z(i-1,j))  cycle
      !
      ! Candidate for a maximum, look in neighbourhood in
      ! range [i-irg:i+irg,j-jrg:j+jrg]
160   jst = max(jmin,j-jrg)
      jed = min(jmax,j+jrg)
170   ist = max(imin,i-irg)
      ied = min(imax,i+irg)
      !
200   cur = z(ist,jst)
      if (val.gt.cur)  goto 210  ! Found a lower value in neighbourhood: continue
      if (val.lt.cur)  cycle     ! Found a higher value in neighbourhood: not a maximum
      if (i.eq.ist .and. j.eq.jst) goto 210  ! Looking at same pixel: continue
      cycle                      ! Found an equal value: not a higher maximum
      !
210   ist = ist+1                ! Iterate on next pixel in neighbourhood
      if (ist.le.ied) goto 200
      jst = jst+1                ! Iterate on next pixel in neighbourhood
      if (jst.le.jed) goto 170
      !
      ! Finished iterating in neighbourhood: val is a local maximum
      x = (i-rg%xref)*rg%xinc+rg%xval
      y = (j-rg%yref)*rg%yinc+rg%yval
      call uwrite(val,x,y)
      !
    enddo
  enddo
  !
contains
  subroutine uwrite(val,x,y)
    use greg_kernel
    !---------------------------------------------------------------------
    !  This subroutine writes the value VAL at location X,Y in User
    ! Coordinates. VAL is encoded in shortest format.
    !---------------------------------------------------------------------
    real(kind=4), intent(in) :: val   ! Value to be encoded
    real(kind=8), intent(in) :: x     ! X coordinate
    real(kind=8), intent(in) :: y     ! Y coordinate
    ! Local
    real(kind=4) :: expand0
    character(len=24) :: chain
    character(len=20) :: string
    integer(kind=4) :: nchar
    character(len=1), parameter :: backslash=char(92)
    !
    if (toplot) then
      expand0 = expand
      expand = 0.6*expand
      call conecd (val,string,nchar)
      call relocate(x,y)
      chain = backslash//backslash//'1'//string
      call putlabel(nchar+3,chain,5,tangle,.false.)
      expand = expand0
    endif
    if (toterm)      write(6,    '(1PG14.6,2(1X,1PG16.8))')  val,x,y
    if (tolun.ne.0)  write(tolun,'(1PG14.6,2(1X,1PG16.8))')  val,x,y
  end subroutine uwrite
end subroutine rgextr_local
