module last_flux
  real(8) :: iter_counter
  real(8) :: cumulative_flux
  character(len=12) :: last_operation
  integer :: old_clean_type
  !
  integer :: iter_size=0  ! Size of arrays
  integer :: iter_curr=0  ! Current iteration #
  real(4) :: iter_limit, flux_limit         ! Plot limits
  real(4), allocatable :: iter_number(:)
  real(4), allocatable :: iter_flux(:)
end module last_flux
!
subroutine init_flux90 (method,head,ylimn,ylimp,ipen)
  use gkernel_interfaces
  use clean_def
  use image_def
  use last_flux
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for deconvolution
  !   Create or reuse the <FLUX window
  !---------------------------------------------------------------------
  type (clean_par), intent(in) :: method
  type (gildas), intent(in)    :: head
  real, intent(in)             :: ylimn, ylimp
  integer, intent(out)         :: ipen
  ! Local
  character(len=80) chain
  logical :: error
  !
  if (.not.gtexist('<FLUX')) then
    call gr_execl('CREATE DIRECTORY <FLUX /PLOT_PAGE 20 20 /GEOMETRY 256 256')
    call gr_execl('CHANGE DIRECTORY <FLUX')
  else
    call gr_execl('CHANGE DIRECTORY <FLUX')
    call gr_execl('CLEAR DIRECTORY')  ! Empty the directory (rm *)
  endif
  call gr_execl('CHANGE POSITION 7')
  call gr_exec1('SET BOX 2 19 2 19')
  iter_limit = max(1,min(500,method%m_iter))
  write(chain,'(A,F12.0,1X,1PG12.5,1X,1PG12.5)')   &
              'LIMITS 0 ',iter_limit,ylimn,ylimp
  flux_limit = ylimp
  call gr_exec1(chain)
  call gr_exec1('BOX')
  !
  ! Open a dummy RUNNING segment. If this is not done here, MAPPING
  ! crashes for unknown reasons when re-using the FLUX window...  
  ! Perhaps some drawing action is done in other parts of the code before any call 
  ! to next_flux...
  ipen = gr_spen(3)
  error = .false.
  call gr_segm('RUNNING',error)
  if (error)  return
  iter_counter = 0.d0
  cumulative_flux = 0.d0
  call relocate(iter_counter, cumulative_flux)
  last_operation = 'INIT_FLUX'
  old_clean_type = 3
  !
  iter_curr = 0
end subroutine init_flux90
  !
subroutine plot_multi90(niter,flux,is)
  use gkernel_interfaces
  use clean_def
  use image_def
  use last_flux
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for deconvolution
  !   Plot in the <FLUX window
  !---------------------------------------------------------------------
  integer, intent(in) :: is
  integer, intent(in) :: niter
  real, intent(in) :: flux
  !
  integer :: lpen
  logical :: error
  !
  if (niter.eq.1 .or. is.ne.old_clean_type) then
    error = .false.
    !!Print *,'Closing segment at PLOT_MULTI90'
    call gr_segm_close(error)   ! It may be empty, though
    lpen = gr_spen(is)
    old_clean_type = is
    error = .false.
    call gr_segm('RUNNING',error)
    if (error)  return
    if (niter.eq.1) call relocate(0.d0,0.d0)
  endif
  iter_counter = niter
  cumulative_flux = flux
  call draw(iter_counter, cumulative_flux)
  call gr_out
  last_operation = 'PLOT_MULTI90'
  !
end subroutine plot_multi90
!
subroutine connect_flux
  use gkernel_interfaces
  use last_flux
  !
  logical :: error
  !
  !!Print *,'Connecting to FLUX, last '//last_operation,iter_counter, cumulative_flux 
  call gr_execl('CHANGE DIRECTORY <FLUX')
  call gr_segm('RUNNING',error)  ! Open a new segment
  call relocate(iter_counter, cumulative_flux)
  last_operation = 'Connect_Flux '
  !
