! Code for command DISCARD
! Code for command BUFFERS
! and some generic routines to support Buffers
! Specific UV routines in uv_buffers.f90
!
subroutine discard_comm(line,comm,error)
  use clean_def
  use clean_arrays
  use clean_default
  use clean_types
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : map_message, sub_discard
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command DISCARD
  !
  ! Delete some internal buffer(s) and associated SIC variable
  ! This is the parsing routine only.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  character(len=*), intent(in) :: comm  !! Command
  logical, intent(out) :: error         !! Logical error flag
  !
  integer, parameter :: muv=7
  integer, parameter :: mimag=13
  character(len=16) :: vuv(muv), vimag(mimag) 
  data vuv/    'UV_DATA',  'UVCONT', 'UVCALIB', 'UVSELF',  'UV_MODEL', 'CGAINS', 'UVRAW'/
  data vimag/ &
    & 'BEAM',    'CONTINUUM',    'DIRTY',    'RESIDUAL',    'CLEAN',    'SKY', &
    & 'MASK',    'PRIMARY',    'CCT',    'SINGLE',    'SHORT',    'SUPPORT', 'DATA' /
  !
  ! Local ---
  character(len=32) :: key
  character(len=512) :: str
  integer :: nk,i,istr
  logical :: doall, douv
  !
  ! Code ----
  error = .false.
  call sic_ch(line,0,1,key,nk,.true.,error)
  if (key.eq.'?') then
    call map_message(seve%i,'DISCARD','Available UV-Like buffers')
    write(*,*) vuv
    call map_message(seve%i,'DISCARD','Available Image-Like buffers')
    write(*,*) vimag
    return
  endif
  !
  str = ' '
  doall = .false.
  douv = .false.
  do i=1,sic_narg(0)
    !
    call sic_ke(line,0,i,key,nk,.true.,error)
    if (error) exit 
    !
    doall = key.eq.'*'
    douv  = key.eq.'UV*'
    if (key.eq.'UV') key = 'UV_DATA'
    call sub_discard(str,key,doall,douv)
    !
    if (doall.or.douv) then
      istr = len_trim(str)
      if (istr.gt.0) then
        str(istr:istr) = ']'
        call map_message(seve%i,comm,'Deallocated ['//str(1:istr))
      endif    
      str = ' '
    endif
  enddo
  !
  istr = len_trim(str)
  if (istr.gt.0) then
    str(istr:istr) = ']'
    call map_message(seve%i,comm,'Deallocated ['//str(1:istr))
  endif    
end subroutine discard_comm
!
subroutine sub_discard(str,key,doall,douv)  
  use clean_def
  use clean_arrays
  use clean_default
  use clean_types
  use clean_support
  use gbl_message
  use gkernel_interfaces, only : sic_delvariable, locwrd, gildas_null
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command DISCARD
  !
  ! Delete some internal buffer and its associated SIC variable
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: str  !! List of discarded buffers
  character(len=*), intent(in) :: key     !! Buffer to be discarded 
  logical :: doall !! Indicate if all Cube-like buffers should be discarded
  logical :: douv  !! Indicate if all UV-like buffers should be discarded
  !
  integer :: ier
  logical :: error
  !
  error = .false.
  ier = 0
  !
  if ((key.eq.'UV').or.(key.eq.'UV_DATA').or.douv) then
    if (associated(huv_init%r2d)) str = 'UV_DATA,'//trim(str)
    call discard_uvdata(error)
    if (error) ier = 1
    if (.not.douv) goto 100
  endif
  !
  if ((key.eq.'UVCONT').or.douv) then
    ! Delete the CONTINUUM UV data if defined
    call sic_delvariable ('UVCONT',.false.,error)
    if (allocated(duvc)) then
      str = 'UVCONT, '//trim(str)
      deallocate(duvc,stat=ier)
    endif
    huv_cont%loca%size = 0
    if (.not.douv) goto 100
  endif
  !
  if ((key.eq.'UVSELF').or.douv) then
    !
    ! Delete the SELF array if defined
    call sic_delvariable ('UVCALIB',.false.,error)
    call sic_delvariable ('UVSELF',.false.,error)
    if (associated(duvself)) then
      if (associated(duvself,duvcalib)) then
        nullify(duvself)
      else
        deallocate(duvself,stat=ier)
      endif
    endif
    if (allocated(duvcalib)) deallocate(duvcalib,stat=ier)
    str = 'UVSELF, '//trim(str)
    hself_self%loca%size = 0
    hself_calib%loca%size = 0
    if (.not.douv) goto 100
  endif
  !
  if ((key.eq.'UV_MODEL').or.douv) then
    ! Free the previous zone
    call sic_delvariable ('UV_MODEL',.false.,error)
    if (allocated(duvm)) then
      str = 'UV_MODEL, '//trim(str)
      deallocate(duvm,stat=ier)
      huv_model%loca%size = 0
    endif
    if (.not.douv) goto 100
  endif
  !
  if ((key.eq.'CGAINS').or.douv) then
    ! Free the previous zone
    call sic_delvariable ('CGAINS',.false.,error)
    if (allocated(duvbg)) then
      str = 'CGAINS, '//trim(str)
      deallocate(duvbg,stat=ier)
      hbgain%loca%size = 0
    endif
    if (.not.douv) goto 100
  endif
  !
  if ((key.eq.'UVRAW').or.douv) then
    ! Free the previous zone
    call sic_delvariable ('UVRAW',.false.,error)
    if (allocated(duvraw)) then
      str = 'UVRAW, '//trim(str)
      deallocate(duvraw,stat=ier)
      hself_raw%loca%size = 0
    endif
    if (.not.douv) goto 100
  endif
  
  !
  if ((key.eq.'BEAM').or.doall) then
    save_data(code_save_beam) = .false.
    call sic_delvariable ('BEAM',.false.,error)
    if (allocated(dbeam)) then
      str = 'BEAM, '//trim(str)
      deallocate(dbeam,stat=ier)
    endif
    hbeam%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'CONTINUUM').or.doall) then
    ! Delete the CONTINUUM image if defined
    save_data(code_save_cont) = .false.
    call sic_delvariable ('CONTINUUM',.false.,error)
    if (allocated(dcont)) then
      deallocate(dcont,stat=ier)
      str = 'CONTINUUM, '//trim(str)
    endif
    hcont%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  !
  if ((key.eq.'DIRTY').or.doall) then
    save_data(code_save_dirty) = .false.
    call sic_delvariable ('DIRTY',.false.,error)
    if (allocated(ddirty)) then
      str = 'DIRTY, '//trim(str)
      deallocate(ddirty,stat=ier)
    endif
    hdirty%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'RESIDUAL').or.doall) then
    save_data(code_save_resid) = .false.
    call sic_delvariable ('RESIDUAL',.false.,error)
    if (allocated(dresid)) then
      str = 'RESIDUAL, '//trim(str)
      deallocate(dresid,stat=ier)
    endif
    hresid%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'CLEAN').or.doall) then
    save_data(code_save_clean) = .false.
    call sic_delvariable ('CLEAN',.false.,error)
    if (allocated(dclean)) then
      str = 'CLEAN, '//trim(str)
      deallocate(dclean,stat=ier)
    endif
    hclean%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'SKY').or.doall) then
    save_data(code_save_sky) = .false.
    call sic_delvariable ('SKY',.false.,error)
    if (allocated(dsky)) then
      str = 'SKY, '//trim(str)
      deallocate(dsky,stat=ier)
    endif
    hsky%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'MASK').or.doall) then
    save_data(code_save_mask) = .false.
    call sic_delvariable ('MASK',.false.,error)
    if (allocated(dmask)) then
      str = 'MASK, '//trim(str)
      deallocate(dmask,stat=ier)
    endif
    hmask%loca%size = 0
    user_method%do_mask = .true.  ! The mask HAS changed...
    if (support_type.gt.0) support_type = support_none
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'PRIMARY').or.doall) then
    save_data(code_save_primary) = .false.
    call sic_delvariable ('PRIMARY',.false.,error)
    if (allocated(dprim)) then
      str = 'PRIMARY, '//trim(str)
      deallocate(dprim,stat=ier)
    endif
    hprim%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'CCT').or.doall) then
    save_data(code_save_cct) = .false.
    call sic_delvariable ('CCT',.false.,error)
    if (allocated(dcct)) then
      str = 'CCT, '//trim(str)
      deallocate(dcct,stat=ier)
    endif
    hcct%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'SINGLEDISH').or.doall) then
    save_data(code_save_single) = .false.
    call sic_delvariable ('SINGLE',.false.,error)
    call sic_delvariable ('SHORT',.false.,error)
    if (allocated(dshort)) then
      str = 'SHORT, '//trim(str)
      deallocate(dshort,stat=ier)
    endif
    hshort%loca%size = 0
    call gildas_null(hshort) ! Play safe
    if (allocated(dsingle)) then
      str = 'SINGLE, '//trim(str)
      deallocate(dsingle,stat=ier)
    endif
    hsingle%loca%size = 0
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'SHORT').or.doall) then
    save_data(code_save_single) = .false.
    call sic_delvariable ('SHORT',.false.,error)
    if (allocated(dshort)) then
      str = 'SHORT, '//trim(str)
      deallocate(dshort,stat=ier)
    endif
    hshort%loca%size = 0
    call gildas_null(hshort) ! Play safe
    if (.not.doall) goto 100
  endif
  !
  if ((key.eq.'SUPPORT').or.doall) then
    call greg_poly_reset(supportpol,supportvar,error)
    if (error)  return
    user_method%do_mask = .true.  ! The mask HAS changed...
    support_type = support_none
    !
    ! Delete the "supportvar" structure
    call sic_delvariable(supportvar,.false.,error)
    if (.not.doall) goto 100
  endif
  !
  if (key.eq.'DATA') then    ! hview
    !! save_data(code_save_none) = .false.
    call sic_delvariable ('DATA',.false.,error)
    if (allocated(dview)) then
      str = 'DATA, '//trim(str)
      deallocate(dview,stat=ier)
    endif
    hview%loca%size = 0
    call gildas_null(hview)
  endif
  !
  if (.not.(doall.or.douv)) then
    call map_message(seve%w,'DISCARD','No code for '//key)
    error = .true.
    return
  endif
  !
100 continue
  if (ier.ne.0) then
    call map_message(seve%e,'DISCARD',trim(key)//' deallocation error')
    error = .true.
  endif
end subroutine sub_discard
!
subroutine buffers_comm(line,error)
  use gkernel_interfaces
  use clean_types
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command BUFFERS
  !
  ! List known buffer status
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line    !! Command line  
  logical :: error                        !! Logical error flag
  !
  ! Local ---
  type(sic_descriptor_t) :: desc   ! Descriptor
  logical :: found
  character(len=32) :: chain
  character(len=12) :: cmem
  character(len=12) :: ctotal
  integer :: i, j, nc
  real :: tmem, rmem
  !
  ! Code ----
  tmem = 0.
  chain = '  Size'
  cmem =  '  Memory'
  write(*,'(A,A,A,A)') 'Name        ',chain,cmem, ' Purpose '
  do i=1,mbuffer
    call sic_descriptor(cbuffer(i),desc,found)  
    if (found) then
      if (desc%ndim.eq.0) then
        chain = '(undefined)'
        cmem = ' '
      else
        chain='['
        nc = 2
        do j=1,desc%ndim
          write(chain(nc:),'(I0,A)') desc%dims(j),','
          nc = len_trim(chain)+1
        enddo
        nc = nc-1
        chain(nc:nc) = ']'
        !
        rmem = product(desc%dims(1:desc%ndim))*4/1024./1024./1024.
        write(cmem,'(F9.2)') rmem
        tmem = tmem+rmem
      endif
    else
      chain = '(undefined)  '
      cmem = ' '
    endif
    write(*,'(A,A,A,A)') cbuffer(i), chain, cmem, sbuffer(i)
  enddo
  !
  ctotal = ' '
  chain  = '   ----- Total memory ---- '
  write(cmem,'(F9.2)') tmem
  write(*,'(A,A,A,A)') ctotal, chain, cmem,'(Gbytes)'
end subroutine buffers_comm
!
subroutine dump_memory(error)
  use clean_default
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  !
  !*
  ! IMAGER -- Support for DUMP MEMORY: Printout memory usage.
  !
  ! There is no generic code to retrieve the memory use.
  !
  ! On Linux, one could scan directly the /proc/self/status   file.
  !
  ! Most efficient would be to call the C Posix standard "getrusage"
  ! but that only returns the Maximum used memory, not the current one.
  ! 
  ! Other methods are system dependent, and require to fork a child, 
  ! which duplicates the memory content and can lead to Crashes !...
  !!
  logical, intent(out) :: error  !! Logical error flag
  !
  ! Local
  character(len=256) :: tmp, str, line
  character(len=16) :: cpid
  real(8) :: umem, pmem, pcpu, vsz
  integer :: ilun, idx, pid, ier
  integer(8) :: valueRSS
  ! 
  ! Code ----
  error = .true.
  ! Initialization to avoid system dependent compilation warnings 
  cpid = ' '
  line = ' '
  str = ' '
  idx = 0 
  pcpu = 0.d0
  vsz = 0.d0
  pid = 0
  !
#if defined(DARWIN)
  !
  ! System fork uses extra memory...
  ier = sic_getlog("GAG_SCRATCH:",tmp)
  ier = gag_system("LANG=US; ps -awxm -o %mem,vsz,rss,comm | sort -nr | grep imager > "// &
    & trim(tmp)//"top.tmp" )
  if (ier.eq.0) then
    ier = sic_getlun(ilun)
    open(unit=ilun,file=trim(tmp)//'top.tmp',status='old',iostat=ier)
    if (ier.eq.0) then
      read(ilun,*) pmem
      umem = (pmem*sys_ramsize/100)/1024
      write(tmp,'(A,F8.1,A,F5.1,A)') 'Current memory used ',umem,' Gbytes (',pmem,' %) of available'
      close(unit=ilun)
      call sic_message(seve%i,'DEBUG',tmp)
    endif
    call sic_frelun(ilun)
  endif
  !
  ! This only returns the max in history, not the current value...
  valueRSS = 0
  valueRSS = systMemUsageC()
  umem = valueRSS/1024.0/1024.0
  pmem = umem*100.0/sys_ramsize
  umem = umem/1024.0
  write(tmp,'(A,F8.1,A,F5.1,A)') 'Maximum memory used ',umem,' Gbytes (',pmem,' %) of available'
  call map_message(seve%i,'DEBUG',tmp)
#elif defined(LINUX)
  ier = sic_getlun(ilun)
  !
  ! Data is available in a virtual file 
  valueRSS = -1   
  open(unit=ilun, file='/proc/self/status', action='read')
  do
    read(ilun, '(a)',iostat=ier ) line
    if (ier /=0) exit
    if (line(1:6) == 'VmRSS:') then
      read(line(7:), *) valueRSS
      exit
    endif
  enddo
  close(ilun)
  call sic_frelun(ilun)
  !! Print *,'ValueRSS ',valueRSS
  umem = valueRSS/1024.0/1024.0
  pmem = umem/sys_ramsize*100.
  write(tmp,'(A,F8.1,A,F5.1,A)') 'Current memory used ',umem,' Gbytes (',pmem,' %) of available'
  call map_message(seve%i,'DEBUG',tmp)
  !
  ! This only returns the max in history, not the current value...
  valueRSS = 0
  valueRSS = systMemUsageC()
  !! Print *,'ValueRSS ',valueRSS
  umem = valueRSS/1024.0/1024.0
  pmem = umem/sys_ramsize*100.
  write(tmp,'(A,F8.1,A,F5.1,A)') 'Maximum memory used ',umem,' Gbytes (',pmem,' %) of available'
  call map_message(seve%i,'DEBUG',tmp)
#else
  ! May work on generic Unix system, but doubles the memory usage
  ! while using "system" fork. So it is prompt to crashes when
  ! reaching memory limits. This is exactly when one wants to 
  ! monitor the use, so a real issue...
  ier = sic_getlog("GAG_SCRATCH:",tmp)
  pid = gag_getpid()
  write(cpid,'(I0)') pid
  ier = gag_system("ps aux | grep imager | grep "//trim(cpid)//" > "// &
    & trim(tmp)//"ps.tmp" )
  if (ier.ne.0) return
  ier = sic_getlun(ilun)
  open(unit=ilun,file=trim(tmp)//'ps.tmp',status='old',iostat=ier)
  if (ier.ne.0) then
    call sic_frelun(ilun)
    return
  endif
  do 
    read(ilun,'(A)',iostat=ier) str
    if (ier.ne.0) exit
    idx = index(str,trim(cpid))
    if ((idx.ne.0).and.(idx.lt.16)) then
      read(str(idx:),*,iostat=ier) pid, pcpu, pmem, vsz
      umem = (pmem*sys_ramsize/100)/1024
      write(tmp,'(A,F8.1,A,F5.1,A)') 'Used memory ',umem,' Gbytes (',pmem,' % of available'
      exit
    endif
  enddo
  close(unit=ilun)
  call sic_frelun(ilun)
  if (idx.ne.0) call map_message(seve%i,'DEBUG',tmp)
#endif
  error = .false.
  !
contains
!
function systMemUsageC() result(valueRSS)
  use iso_c_binding
  interface
    subroutine getSize(val) bind(c, name='getSize')
      import :: c_long
      integer(kind=c_long) :: val
    end
  end interface
  integer(kind=8) :: valueRSS
  !
  call getSize(valueRSS)
end
end subroutine dump_memory
