mmap

ezfio_config/qmc.config

@@ -100,4 +100,3 @@ pseudo
   pseudo_v_k       double precision   (nuclei_nucl_num,pseudo_pseudo_klocmax)
   pseudo_v_kl      double precision   (nuclei_nucl_num,pseudo_pseudo_kmax,pseudo_pseudo_lmax+1)
 
-

scripts/compile_irpf90.sh

@@ -27,10 +27,10 @@ then
   source ${QMCCHEM_PATH}/make.config
 
   LIB="${LIB} ${QMCCHEM_PATH}/lib/libezfio_irp.a ${QMCCHEM_PATH}/lib/libf77zmq.a ${QMCCHEM_PATH}/lib/libzmq.a -lstdc++ -lrt"
-  SRC="${SRC} ZMQ/f77_zmq_module.f90" 
-  OBJ="${OBJ} IRPF90_temp/ZMQ/f77_zmq_module.o"
+  SRC="${SRC} ZMQ/f77_zmq_module.f90 TOOLS/fortran_mmap.c TOOLS/mmap.f90" 
+  OBJ="${OBJ} IRPF90_temp/ZMQ/f77_zmq_module.o IRPF90_temp/TOOLS/mmap.o IRPF90_temp/TOOLS/fortran_mmap.o"
   INCLUDES="${INCLUDES} -I AO -I SAMPLING -I TOOLS -I JASTROW -I MAIN -I PROPERTIES -I ZMQ"
-  IRPF90_FLAGS="${IRPF90_FLAGS} --ninja"
+  IRPF90_FLAGS="${IRPF90_FLAGS} --ninja -m"
 
   # Check IRPF90 version
   if [[ $( ${IRPF90} -v | python -c "import sys ; print float(sys.stdin.read().rsplit('.',1)[0]) >= 1.6") == False ]]
@@ -41,6 +41,7 @@ then
 
   export IRPF90 IRPF90_FLAGS INCLUDES LIB SRC OBJ 
 
+  ${CC} -O2 -c TOOLS/fortran_mmap.c
   exec ${IRPF90} ${IRPF90_FLAGS} ${INCLUDES} || exit -1
 fi
 

src/TOOLS/fortran_mmap.c

@@ -0,0 +1,58 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/mman.h>
+
+void* mmap_fortran(char* filename, size_t bytes, int* file_descr)
+{
+    int i;
+    int fd;
+    int result;
+    void* map;
+
+    printf(":%s:\n",filename);
+
+    fd = open(filename, O_RDWR | O_CREAT, (mode_t)0600);
+/*
+    fd = open(filename, O_RDONLY, (mode_t)0600);
+*/
+    if (fd == -1) {
+        perror("Error opening mmap file for writing");
+        exit(EXIT_FAILURE);
+    }
+
+    result = lseek(fd, bytes, SEEK_SET);
+    if (result == -1) {
+        close(fd);
+        perror("Error calling lseek() to stretch the file");
+        exit(EXIT_FAILURE);
+    }
+    
+    result = write(fd, "", 1);
+    if (result != 1) {
+        close(fd);
+        perror("Error writing last byte of the file");
+        exit(EXIT_FAILURE);
+    }
+
+    map = mmap(0, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0);
+    if (map == MAP_FAILED) {
+        close(fd);
+        perror("Error mmapping the file");
+        exit(EXIT_FAILURE);
+    }
+
+    *file_descr = fd;
+    return map;
+}
+
+void munmap_fortran(size_t bytes, int fd, void* map)
+{
+    if (munmap(map, bytes) == -1) {
+        perror("Error un-mmapping the file");
+    }
+    close(fd);
+}

src/TOOLS/mmap.f90