end subroutine connect_flux
!
subroutine next_flux90(niter,cum)
  use gkernel_interfaces
  use last_flux
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Draw in the <FLUX window
  !---------------------------------------------------------------------
  integer, intent(in) :: niter
  real, intent(in) :: cum
  !
  logical :: error
  real(8), parameter :: fact=4.d0 ! sqrt(2.d0)
  real(4), allocatable :: tmp(:)
  character(len=80) :: chain
  integer :: jsize, ier
  !
  if (iter_curr.ge.iter_size) then
    if (iter_size.eq.0) then
      !!Print *,'First allocation '
      iter_size = 500
      allocate(iter_flux(iter_size),iter_number(iter_size),stat=ier)
      !!Print *,'First allocation DONE '
    else
      !!Print *,'Expansion allocation '
      jsize = nint(fact*dble(iter_size))
      allocate (tmp(jsize))
      tmp(1:iter_size) = iter_number
      call move_alloc(from=tmp,to=iter_number)
      !!Print *,'Expansion allocation DONE (1)'
      allocate (tmp(jsize))
      tmp(1:iter_size) = iter_flux
      call move_alloc(from=tmp,to=iter_flux)
      iter_size = jsize
      !!Print *,'Expansion allocation DONE (2)'
    endif
    !
  endif
  !
  if (iter_curr.gt.iter_limit) then
    iter_limit = max(200.0,fact*real(iter_limit))    
    flux_limit = max(flux_limit,1.2d0*cum)
    !
    ! Erase the FLUX window
    call gr_segm_close(error)   ! It may be empty, though
    call gr_execl('CHANGE DIRECTORY <FLUX')
    call gr_execl('CLEAR DIRECTORY')  ! Empty the directory (rm *)
    call gr_execl('CHANGE POSITION 7')
    call gr_exec1('SET BOX 2 19 2 19')
    !
    ! Enlarge it
    write(chain,'(A,F12.0,A,1PG12.5)')   &
              'LIMITS 0 ',iter_limit,' = ',flux_limit 
    call gr_exec1(chain)
    call gr_exec1('BOX')
    !
    ! Plot the existing values
    error = .false.
    call gr_segm('RUNNING',error)
    if (error)  return
    call gr4_connect(iter_curr,iter_number,iter_flux,0.0,-1.0)
  endif
  !
  if (mod(niter,100).eq.1) then
    error = .false.
    !!Print *,'Closing segment at NEXT_FLUX, last '//last_operation
    call gr_segm_close(error)   ! It may be empty, though
    error = .false.
    call gr_segm('RUNNING',error)
    if (error)  return
    if (niter.eq.1) call relocate(0.d0,0.d0)
  endif
  !
  iter_counter = niter
  cumulative_flux = cum
  call draw(iter_counter, cumulative_flux)
  if (mod(niter,10).eq.0) call gr_out
  last_operation = 'NEXT_FLUX'
  !
  iter_curr = iter_curr+1
  iter_number(iter_curr) = iter_curr
  iter_flux(iter_curr) = cumulative_flux
end subroutine next_flux90
!
subroutine close_flux90(ipen,error)
  use gkernel_interfaces
  use last_flux
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Close the <FLUX segments
  !---------------------------------------------------------------------
  integer, intent(in)    :: ipen   ! New pen to be used
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  integer :: oldpen
  !
  !!Print *,'Closing segment at CLOSE_FLUX, last '//last_operation
  call gr_segm_close(error)
  oldpen = gr_spen(ipen)
  call gr_execl('CHANGE DIRECTORY <GREG')
  !
