9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01:00

Improve mmap interface

This commit is contained in:
Anthony Scemama 2024-09-25 11:11:55 +02:00
parent 360ac7b128
commit 4c4c65581a
3 changed files with 142 additions and 6 deletions

View File

@ -76,8 +76,7 @@ END_PROVIDER
ndim8 = ao_num*ao_num*1_8+1
double precision :: wall0,wall1
type(c_ptr) :: c_pointer(2)
integer :: fd(2)
type(mmap_type) :: map
PROVIDE nproc ao_cholesky_threshold do_direct_integrals qp_max_mem
PROVIDE nucl_coord ao_two_e_integral_schwartz
@ -181,8 +180,9 @@ END_PROVIDER
if (elec_num > 10) then
rank_max = min(np,20*elec_num*elec_num)
endif
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 /))
call mmap_create_d(trim(ezfio_work_dir)//'cholesky_ao_tmp', (/ ndim8, rank_max /), 8, .False., .True., map)
L => map%d2
! Deleting the file while it is open makes the file invisible on the filesystem,
! and automatically deleted, even if the program crashes
@ -480,7 +480,7 @@ END_PROVIDER
enddo
!$OMP END PARALLEL DO
call munmap( (/ ndim8, rank_max /), 8, fd(1), c_pointer(1) )
call mmap_destroy(map)
cholesky_ao_num = rank

View File

@ -910,6 +910,7 @@ subroutine copy_psi_bilinear_to_psi(psi, isize)
end
BEGIN_PROVIDER [ integer*8, singles_alpha_csc_idx, (N_det_alpha_unique+1) ]
&BEGIN_PROVIDER [ integer*8, singles_alpha_csc_size ]
implicit none

View File

@ -2,6 +2,25 @@ module mmap_module
use iso_c_binding
type mmap_type
type(c_ptr) :: ptr ! Pointer to the data
character*(128) :: filename ! Name of the file
integer*8 :: length ! Size of the array in bytes
integer :: fd ! File descriptor
! Pointers to data
integer, pointer, dimension (:) :: i1
integer, pointer, dimension (:,:) :: i2
integer, pointer, dimension (:,:,:) :: i3
integer, pointer, dimension (:,:,:,:) :: i4
! Pointers to data
double precision, pointer, dimension (:) :: d1
double precision, pointer, dimension (:,:) :: d2
double precision, pointer, dimension (:,:,:) :: d3
double precision, pointer, dimension (:,:,:,:) :: d4
end type mmap_type
interface
! File descriptors
@ -82,7 +101,7 @@ module mmap_module
length = length * shape(i)
enddo
fd_ = fd
call c_munmap_fortran( length, fd_, map)
call c_munmap_fortran(length, fd_, map)
end subroutine
subroutine msync(shape, bytes, fd, map)
@ -106,6 +125,122 @@ module mmap_module
call c_msync_fortran( length, fd_, map)
end subroutine
! Functions for the mmap_type
subroutine mmap_create(filename, shape, bytes, 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
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
type(mmap_type), intent(out) :: map ! mmap
integer :: i
map%filename = filename
map%length = int(bytes,8)
do i=1,size(shape)
map%length = map%length * shape(i)
enddo
call mmap(map%filename, &
shape, &
bytes, &
map%fd, &
read_only, &
single_node, &
map%ptr)
map%d1 => NULL()
map%d2 => NULL()
map%d3 => NULL()
map%d4 => NULL()
map%i1 => NULL()
map%i2 => NULL()
map%i3 => NULL()
map%i4 => NULL()
end
subroutine mmap_create_d(filename, shape, bytes, 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
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
type(mmap_type), intent(out) :: map ! mmap
call mmap_create(filename, shape, bytes, read_only, single_node, map)
select case (size(shape))
case (1)
call c_f_pointer(map%ptr, map%d1, shape)
case (2)
call c_f_pointer(map%ptr, map%d2, shape)
case (3)
call c_f_pointer(map%ptr, map%d3, shape)
case (4)
call c_f_pointer(map%ptr, map%d4, shape)
case default
stop 'mmap: dimension not implemented'
end select
end subroutine
subroutine mmap_create_i(filename, shape, bytes, 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
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
type(mmap_type), intent(out) :: map ! mmap
call mmap_create(filename, shape, bytes, read_only, single_node, map)
select case (size(shape))
case (1)
call c_f_pointer(map%ptr, map%i1, shape)
case (2)
call c_f_pointer(map%ptr, map%i2, shape)
case (3)
call c_f_pointer(map%ptr, map%i3, shape)
case (4)
call c_f_pointer(map%ptr, map%i4, shape)
case default
stop 'mmap: dimension not implemented'
end select
end subroutine
subroutine mmap_destroy(map)
implicit none
type(mmap_type), intent(inout) :: map
call c_munmap_fortran(map%length, map%fd, map%ptr)
map%ptr = C_NULL_PTR
map%filename = ''
map%length = 0
map%fd = 0
map%d1 => NULL()
map%d2 => NULL()
map%d3 => NULL()
map%d4 => NULL()
map%i1 => NULL()
map%i2 => NULL()
map%i3 => NULL()
map%i4 => NULL()
end subroutine
subroutine mmap_sync(map)
implicit none
type(mmap_type), intent(inout) :: map
call c_msync_fortran(map%length, map%fd, map%ptr)
end subroutine
end module mmap_module