Trying to improve mmap performance

src/ao_two_e_ints/cholesky.irp.f

@@ -88,7 +88,7 @@ END_PROVIDER
      call resident_memory(mem0)
 
      rank_max = min(ndim8,274877906944_8/1_8/ndim8)
-     call mmap(trim(ezfio_work_dir)//'cholesky_ao_tmp', (/ ndim8, rank_max /), 8, fd(1), .False., c_pointer(1))
+     call mmap(trim(ezfio_work_dir)//'cholesky_ao_tmp', (/ ndim8, rank_max /), 8, fd(1), .False., .True., c_pointer(1))
      call c_f_pointer(c_pointer(1), L, (/ ndim8, rank_max /))
      ! Deleting the file while it is open makes the file invisible on the filesystem,
      ! and automatically deleted, even if the program crashes
@@ -237,7 +237,7 @@ END_PROVIDER
              + (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
 
        if (mem > qp_max_mem) then
-         call mmap(trim(ezfio_work_dir)//'cholesky_delta', (/ np*1_8, nq*1_8 /), 8, fd(2), .False., c_pointer(2))
+         call mmap(trim(ezfio_work_dir)//'cholesky_delta', (/ np*1_8, nq*1_8 /), 8, fd(2), .False., .True., c_pointer(2))
          call c_f_pointer(c_pointer(2), Delta, (/ np, nq /))
          ! Deleting the file while it is open makes the file invisible on the filesystem,
          ! and automatically deleted, even if the program crashes

src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f

@@ -1,6 +1,5 @@
 
 subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc)
-  use mmap_module
   implicit none
   BEGIN_DOC
   ! Generic Davidson diagonalization with ONE DIAGONAL DRESSING OPERATOR 

src/dav_general_mat/dav_diag_dressed_ext_rout_nonsym_B1space.irp.f

@@ -3,8 +3,6 @@
 
 subroutine davidson_general_diag_dressed_ext_rout_nonsym_b1space(u_in, H_jj, Dress_jj,energies, sze, N_st, N_st_diag_in, converged, hcalc)
 
-  use mmap_module
-
   BEGIN_DOC
   ! Generic modified-Davidson diagonalization 
   !

src/dav_general_mat/dav_double_dress_ext_rout.irp.f

@@ -1,5 +1,4 @@
 subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies,sze,N_st,N_st_diag,converged,hcalc)
-  use mmap_module
   BEGIN_DOC
   ! Generic Davidson diagonalization with TWO DRESSING VECTORS 
   !

src/dav_general_mat/dav_dressed_ext_rout.irp.f

@@ -1,5 +1,4 @@
 subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_diag,dressing_state,dressing_vec,idress,converged,hcalc)
-  use mmap_module
   implicit none
   BEGIN_DOC
   ! Davidson diagonalization.

src/dav_general_mat/dav_ext_rout.irp.f

@@ -1,6 +1,5 @@
 
 subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc)
-  use mmap_module
   implicit none
   BEGIN_DOC
   ! Generic Davidson diagonalization 

src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f

@@ -3,8 +3,6 @@
 
 subroutine davidson_general_ext_rout_nonsym_b1space(u_in, H_jj, energies, sze, N_st, N_st_diag_in, converged, hcalc)
 
-  use mmap_module
-
   BEGIN_DOC
   ! Generic modified-Davidson diagonalization 
   !

src/dav_general_mat/dav_general.irp.f

@@ -1,6 +1,6 @@
 
 subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,converged,h_mat)
-  use mmap_module
+!  use mmap_module
   implicit none
   BEGIN_DOC
   ! Davidson diagonalization with specific diagonal elements of the H matrix
@@ -160,9 +160,9 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
 !    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., ptr_w)
+!        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., ptr_s)
+!        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/))
 !  else

src/davidson/diagonalization_h_dressed.irp.f

@@ -228,7 +228,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia
     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., ptr_w)
+        8, fd_w, .False., .True., ptr_w)
     call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
   else
     allocate(W(sze,N_st_diag*itermax))

src/davidson/diagonalization_hcsf_dressed.irp.f

@@ -229,7 +229,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
     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., ptr_w)
+        8, fd_w, .False., .True., ptr_w)
     call c_f_pointer(ptr_w, W_csf, (/sze_csf,N_st_diag*itermax/))
   else
     allocate(W(sze,N_st_diag),W_csf(sze_csf,N_st_diag*itermax))

src/davidson/diagonalization_hs2_dressed.irp.f

@@ -270,9 +270,9 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
     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., ptr_w)
+        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., ptr_s)
+        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/))
   else

src/davidson/diagonalization_nonsym_h_dressed.irp.f

@@ -251,7 +251,7 @@ subroutine davidson_diag_nonsym_hjj(dets_in, u_in, H_jj, energies, dim_in, sze,
     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., ptr_w)
+        8, fd_w, .False., .True., ptr_w)
     call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
   else
     allocate(W(sze,N_st_diag*itermax))

src/utils/fortran_mmap.c

@@ -7,7 +7,7 @@
 #include <sys/mman.h>
 
 