@@ -0,0 +1,63 @@
+module mmap_module
+
+  use iso_c_binding
+
+  interface
+
+    ! File descriptors
+    ! ----------------
+
+    type(c_ptr) function c_mmap_fortran(filename, length, fd) 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
+    end function
+
+    subroutine c_munmap(length, fd, map) bind(c,name='munmap_fortran')
+      use iso_c_binding
+      integer(c_size_t), intent(in), value :: length
+      integer(c_int), intent(in), value :: fd
+      type(c_ptr), intent(in), value    :: map
+    end subroutine
+
+  end interface
+
+  contains
+
+  subroutine mmap(filename, shape, bytes, fd, map)
+      use iso_c_binding
+      implicit none
+      character*(*), intent(in)      :: filename   ! Name of the mapped file
+      integer, intent(in)            :: shape(:)   ! Shape of the array to map
+      integer, intent(in)            :: bytes      ! Number of bytes per element
+      integer, intent(out)           :: fd         ! File descriptor
+      type(c_ptr), intent(out)       :: map        ! C Pointer
+     
+      integer(c_long)                :: length
+      integer(c_int)                 :: fd_
+
+      length = PRODUCT( INT(shape(:),8) ) * bytes
+      map = c_mmap_fortran( trim(filename)//char(0), length, fd_)
+      fd = fd_
+  end subroutine
+
+  subroutine munmap(shape, bytes, fd, map)
+      use iso_c_binding
+      implicit none
+      integer, intent(in)            :: shape(:)  ! Shape of the array to map
+      integer, intent(in)            :: bytes     ! Number of bytes per element
+      integer, intent(in)            :: fd        ! File descriptor
+      type(c_ptr), intent(in)        :: map       ! C pointer
+
+      integer(c_long)                :: length
+      integer(c_int)                 :: fd_
+
+      length = PRODUCT( INT(shape(:),8) ) * bytes
+      fd_ = fd
+      call c_munmap( length, fd_, map)
+  end 
+
+end module mmap_module
+
+

src/ezfio_interface.irp.f

@@ -47,7 +47,6 @@ data = [ \
 ("simulation_e_ref"                , "double precision" , ""                   ),
 ("simulation_do_run"               , "logical       " , ""                   ),
 ("pseudo_do_pseudo"         , "logical       " , ""                   ),
-
 ]
 
 data_no_set = [\

src/mo.irp.f

@@ -51,46 +51,79 @@ END_PROVIDER
 
 
 BEGIN_PROVIDER [ real, mo_coef, (ao_num_8,mo_num_8) ]
+  use mmap_module
   implicit none
   BEGIN_DOC
 ! Molecular orbital coefficients
   END_DOC
   integer                        :: i, j
+  integer                        :: fd
+  type(c_ptr)                    :: c_pointer
+  logical                        :: exists
+
+  deallocate(mo_coef)
+  INQUIRE(FILE='/dev/shm/mo_coef', EXIST=exists)
+
+  call mmap('/dev/shm/mo_coef', &
+      (/ao_num_8,mo_num_8/), 8, fd, c_pointer)
+
+  call c_f_pointer(c_pointer,mo_coef,(/ao_num_8,mo_num_8/))
   
-  do j=1,mo_num
-    do i=1,ao_num_8
-      mo_coef(i,j) = mo_coef_input(i,j)
+  if (.not.exists) then
+    print *,  'Creating '//trim(ezfio_filename)//'/mmap/mo_coef'
+
+    do j=1,mo_num
+      do i=1,ao_num_8
+        mo_coef(i,j) = mo_coef_input(i,j)
+      enddo
     enddo
-  enddo
-  do j =mo_num+1,mo_num_8
-    !DIR$ VECTOR ALIGNED
-    do i=1,ao_num_8
-      mo_coef(i,j) = 0.
+    do j =mo_num+1,mo_num_8
+      !DIR$ VECTOR ALIGNED
+      do i=1,ao_num_8
+        mo_coef(i,j) = 0.
+      enddo
     enddo
-  enddo
   
-  ! Input MOs are not needed any more
-  FREE mo_coef_input
-  
-  real                           :: f
-  f = 1./mo_scale
-  do j=1,mo_num
-    !DIR$ VECTOR ALIGNED
-    !DIR$ LOOP COUNT (2000)
-    do i=1,ao_num_8
-      mo_coef(i,j) *= f
+    ! Input MOs are not needed any more
+    FREE mo_coef_input
+    
+    real                           :: f
+    f = 1./mo_scale
+    do j=1,mo_num
+      !DIR$ VECTOR ALIGNED
+      !DIR$ LOOP COUNT (2000)
+      do i=1,ao_num_8
+        mo_coef(i,j) *= f
+      enddo
     enddo
-  enddo
-  
+
+  endif
+
 END_PROVIDER
 
 
 BEGIN_PROVIDER [ real, mo_coef_transp, (mo_num_8,ao_num_8) ]
+  use mmap_module
   implicit none
   BEGIN_DOC
 ! Transpose of the Molecular orbital coefficients
   END_DOC
-  call transpose(mo_coef,ao_num_8,mo_coef_transp,mo_num_8,ao_num_8,mo_num_8)
+  integer                        :: fd
+  type(c_ptr)                    :: c_pointer
+  logical                        :: exists
+
+  deallocate(mo_coef_transp)
+  INQUIRE(FILE='/dev/shm/mo_coef_transp', EXIST=exists)
+
+  call mmap('/dev/shm/mo_coef_transp', &
+      (/mo_num_8,ao_num_8/), 8, fd, c_pointer)
+
+  call c_f_pointer(c_pointer,mo_coef_transp,(/mo_num_8,ao_num_8/))
+  
+  if (.not.exists) then
+    print *,  'Creating '//trim(ezfio_filename)//'/mmap/mo_coef_transp'
+    call transpose(mo_coef,ao_num_8,mo_coef_transp,mo_num_8,ao_num_8,mo_num_8)
+  endif
   
 END_PROVIDER
 
@@ -123,17 +156,33 @@ END_PROVIDER
 
 
 BEGIN_PROVIDER [ real, mo_coef_transp_present, (num_present_mos_8,ao_num_8) ]
+  use mmap_module
   implicit none
   BEGIN_DOC
 ! mo_coef_transp without MOs absent in all determinants
   END_DOC
   integer                        :: i,j,n
-  mo_coef_transp_present = 0.
-  do i=1,ao_num
-    do j=1,num_present_mos
-      mo_coef_transp_present(j,i) = mo_coef_transp(present_mos(j),i)
+  integer                        :: fd
+  type(c_ptr)                    :: c_pointer
+  logical                        :: exists
+
+  deallocate(mo_coef_transp_present)
+  INQUIRE(FILE='/dev/shm/mo_coef_transp_present', EXIST=exists)
+
+  call mmap('/dev/shm/mo_coef_transp_present', &
+      (/num_present_mos_8,ao_num_8/), 8, fd, c_pointer)
+
+  call c_f_pointer(c_pointer,mo_coef_transp_present,(/num_present_mos_8,ao_num_8/))
+  
+  if (.not.exists) then
+    print *,  'Creating '//trim(ezfio_filename)//'/mmap/mo_coef_transp_present'
+    mo_coef_transp_present = 0.
+    do i=1,ao_num
+      do j=1,num_present_mos
+        mo_coef_transp_present(j,i) = mo_coef_transp(present_mos(j),i)
+      enddo
     enddo
-  enddo
+  endif
   
 END_PROVIDER
 

src/simulation.irp.f

@@ -304,7 +304,7 @@ BEGIN_PROVIDER [ integer, vmc_algo ]
 END_PROVIDER
  
  
-BEGIN_PROVIDER  [ character*(512), ezfio_filename ]
+BEGIN_PROVIDER [ character*(512), ezfio_filename ]
    implicit none
    BEGIN_DOC
    ! Name of the ezfio file.

src/wf.irp.f

@@ -67,17 +67,41 @@ END_PROVIDER
  BEGIN_PROVIDER [ double precision, det_coef_matrix_values,  (det_num_input) ]
 &BEGIN_PROVIDER [ integer,          det_coef_matrix_rows,    (det_num_input) ]
 &BEGIN_PROVIDER [ integer,          det_coef_matrix_columns, (det_num_input) ]
+  use mmap_module
   implicit none
   BEGIN_DOC
   ! det_coef_matrix in sparse storage (Coordinate format for sparse BLAS)
   END_DOC
   double precision, allocatable  :: buffer(:,:)
+ integer                        :: fd
+ type(c_ptr)                    :: c_pointer
+ logical                        :: exists
+ 
+ deallocate(det_coef_matrix_values)
+ deallocate(det_coef_matrix_rows)
+ deallocate(det_coef_matrix_columns)
+ INQUIRE(FILE='/dev/shm/det_coef_matrix_values', EXIST=exists)
+ 
+ call mmap('/dev/shm/det_coef_matrix_values', &
+     (/det_num_input/), 8, fd, c_pointer)
+ call c_f_pointer(c_pointer,det_coef_matrix_values,(/det_num_input/))
+
+ call mmap('/dev/shm/det_coef_matrix_rows', &
+     (/det_num_input/), 4, fd, c_pointer)
+ call c_f_pointer(c_pointer,det_coef_matrix_rows,(/det_num_input/))
+
+ call mmap('/dev/shm/det_coef_matrix_columns', &
+     (/det_num_input/), 4, fd, c_pointer)
+ call c_f_pointer(c_pointer,det_coef_matrix_columns,(/det_num_input/))
+ 
+ if (.not.exists) then
   allocate (buffer(det_num_input,N_states))
   call get_spindeterminants_psi_coef_matrix_rows(det_coef_matrix_rows)
   call get_spindeterminants_psi_coef_matrix_columns(det_coef_matrix_columns)
   call get_spindeterminants_psi_coef_matrix_values(buffer)
   det_coef_matrix_values(:) = buffer(:,i_state)
   deallocate(buffer)
+ endif
 END_PROVIDER
 
 BEGIN_PROVIDER [ integer, det_num ]
@@ -222,19 +246,49 @@ BEGIN_PROVIDER [ double precision, ci_threshold ]
 END_PROVIDER
 
 BEGIN_PROVIDER [ integer*8, psi_det_alpha, (N_int,det_alpha_num) ]
+ use mmap_module
  implicit none
  BEGIN_DOC
  ! Alpha determinants
  END_DOC
- call get_spindeterminants_psi_det_alpha(psi_det_alpha)
+ integer                        :: fd
+ type(c_ptr)                    :: c_pointer
+ logical                        :: exists
+ 
+ deallocate(psi_det_alpha)
+ INQUIRE(FILE='/dev/shm/psi_det_alpha', EXIST=exists)
+ 
+ call mmap('/dev/shm/psi_det_alpha',                                       &
+     (/N_int,det_alpha_num/), 8, fd, c_pointer)
+ 
+ call c_f_pointer(c_pointer,psi_det_alpha,(/N_int,det_alpha_num/))
+ 
+ if (.not.exists) then
+  call get_spindeterminants_psi_det_alpha(psi_det_alpha)
+ endif
 END_PROVIDER
 
 BEGIN_PROVIDER [ integer*8, psi_det_beta, (N_int,det_beta_num) ]
+ use mmap_module
  implicit none
  BEGIN_DOC
  ! Beta determinants
  END_DOC
- call get_spindeterminants_psi_det_beta(psi_det_beta)
+ integer                        :: fd
+ type(c_ptr)                    :: c_pointer
+ logical                        :: exists
+ 
+ deallocate(psi_det_beta)
+ INQUIRE(FILE='/dev/shm/psi_det_beta', EXIST=exists)
+ 
+ call mmap('/dev/shm/psi_det_beta',                                       &
+     (/N_int,det_beta_num/), 8, fd, c_pointer)
+ 
+ call c_f_pointer(c_pointer,psi_det_beta,(/N_int,det_beta_num/))
+ 
+ if (.not.exists) then
+  call get_spindeterminants_psi_det_beta(psi_det_beta)
+ endif
 END_PROVIDER
 
 BEGIN_PROVIDER  [ integer, present_mos, (mo_tot_num) ]