LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01: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(:) integer(omp_lock_kind), allocatable :: lock(:)
double precision :: rss double precision :: mem
double precision, external :: memory_of_double, memory_of_int double precision, external :: memory_of_double, memory_of_int
integer, external :: getUnitAndOpen integer, external :: getUnitAndOpen
@ -70,15 +70,21 @@ END_PROVIDER
PROVIDE nucl_coord 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 PROVIDE ao_two_e_integrals_in_map
endif endif
tau = ao_cholesky_threshold tau = ao_cholesky_threshold
rss = 6.d0 * memory_of_double(ndim) + & mem = 6.d0 * memory_of_double(ndim) + 6.d0 * memory_of_int(ndim)
6.d0 * memory_of_int(ndim) call check_mem(mem, irp_here)
call check_mem(rss, irp_here)
call print_memory_usage()
allocate(L(ndim,1)) allocate(L(ndim,1))
@ -112,7 +118,7 @@ END_PROVIDER
enddo enddo
if (do_direct_integrals) then 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 do i=1,ndim
D(i) = ao_two_e_integral(addr(1,i), addr(2,i), & D(i) = ao_two_e_integral(addr(1,i), addr(2,i), &
addr(1,i), addr(2,i)) addr(1,i), addr(2,i))
@ -175,20 +181,20 @@ END_PROVIDER
endif endif
enddo enddo
call resident_memory(rss) call total_memory(mem)
rss = rss & mem = mem &
+ np*memory_of_double(nq) &! Delta(np,nq) + np*memory_of_double(nq) &! Delta(np,nq)
+ (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq) + (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq)
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
! Ltmp_q(nq,block_size)
if (rss > qp_max_mem) then if (mem > qp_max_mem) then
s = s*2.d0 s = s*2.d0
else else
exit exit
endif endif
if ((s > 1.d0).or.(nq == 0)) then if ((s > 1.d0).or.(nq == 0)) then
call print_memory_usage()
print *, 'Not enough memory. Reduce cholesky threshold' print *, 'Not enough memory. Reduce cholesky threshold'
stop -1 stop -1
endif endif
@ -201,6 +207,7 @@ END_PROVIDER
L_old => L L_old => L
allocate(L(ndim,rank+nq), stat=ierr) allocate(L(ndim,rank+nq), stat=ierr)
if (ierr /= 0) then if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (L(ndim,rank+nq))' print *, irp_here, ': allocation failed : (L(ndim,rank+nq))'
stop -1 stop -1
endif endif
@ -215,18 +222,21 @@ END_PROVIDER
allocate(Delta(np,nq), stat=ierr) allocate(Delta(np,nq), stat=ierr)
if (ierr /= 0) then if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Delta(np,nq))' print *, irp_here, ': allocation failed : (Delta(np,nq))'
stop -1 stop -1
endif endif
allocate(Ltmp_p(np,block_size), stat=ierr) allocate(Ltmp_p(np,block_size), stat=ierr)
if (ierr /= 0) then if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))' print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))'
stop -1 stop -1
endif endif
allocate(Ltmp_q(nq,block_size), stat=ierr) allocate(Ltmp_q(nq,block_size), stat=ierr)
if (ierr /= 0) then if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))' print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))'
stop -1 stop -1
endif endif
@ -253,7 +263,7 @@ END_PROVIDER
!$OMP BARRIER !$OMP BARRIER
!$OMP DO SCHEDULE(guided) !$OMP DO SCHEDULE(dynamic)
do m=1,nq do m=1,nq
call omp_set_lock(lock(m)) call omp_set_lock(lock(m))
@ -419,6 +429,7 @@ END_PROVIDER
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr) allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
if (ierr /= 0) then if (ierr /= 0) then
call print_memory_usage()
print *, irp_here, ': Allocation failed' print *, irp_here, ': Allocation failed'
stop -1 stop -1
endif endif

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

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