-void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only)
+void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only, int single_node)
 {
     int fd;
     int result;
@@ -21,7 +21,7 @@ void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only)
             perror("Error opening mmap file for reading");
             exit(EXIT_FAILURE);
         }
-        map = mmap(NULL, bytes, PROT_READ, MAP_SHARED, fd, 0);
+        map = mmap(NULL, bytes, PROT_READ, MAP_PRIVATE, fd, 0);
     }
     else
     {
@@ -48,7 +48,12 @@ void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only)
             exit(EXIT_FAILURE);
         }
 
-        map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0);
+        if (single_node == 1) {
+          map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, 
+             MAP_PRIVATE | MAP_HUGETLB , fd, 0);
+        } else {
+          map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_HUGETLB, fd, 0);
+        }
     }
 
     if (map == MAP_FAILED) {

src/utils/map_functions.irp.f

@@ -21,13 +21,13 @@ subroutine map_save_to_disk(filename,map)
     stop 'map already consolidated'
   endif
 
-  call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .False., c_pointer(1))
+  call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .False., .False., c_pointer(1))
   call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size +2_8/))
 
-  call mmap(trim(filename)//'_consolidated_key', (/ n_elements /), cache_key_kind, fd(2), .False., c_pointer(2))
+  call mmap(trim(filename)//'_consolidated_key', (/ n_elements /), cache_key_kind, fd(2), .False., .False., c_pointer(2))
   call c_f_pointer(c_pointer(2),map % consolidated_key, (/ n_elements /))
 
-  call mmap(trim(filename)//'_consolidated_value', (/ n_elements /), integral_kind, fd(3), .False., c_pointer(3))
+  call mmap(trim(filename)//'_consolidated_value', (/ n_elements /), integral_kind, fd(3), .False., .False., c_pointer(3))
   call c_f_pointer(c_pointer(3),map % consolidated_value, (/ n_elements /))
 
   if (.not.associated(map%consolidated_key)) then
@@ -85,15 +85,15 @@ subroutine map_load_from_disk(filename,map)
     stop 'map already consolidated'
   endif
 
-  call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .True., c_pointer(1))
+  call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .True., .False., c_pointer(1))
   call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size + 2_8/))
 
   map% n_elements = map % consolidated_idx (map % map_size+2_8)-1_8
 
-  call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .True., c_pointer(2))
+  call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .True., .False., c_pointer(2))
   call c_f_pointer(c_pointer(2),map % consolidated_key, (/ map % n_elements /))
 
-  call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., c_pointer(3))
+  call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., .False., c_pointer(3))
   call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /))
 
   l = 0_8

src/utils/memory.irp.f

@@ -6,7 +6,7 @@ BEGIN_PROVIDER [ integer, qp_max_mem ]
  character*(128) :: env
  integer, external :: get_total_available_memory
 
- qp_max_mem = get_total_available_memory()
+ qp_max_mem = max(get_total_available_memory() - 1,3)
  call write_int(6,qp_max_mem,'Total available memory (GB)')
  call getenv('QP_MAXMEM',env)
  if (trim(env) /= '') then

src/utils/mmap.f90

@@ -7,12 +7,13 @@ module mmap_module
     ! File descriptors
     ! ----------------
 
-    type(c_ptr) function c_mmap_fortran(filename, length, fd, read_only) bind(c,name='mmap_fortran')
+    type(c_ptr) function c_mmap_fortran(filename, length, fd, read_only, single_node) bind(c,name='mmap_fortran')
       use iso_c_binding
       character(c_char), intent(in)  :: filename(*)
       integer(c_size_t), intent(in), value :: length
       integer(c_int), intent(out)    :: fd
       integer(c_int), intent(in), value    :: read_only
+      integer(c_int), intent(in), value    :: single_node
     end function
 
     subroutine c_munmap_fortran(length, fd, map) bind(c,name='munmap_fortran')
@@ -33,31 +34,33 @@ module mmap_module
 
   contains
 
-  subroutine mmap(filename, shape, bytes, fd, read_only, map)
+  subroutine mmap(filename, shape, bytes, fd, read_only, single_node, map)
       use iso_c_binding
       implicit none
       character*(*), intent(in)      :: filename   ! Name of the mapped file
       integer*8, intent(in)          :: shape(:)   ! Shape of the array to map
       integer, intent(in)            :: bytes      ! Number of bytes per element
       logical, intent(in)            :: read_only  ! If true, mmap is read-only
+      logical, intent(in)            :: single_node! If true, mmap is on a single node
       integer, intent(out)           :: fd         ! File descriptor
       type(c_ptr), intent(out)       :: map        ! C Pointer
 
       integer(c_size_t)              :: length
       integer(c_int)                 :: fd_
 
-      integer :: i
+      integer :: i, read_only_, single_node_
+
+      read_only_ = 0
+      single_node_ = 0
+      if (read_only_) read_only_ = 1
+      if (single_node_) single_node_ = 1
 
       length = int(bytes,8)
       do i=1,size(shape)
         length = length * shape(i)
       enddo
 
-      if (read_only) then
+      map = c_mmap_fortran( trim(filename)//char(0), length, fd_, read_only, single_node)
-          map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 1)
-      else
-          map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 0)
-      endif
       fd = fd_
   end subroutine