From 05ae2f24050056ab80da345607c4c4813d18a2ad Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 26 Sep 2024 19:26:16 +0200 Subject: [PATCH] Improve mmap in davidson --- .../diagonalization_hs2_dressed.irp.f | 30 ++++++--------- src/davidson/u0_h_u0.irp.f | 2 +- src/utils/mmap.f90 | 37 +++++++++++++++++++ 3 files changed, 49 insertions(+), 20 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 39520836..d299f982 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -223,12 +223,11 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ exit endif - if (itermax > 4) then - itermax = itermax - 1 - else if (m==1.and.disk_based_davidson) then + if (disk_based_davidson) then m=0 disk_based = .True. - itermax = 6 + else if (itermax > 4) then + itermax = itermax - 1 else nproc_target = nproc_target - 1 endif @@ -267,14 +266,12 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ if (disk_based) then ! Create memory-mapped files for W and S - type(c_ptr) :: ptr_w, ptr_s - integer :: fd_s, fd_w - call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),& - 8, fd_w, .False., .True., ptr_w) - call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),& - 4, fd_s, .False., .True., ptr_s) - call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) - call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) + type(mmap_type) :: map_s, map_w + + call mmap_create_d('', (/ 1_8*sze, 1_8*N_st_diag*itermax /), .False., .True., map_w) + call mmap_create_s('', (/ 1_8*sze, 1_8*N_st_diag*itermax /), .False., .True., map_s) + w => map_w%d2 + s => map_s%s2 else allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) endif @@ -755,13 +752,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ if (disk_based)then ! Remove temp files - integer, external :: getUnitAndOpen - call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 8, fd_w, ptr_w ) - fd_w = getUnitAndOpen(trim(ezfio_work_dir)//'davidson_w','r') - close(fd_w,status='delete') - call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 4, fd_s, ptr_s ) - fd_s = getUnitAndOpen(trim(ezfio_work_dir)//'davidson_s','r') - close(fd_s,status='delete') + call mmap_destroy(map_w) + call mmap_destroy(map_s) else deallocate(W,S) endif diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index cb80b1c0..808bbb5d 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -212,7 +212,7 @@ subroutine H_u_0_nstates_openmp_work_$N_int(v_t,u_t,N_st,sze,istart,iend,ishift, !$OMP istart, iend, istep, irp_here, v_t, & !$OMP ishift, idx0, u_t, maxab, compute_singles, & !$OMP singles_alpha_csc,singles_alpha_csc_idx, & - !$OMP singles_beta_csc_,singles_beta_csc_idx) & + !$OMP singles_beta_csc,singles_beta_csc_idx) & !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & !$OMP lcol, lrow, l_a, l_b, utl, kk, u_is_sparse, & !$OMP buffer, doubles, n_doubles, umax, & diff --git a/src/utils/mmap.f90 b/src/utils/mmap.f90 index 4db655a2..4ac32233 100644 --- a/src/utils/mmap.f90 +++ b/src/utils/mmap.f90 @@ -23,6 +23,11 @@ module mmap_module double precision, pointer :: d2(:,:) double precision, pointer :: d3(:,:,:) double precision, pointer :: d4(:,:,:,:) + + real, pointer :: s1(:) + real, pointer :: s2(:,:) + real, pointer :: s3(:,:,:) + real, pointer :: s4(:,:,:,:) end type mmap_type interface @@ -176,6 +181,10 @@ module mmap_module map%d2 => NULL() map%d3 => NULL() map%d4 => NULL() + map%s1 => NULL() + map%s2 => NULL() + map%s3 => NULL() + map%s4 => NULL() map%i1 => NULL() map%i2 => NULL() map%i3 => NULL() @@ -211,6 +220,30 @@ module mmap_module end select end subroutine + subroutine mmap_create_s(filename, shape, read_only, single_node, map) + implicit none + character*(*), intent(in) :: filename ! Name of the mapped file + integer*8, intent(in) :: shape(:) ! Shape of the array to map + logical, intent(in) :: read_only ! If true, mmap is read-only + logical, intent(in) :: single_node! If true, mmap is on a single node + type(mmap_type), intent(out) :: map ! mmap + + call mmap_create(filename, shape, 4, read_only, single_node, map) + + select case (size(shape)) + case (1) + call c_f_pointer(map%ptr, map%s1, shape) + case (2) + call c_f_pointer(map%ptr, map%s2, shape) + case (3) + call c_f_pointer(map%ptr, map%s3, shape) + case (4) + call c_f_pointer(map%ptr, map%s4, shape) + case default + stop 'mmap: dimension not implemented' + end select + end subroutine + subroutine mmap_create_i(filename, shape, read_only, single_node, map) implicit none character*(*), intent(in) :: filename ! Name of the mapped file @@ -269,6 +302,10 @@ module mmap_module map%filename = '' map%length = 0 map%fd = 0 + map%s1 => NULL() + map%s2 => NULL() + map%s3 => NULL() + map%s4 => NULL() map%d1 => NULL() map%d2 => NULL() map%d3 => NULL()