diff --git a/ezfio_config/qmc.config b/ezfio_config/qmc.config index 29aaac9..bdddf2f 100644 --- a/ezfio_config/qmc.config +++ b/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) - diff --git a/scripts/compile_irpf90.sh b/scripts/compile_irpf90.sh index 2b790d5..d9c79f0 100755 --- a/scripts/compile_irpf90.sh +++ b/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 diff --git a/src/TOOLS/fortran_mmap.c b/src/TOOLS/fortran_mmap.c new file mode 100644 index 0000000..21653c6 --- /dev/null +++ b/src/TOOLS/fortran_mmap.c @@ -0,0 +1,58 @@ +#include +#include +#include +#include +#include +#include +#include + +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); +} diff --git a/src/TOOLS/mmap.f90 b/src/TOOLS/mmap.f90 new file mode 100644 index 0000000..501e54e --- /dev/null +++ b/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 + + diff --git a/src/ezfio_interface.irp.f b/src/ezfio_interface.irp.f index 08c9cfe..ec4a3b1 100644 --- a/src/ezfio_interface.irp.f +++ b/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 = [\ diff --git a/src/mo.irp.f b/src/mo.irp.f index ee2c2fc..db2473e 100644 --- a/src/mo.irp.f +++ b/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 diff --git a/src/simulation.irp.f b/src/simulation.irp.f index 0995e2d..5c7c239 100644 --- a/src/simulation.irp.f +++ b/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. diff --git a/src/wf.irp.f b/src/wf.irp.f index cee557b..120e9a5 100644 --- a/src/wf.irp.f +++ b/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) ]