end subroutine close_flux90
!
subroutine re_mask(method,head,nl,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>re_mask
  use clean_def
  use image_def
  use last_flux
  use clean_support
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for Clean
  !   Re-compute mask in Major Cycles
  !---------------------------------------------------------------------
  type (clean_par), intent(inout) :: method
  type (gildas), intent(in) :: head
  integer, intent(inout) :: nl
  logical, intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CLARK'
  character(len=80) :: comm
  integer :: n
  !
  if (.not.method%qcycle) goto 100 
  !
  comm = ' '
  call sic_wprn('I-CLARK,  Press RETURN, C for cursor, '//   &
     &    ' or new polygon name ',comm,n)
  if (n.eq.0) goto 100
  n = len_trim(comm)
  if (n.eq.0) goto 100
  call gr_execl ('CHANGE DIRECTORY <CLARK')
  call gr_exec1 ('LIMITS /RGDATA')
  if (comm(1:n).eq.'C' .or. comm(1:n).eq.'c') then
    call greg_poly_define(rname,' ',.false.,supportpol,supportvar,error)
  else
    call greg_poly_define(rname,comm,.true.,supportpol,supportvar,error)
  endif
  if (error) goto 100
  !
  method%do_mask = .true.
  call check_mask(method,head)
  !
  ! This subroutine is called by CLARK but also SDI
100 continue
  if (method%pflux) then
    call gr_out
    call gr_execl ('CHANGE DIRECTORY <FLUX')
    call relocate(iter_counter, cumulative_flux) 
    call gr_out
  endif
  nl = method%nlist
end subroutine re_mask
!
subroutine init_plot(method,head,pdata)
  use gkernel_interfaces
  use clean_def
  use image_def
  use last_flux
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Create or reuse the <CLARK window, and draw in it. Then go back
  !   to <FLUX if needed.
  !---------------------------------------------------------------------
  type (clean_par), intent(in) :: method
  type (gildas), intent(in)    :: head
  real, intent(in)             :: pdata(head%gil%dim(1),head%gil%dim(2))
  ! Local
  real :: r1,r2
  logical :: error,exist
  character(len=80) :: chain
  ! Data
  real, save :: old_r1=-1.0
  real, save :: old_r2=+1.0
  !
  error = .false.
  !
  ! First, close the segment opened in <FLUX
  if (method%pflux) then
    !!Print *,'Closing segment at INIT_PLOT, last '//last_operation
    call gr_segm_close(error)
    error = .false.
  endif
  !
  if (head%gil%dim(1).eq.head%gil%dim(2)) then
    r1 = 1
    r2 = 1
  elseif (head%gil%dim(1).lt.head%gil%dim(2)) then
    r1 = float(head%gil%dim(1))/head%gil%dim(2)
    r2 = 1
  else
    r1 = 1
    r2 = float(head%gil%dim(2))/head%gil%dim(1)
  endif
  !
  ! Re-create, Re-use, or Modify directory
  exist = gtexist('<CLARK')
  if (exist) then
    if (old_r1.eq.r1 .and. old_r2.eq.r2) then
      call gr_execl ('CHANGE DIRECTORY <CLARK')
    else
      call gr_execl ('DESTROY DIRECTORY <CLARK')
      exist = .false.
    endif
  endif
  if (.not.exist) then
    write(chain,1000) 20.*r1,20.*r2,nint(384.0*r1),nint(384.0*r2)
    call gr_execl (chain)
    call gr_execl ('CHANGE DIRECTORY <CLARK')
    call gr_execl ('CHANGE POSITION 9')
  endif
  write(chain,1001) 20.*r1,20.*r2
  call gr_exec1 (chain)
  old_r1 = r1
  old_r2 = r2
  !
  call sic_delvariable('MRC',.false.,error) ! Program request
  call sic_def_real('MRC',pdata,2,head%gil%dim,.true.,error)
  call gr_exec2('PLOT MRC /SCALING LINE CLEAN_DMIN CLEAN_DMAX')
  call sic_delvariable('MRC',.false.,error)
  !
  ! Go back to <FLUX and open a new segment there
  if (method%pflux) then
    call gr_execl('CHANGE DIRECTORY <FLUX')
    call gr_segm('RUNNING',error)  ! Open a new segment
  endif
  !
1000  format('CREATE DIRECTORY <CLARK /PLOT_PAGE ',f5.1,1x,f5.1,  &
        ' /GEOMETRY ',i5,i5)
1001  format('SET BOX 0 ',f5.1,' 0 ',f5.1)
end subroutine init_plot
!
!
subroutine major_plot90 (method,head   &
     &    ,conv,niter,nx,ny,np,tcc  &
     &    ,clean,resid,poids)
  use gkernel_interfaces
  use clean_def
  use image_def
  use gbl_message
  !---------------------------------------------------------
  ! @ private
  !
  ! MAPPING 
  !   Plot result of Major Cycle
  !---------------------------------------------------------
  type (clean_par), intent(inout) :: method
  type (gildas), intent(in) :: head
  !
  logical, intent(inout) :: conv        ! Convergence status
  integer, intent(in) ::  niter         ! Number of iterations
  integer, intent(in) ::  nx            ! X size
  integer, intent(in) ::  ny            ! Y size
  integer, intent(in) ::  np            ! Number of planes
  real, intent(inout) :: clean(nx,ny)      ! Clean image
  real, intent(inout) :: resid(nx,ny)      ! Residuals
  real, intent(in) :: poids(nx,ny)         ! Weight image
  type (cct_par), intent(in) :: tcc(niter)
  !
  character(len=80) :: comm
  character(len=message_length) :: chain
  integer n,ier
  integer(kind=index_length) :: dim(4)
  real gain
  logical error,doplot
  !
  ! Will we plot something in the window <CLARK?
  doplot = method%pmrc .or. method%pclean .or. method%pcycle
  !
  ! Close the segment opened in <FLUX (if any)
  if (method%pflux .and. doplot)  then
    !!call gr_execl('DISPLAY DIRECTORY',error)
    call gr_segm_close(error)
    error = .false.
  endif
  !
  ! MRC plot
  dim = 0
  dim(1) = nx
  dim(2) = ny
  if (method%pmrc.or.method%pclean) then
    ! Plot clean map
    if (method%pmrc) then
      call map_message(seve%w,'MAJOR_CYCLE','MRC Not yet DEBUGGED')
    endif
    error = .false.
    !
    ! Add clean components to clean map
    if (method%n_iter.ne.0) then
      call clean_make90 (method, head, clean, tcc)
      if (np.le.1) then
        clean = clean+resid
      else
        clean = clean+resid*poids
      endif
    else
      if (np.le.1) then
        clean = resid
      else
        clean = resid*poids
      endif
    endif
    call gr_execl ('CHANGE DIR <CLARK')
    call sic_delvariable('MRC',.false.,error) ! Program request
    call sic_def_real('MRC',clean,2,dim,.true.,error)
    call gr_exec2 ('PLOT MRC /SCALING LIN CLEAN_DMIN CLEAN_DMAX')
  elseif (method%pcycle) then
    !
    ! Plot residuals only
    call gr_execl ('CHANGE DIR <CLARK')
    call sic_delvariable('MRC',.false.,error)
    call sic_def_real('MRC',resid,2,dim,.true.,error)
    call gr_exec2 ('PLOT MRC /SCALING LIN CLEAN_DMIN -CLEAN_DMIN')
  endif
  !
  ! Reconnect to the <FLUX directory if needed
  if (method%pflux .and. doplot) then
    call connect_flux
  endif
  !
  if (conv .or. .not.method%qcycle) return
  !
  ! Query mode:
  !
  ! Change loop gain if needed
  gain = -1.0
  do while (gain.lt.0.02 .or. gain.gt.0.8)
    comm = ' '
    call sic_wprn('I-CLARK,  Press RETURN, Q to Stop, '//   &
     &      ' or new gain value ',comm,n)
    if (n.eq.0) return
    call sic_upper (comm)
    if (comm(1:1).eq.'Q') then
      conv = .true.
      return
    elseif (len_trim(comm).eq.0) then
      return
    endif
    read(comm(1:lenc(comm)),*,iostat=ier) gain
    if (ier.ne.0) then
      gain = -1.0
    else
      write(chain,'(A,F4.2)') 'Gain is now ',gain
      call map_message(seve%i,'CLARK',chain)
    endif
  enddo
  method%gain = gain
end subroutine major_plot90
!
subroutine plot_mrc(method,head,array,code)
  use image_def
  use clean_def
  use imager_interfaces, except_this=>plot_mrc
  !----------------------------------------------------------------
  ! 
  ! @ private
  !
  ! MAPPING
  !   Dispatch the various plotting actions in MRC
  !----------------------------------------------------------------
  type(clean_par), intent(in) :: method
  type(gildas), intent(in) :: head
  integer, intent(in) :: code
  real, intent(in) :: array(head%gil%dim(1),head%gil%dim(2))
  !
  integer, save :: ipen
  logical :: error
  integer :: nx,ny
  !
  nx = head%gil%dim(1)
  ny = head%gil%dim(2)
  !
  if (code.eq.0) then
    ipen = 0
    if (method%pcycle) call init_plot (method,head,array)
  else if (code.eq.1) then  
    if (method%pflux) then
      !!Print *,'Calling close_flux '
      call close_flux90(ipen,error)
    endif
    call mrc_plot(array,nx,ny,1,'Difference')
    if (method%pflux) then
      !!Print *,'Back to <FLUX #1'
      call gr_execl('CHANGE DIREC <FLUX')
      call relocate(0.d0,0.d0)
      !!Print *,'Calling GR_OUT'  
      call gr_out
    endif
  else if (code.eq.2) then
    if (method%pflux) then
      !!Print *,'Calling close_flux '
      call close_flux90(ipen,error)
    endif
    call mrc_plot(array,nx,ny,2,'Smooth')
  else if (code.eq.3) then
    call mrc_plot(array,nx,ny,3,'Clean')
  endif
end subroutine  plot_mrc
!    
!
subroutine mrc_clear
  call gr_execl ('CHANGE DIRECTORY <MRC')
  call gr_execl ('CLEAR DIRECTORY')  ! Empty the directory (rm *)
end subroutine mrc_clear
!
subroutine mrc_plot(image,nx,ny,type,name)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Plot the smooth and difference final clean image in <MRC
  !   so as to keep them visible
  !---------------------------------------------------------------------
  integer, intent(in) :: nx,ny,type
  real, intent(in) :: image(nx*ny)
  character(len=*) name
  !
  integer, parameter :: npixel=256
  real rr1,rr2
  real old_rr1,old_rr2,rmin,rmax
  integer(kind=index_length) :: dim(4)
  integer :: i
  logical exist,error
  character(len=80) chain
  !
  save old_rr1,old_rr2,rmin,rmax
  data old_rr1/-1./,old_rr2/+1./
  !
  ! Create SIC variables
  !!Print *,'Into MRC_PLOT '
  error = .false.
  dim(1) = nx
  dim(2) = ny
  call sic_def_real('MY_MRC',image,2,dim,.true.,error)
  !
  ! Image min and max (and scale factor)
  rmin = image(1)
  rmax = image(1)
  do i=1,nx*ny
    if (image(i).gt.rmax) rmax = image(i)
    if (image(i).lt.rmin) rmin = image(i)
  enddo
  if (rmin.eq.rmax) then
    rmin = -0.1
    rmax = 0.1
  endif
  !
  ! Window size
  if (nx.eq.ny) then 
    rr1 = 3
    rr2 = 1
  elseif (nx.lt.ny) then 
    rr1 = 3*float(nx)/float(ny) 
    rr2 = 1
  else
    rr1 = 3
    rr2 = float(ny)/float(nx) 
  endif
  !
  exist = gtexist('<MRC')
  if (exist) then
    !!Print *,'<MRC exists'
    if (old_rr1.eq.rr1 .and. old_rr2.eq.rr2) then
      call gr_execl ('CHANGE DIREC <MRC')
    else
      call gr_execl ('DESTROY DIRECTORY <MRC')
      exist = .false.
    endif
  endif
  if (.not.exist) then
    !!Print *,'<MRC is being created'
    write(chain,1000) 20.*rr1,20.*rr2,nint(npixel*rr1),   &
     &      nint(npixel*rr2)
    call gr_execl (chain)
    call gr_execl ('CHANGE DIREC <MRC')
    call gr_execl ('CHANGE POSITION 9')
  endif
  !
  ! Premier passage
  if (type.eq.1) then
    old_rr1 = rr1
    old_rr2 = rr2
    write(chain,1001) 0.0,20./3.*rr1,0.0,20.*rr2
    call gr_exec1(chain)
    !
    write(chain,'(A,1PG11.4,1X,1PG11.4)')   &
     &      'PLOT MY_MRC /SCALING LINEAR ',   &
     &      rmin, rmax
    !!Print *,trim(chain)
    call gr_exec2 (chain)
    call gr_exec1 ('BOX N N N N')
    !
    write(chain,1006) rmin,rmax
    call gr_exec1 ('SET EXPAND 2')
    call gr_exec1 (chain)
    write(chain,1007) name
    call gr_exec1 (chain)
    call gr_exec1 ('SET EXPAND 1')
  else
    !
    ! Smooth plot (TYPE=2) and Final plot (TYPE=3). <MRC exists
    call gr_execl ('CHANGE DIREC <MRC')
    write(chain,1001) 20./3.*(type-1)*rr1,20./3.*type*rr1,   &
     &      0.0,20.*rr2
    !!Print *,trim(chain)
    call gr_exec1(chain)
    !
    write(chain,'(A,1PG11.4,1X,1PG11.4)')   &
     &      'PLOT MY_MRC /SCALING LINEAR ',   &
     &      rmin, rmax
    !!Print *,trim(chain)
    call gr_exec2 (chain)
    call gr_exec1 ('BOX N N N N')
    !
    write(chain,1006) rmin,rmax
    if (type.ge.2) then
      call gr_exec1 ('SET EXPAND 2')
      call gr_exec1 (chain)
      write(chain,1007) name
      call gr_exec1 (chain)
      call gr_exec1 ('SET EXPAND 1')
    endif
  endif
  !
  old_rr1 = rr1
  old_rr2 = rr2
  call sic_delvariable('MY_MRC',.false.,error)
  !
  1000  format('CREATE DIREC <MRC /PLOT_PAGE ',f5.1,1x,f5.1,   &
          ' /GEOMETRY ',i5,i5)
  1001  format('SET BOX ',f5.1,1x,f5.1,1x,f5.1,1x,f5.1)
  1004  format('DRAW TEXT ',f5.1,1x,f5.1,' "Difference" 5 /BOX 1')
  1005  format('DRAW TEXT ',f5.1,1x,f5.1,' "Smooth" 5 /BOX 1')
  1006  format('DRAW TEXT 0 1 "',1pg10.3,1x,1pg10.3,'" 5 /CHAR 2')
  1007  format('DRAW TEXT 0 -1 "',a,'" 5 /CHAR 8')
  !
end subroutine mrc_plot
