9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-06 13:33:37 +01:00
qp2/src/utils/memory.irp.f
2019-01-25 11:39:31 +01:00

117 lines
2.7 KiB
Fortran

BEGIN_PROVIDER [ integer, qp_max_mem ]
implicit none
BEGIN_DOC
! Maximum memory in Gb
END_DOC
character*(128) :: env
qp_max_mem = 2000
call getenv('QP_MAXMEM',env)
if (trim(env) /= '') then
read(env,*) qp_max_mem
endif
call write_int(6,qp_max_mem,'Target maximum memory (GB)')
END_PROVIDER
subroutine resident_memory(value)
implicit none
BEGIN_DOC
! Returns the current used memory in gigabytes used by the current process.
END_DOC
integer :: iunit
integer, external :: getUnitAndOpen
character*(32) :: key
double precision, intent(out) :: value
call omp_set_lock(file_lock)
value = 0.d0
iunit = getUnitAndOpen('/proc/self/status','r')
do
read(iunit,*,err=10,end=20) key, value
if (trim(key) == 'VmRSS:') then
exit
endif
10 continue
end do
20 continue
close(iunit)
value = value / (1024.d0*1024.d0)
call omp_unset_lock(file_lock)
end function
subroutine total_memory(value)
implicit none
BEGIN_DOC
! Returns the current used memory in gigabytes used by the current process.
END_DOC
integer :: iunit
integer, external :: getUnitAndOpen
character*(32) :: key
double precision, intent(out) :: value
iunit = getUnitAndOpen('/proc/self/status','r')
do
read(iunit,*,err=10,end=20) key, value
if (trim(key) == 'VmSize:') then
exit
endif
10 continue
end do
20 continue
close(iunit)
value = value / (1024.d0*1024.d0)
end function
double precision function memory_of_double(n)
implicit none
BEGIN_DOC
! Computes the memory required for n double precision elements in gigabytes.
END_DOC
integer, intent(in) :: n
double precision, parameter :: f = 8.d0 / (1024.d0*1024.d0*1024.d0)
memory_of_double = dble(n) * f
end function
double precision function memory_of_int(n)
implicit none
BEGIN_DOC
! Computes the memory required for n double precision elements in gigabytes.
END_DOC
integer, intent(in) :: n
double precision, parameter :: f = 4.d0 / (1024.d0*1024.d0*1024.d0)
memory_of_int = dble(n) * f
end function
subroutine check_mem(rss_in,routine)
implicit none
BEGIN_DOC
! Checks if n gigabytes can be allocated. If not, exit the run.
END_DOC
double precision, intent(in) :: rss_in
character*(*) :: routine
double precision :: rss
!$OMP CRITICAL
call resident_memory(rss)
rss += rss_in
if (int(rss)+1 > qp_max_mem) then
print *, 'Not enough memory: aborting in ', routine
stop -1
endif
!$OMP END CRITICAL
end
subroutine print_memory_usage()
implicit none
BEGIN_DOC
! Prints the memory usage in the output
END_DOC
double precision :: rss, mem
call resident_memory(rss)
call total_memory(mem)
write(*,'(A,F14.6,A,F14.6,A)') &
'.. >>>>> [ RES MEM : ', rss , &
' GB ] [ VIRT MEM : ', mem, ' GB ] <<<<< ..'
end