PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 15:12:19 +02:00
Code Releases Activity

Improve memory control

Browse Source
This commit is contained in:
Anthony Scemama 2023-07-11 22:17:40 +02:00
parent 8c65e01eed
commit 9e833cc476
2 changed files with 29 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/ao_two_e_ints/cholesky.irp.f
View File

@ -48,7 +48,7 @@ END_PROVIDER
integer(omp_lock_kind), allocatable :: lock(:)
double precision :: rss
double precision :: mem
double precision, external :: memory_of_double, memory_of_int
integer, external :: getUnitAndOpen
@ -70,16 +70,22 @@ END_PROVIDER
PROVIDE nucl_coord
if (.not.do_direct_integrals) then
if (do_direct_integrals) then
if (ao_two_e_integral(1,1,1,1) < huge(1.d0)) then
! Trigger providers inside ao_two_e_integral
continue
endif
else
PROVIDE ao_two_e_integrals_in_map
endif
tau = ao_cholesky_threshold
rss = 6.d0 * memory_of_double(ndim) + &
6.d0 * memory_of_int(ndim)
call check_mem(rss, irp_here)
mem = 6.d0 * memory_of_double(ndim) + 6.d0 * memory_of_int(ndim)
call check_mem(mem, irp_here)
call print_memory_usage()
allocate(L(ndim,1))
print *, ''
@ -112,7 +118,7 @@ END_PROVIDER
enddo
if (do_direct_integrals) then
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i)
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
do i=1,ndim
D(i) = ao_two_e_integral(addr(1,i), addr(2,i), &
addr(1,i), addr(2,i))
@ -175,20 +181,20 @@ END_PROVIDER
endif
enddo
call resident_memory(rss)
rss = rss &
call total_memory(mem)
mem = mem &
+ np*memory_of_double(nq) &! Delta(np,nq)
+ (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq)
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size)
! Ltmp_q(nq,block_size)
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
if (rss > qp_max_mem) then
if (mem > qp_max_mem) then
s = s*2.d0
else
exit
endif
if ((s > 1.d0).or.(nq == 0)) then
call print_memory_usage()
print *, 'Not enough memory. Reduce cholesky threshold'
stop -1
endif
@ -201,6 +207,7 @@ END_PROVIDER
L_old => L
allocate(L(ndim,rank+nq), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (L(ndim,rank+nq))'
stop -1
endif
@ -215,18 +222,21 @@ END_PROVIDER
allocate(Delta(np,nq), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Delta(np,nq))'
stop -1
endif
allocate(Ltmp_p(np,block_size), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))'
stop -1
endif
allocate(Ltmp_q(nq,block_size), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))'
stop -1
endif
@ -253,7 +263,7 @@ END_PROVIDER
!$OMP BARRIER
!$OMP DO SCHEDULE(guided)
!$OMP DO SCHEDULE(dynamic)
do m=1,nq
call omp_set_lock(lock(m))
@ -419,6 +429,7 @@ END_PROVIDER
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': Allocation failed'
stop -1
endif

13
src/utils/memory.irp.f
View File

@ -99,16 +99,15 @@ subroutine check_mem(rss_in,routine)
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
double precision :: mem
call total_memory(mem)
mem += rss_in
if (mem > qp_max_mem) then
call print_memory_usage()
print *, 'Not enough memory: aborting in ', routine
print *, int(rss)+1, ' GB required'
print *, mem, ' GB required'
stop -1
endif
!$OMP END CRITICAL
end
subroutine print_memory_usage()