Skip to content
Snippets Groups Projects
heap.f90 5.96 KiB
!===============================================================================
!===============================================================================
!
!     (parallel) heap memory recording tool
!
!     C. Thieulot    May 2008
!
!===============================================================================
!===============================================================================

subroutine heap (threadinfo,arrayname,routinename,arraysize,datatype,alloc)
use definitions
use threads
implicit none
character*(*) arrayname,routinename,datatype
type (thread) threadinfo
integer arraysize,alloc
integer iunit,ndata
character signe

if (alloc>0 .and. threadinfo%err.ne.0) call stop_run ('Error alloc '//arrayname//' in '//routinename//'$')

iunit=threadinfo%mem_heap_unit

select case (trim(datatype))
case('bool')
    ndata=0
    !ndata=4*arraysize
    threadinfo%mem_int=threadinfo%mem_int + alloc * ndata
    threadinfo%mem_tot=threadinfo%mem_tot + alloc * ndata
case('int','real')
    ndata=4*arraysize
    threadinfo%mem_int=threadinfo%mem_int + alloc * ndata
    threadinfo%mem_tot=threadinfo%mem_tot + alloc * ndata
case('dp')
    ndata=8*arraysize
    threadinfo%mem_dp =threadinfo%mem_dp  + alloc * ndata
    threadinfo%mem_tot=threadinfo%mem_tot + alloc * ndata
case default
    write(iunit,*) 'wrong datatype! array name is'//arrayname//' in routinename '//routinename
end select

if (alloc>0) then
   signe='+'
else
   signe='-'
end if

write(iunit,'(a5,a16,a3,a16,a4,i10,a3,3i11)') '  ',routinename,' | ',arrayname,' | '//signe,ndata/1024,' | ', &
      threadinfo%mem_int/1024, &
      threadinfo%mem_dp/1024 , &
      threadinfo%mem_tot/1024

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_init (threadinfo,iunit,filename)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iunit
character*(*) filename

threadinfo%mem_heap_unit=iunit

open(unit=iunit,file=filename,status='replace')
threadinfo%mem_int=0
threadinfo%mem_dp=0
threadinfo%mem_tot=0


write(iunit,'(a90)') '|---------------------------------------------------------------------------------------------'
write(iunit,'(a90)') '|       routine name   |    array name    |  +/- kbytes |  int memory  dp memory     total ' 
write(iunit,'(a90)') '|---------------------------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_final (threadinfo)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iunit

iunit=threadinfo%mem_heap_unit

write(iunit,'(a90)') '|---------------------------------------------------------------------------------------------'

close(iunit)

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_hop1 (threadinfo,istep)
use definitions
use threads
implicit none
type (thread) threadinfo
integer istep
integer iunit
character(len=5) cistep

iunit=threadinfo%mem_heap_unit

call int_to_char(cistep,5,istep)

write(iunit,'(a90)') '1---istep='//cistep//'-------------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_hop2 (threadinfo,iter)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iter
integer iunit
character(len=5) citer

iunit=threadinfo%mem_heap_unit

call int_to_char(citer,5,iter)

write(iunit,'(a90)') '2-------iter='//citer//'---------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_hop3 (threadinfo,iter_nl)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iter_nl
integer iunit
character(len=5) citer

iunit=threadinfo%mem_heap_unit

call int_to_char(citer,5,iter_nl)

write(iunit,'(a90)') '3-----------iter_nl='//citer//'-------------------------------------------------------------------------'

end subroutine


!===============================================================================
!===============================================================================

subroutine heap_hop3_f (threadinfo)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iunit

iunit=threadinfo%mem_heap_unit

write(iunit,'(a90)') '3-----------end ofloop----------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_hop2_f (threadinfo)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iunit

iunit=threadinfo%mem_heap_unit

write(iunit,'(a90)') '2-------end ofloop----------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================

subroutine heap_hop1_f (threadinfo)
use definitions
use threads
implicit none
type (thread) threadinfo
integer iunit

iunit=threadinfo%mem_heap_unit

write(iunit,'(a90)') '1-------end ofloop----------------------------------------------------------------------------'

end subroutine

!===============================================================================
!===============================================================================