PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-16 02:53:51 +01:00
Code Releases Activity

Merge pull request #273 from QuantumPackage/io

Browse Source 
Improve thread-safety
This commit is contained in:
Anthony Scemama 2023-05-10 15:18:07 +02:00 committed by GitHub
commit 25577131dd
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 48 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/cipsi/environment.irp.f
View File

@ -7,7 +7,9 @@ BEGIN_PROVIDER [ integer, nthreads_pt2 ]
character*(32) :: env
call getenv('QP_NTHREADS_PT2',env)
if (trim(env) /= '') then
call lock_io()
read(env,*) nthreads_pt2
call unlock_io()
call write_int(6,nthreads_pt2,'Target number of threads for PT2')
endif
END_PROVIDER

4
src/davidson/davidson_parallel.irp.f
View File

@ -150,7 +150,9 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
exit
endif
if(task_id == 0) exit
call lock_io()
read (msg,*) imin, imax, ishift, istep
call unlock_io()
integer :: k
do k=imin,imax
v_t(:,k) = 0.d0
@ -555,7 +557,9 @@ BEGIN_PROVIDER [ integer, nthreads_davidson ]
character*(32) :: env
call getenv('QP_NTHREADS_DAVIDSON',env)
if (trim(env) /= '') then
call lock_io()
read(env,*) nthreads_davidson
call unlock_io()
call write_int(6,nthreads_davidson,'Target number of threads for <Psi|H|Psi>')
endif
END_PROVIDER

17
src/ezfio_files/lock.irp.f
View File

@ -9,4 +9,21 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), file_lock ]
call omp_init_lock(file_lock)
END_PROVIDER
! These functions need to be called because internal read and write are not thread safe.
subroutine lock_io()
implicit none
BEGIN_DOC
! Needs to be called because before doing I/O because internal read and write
! are not thread safe.
END_DOC
call omp_set_lock(file_lock)
end subroutine lock_io()
subroutine unlock_io()
implicit none
BEGIN_DOC
! Needs to be called because afterdoing I/O because internal read and write
! are not thread safe.
END_DOC
call omp_unset_lock(file_lock)
end subroutine lock_io()

2
src/mo_two_e_ints/map_integrals.irp.f
View File

@ -377,6 +377,7 @@ integer function load_mo_integrals(filename)
integer*8 :: n, j
load_mo_integrals = 1
open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
call lock_io()
read(66,err=98,end=98) iknd, kknd
if (iknd /= integral_kind) then
print *, 'Wrong integrals kind in file :', iknd
@ -399,6 +400,7 @@ integer function load_mo_integrals(filename)
n = mo_integrals_map%map(i)%n_elements
read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
enddo
call unlock_io()
call map_sort(mo_integrals_map)
load_mo_integrals = 0
return

14
src/nuclei/nuclei.irp.f
View File

@ -241,13 +241,13 @@ END_PROVIDER
enddo
character*(80) :: buffer, dummy
do
read(iunit,'(A80)',end=10) buffer
read(buffer,*) i ! First read i
read(buffer,*) i, element_name(i), dummy, element_mass(i)
enddo
10 continue
close(10)
endif
read(iunit,'(A80)',end=10) buffer
read(buffer,*) i ! First read i
read(buffer,*) i, element_name(i), dummy, element_mass(i)
enddo
10 continue
close(10)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank

12
src/two_body_rdm/io_two_rdm.irp.f
View File

@ -1,15 +1,17 @@
subroutine write_array_two_rdm(n_orb,nstates,array_tmp,name_file)
implicit none
integer, intent(in) :: n_orb,nstates
character*(128), intent(in) :: name_file
character*(128), intent(in) :: name_file
double precision, intent(in) :: array_tmp(n_orb,n_orb,n_orb,n_orb,nstates)
character*(128) :: output
integer :: i_unit_output,getUnitAndOpen
PROVIDE ezfio_filename
PROVIDE ezfio_filename
output=trim(ezfio_filename)//'/work/'//trim(name_file)
i_unit_output = getUnitAndOpen(output,'W')
call lock_io()
write(i_unit_output)array_tmp
call unlock_io()
close(unit=i_unit_output)
end
@ -18,12 +20,14 @@ subroutine read_array_two_rdm(n_orb,nstates,array_tmp,name_file)
character*(128) :: output
integer :: i_unit_output,getUnitAndOpen
integer, intent(in) :: n_orb,nstates
character*(128), intent(in) :: name_file
character*(128), intent(in) :: name_file
double precision, intent(out) :: array_tmp(n_orb,n_orb,n_orb,n_orb,N_states)
PROVIDE ezfio_filename
PROVIDE ezfio_filename
output=trim(ezfio_filename)//'/work/'//trim(name_file)
i_unit_output = getUnitAndOpen(output,'R')
call lock_io()
read(i_unit_output)array_tmp
call unlock_io()
close(unit=i_unit_output)
end

4
src/utils/format_w_error.irp.f
View File

@ -33,7 +33,7 @@ subroutine format_w_error(value,error,size_nb,max_nb_digits,format_value,str_err
character(len=20) :: str_size, str_nb_digits, str_exp
integer :: nb_digits
!$OMP CRITICAL
call lock_io()
! max_nb_digit: Y max
! size_nb = Size of the double: X (FX.Y)
write(str_size,'(I3)') size_nb
@ -68,6 +68,6 @@ subroutine format_w_error(value,error,size_nb,max_nb_digits,format_value,str_err
! FX.Y just for the value
format_value = 'F'//trim(adjustl(str_size))//'.'//trim(adjustl(str_nb_digits))
!$OMP END CRITICAL
call unlock_io()
end

8
src/utils/memory.irp.f
View File

@ -8,7 +8,9 @@ BEGIN_PROVIDER [ integer, qp_max_mem ]
qp_max_mem = 2000
call getenv('QP_MAXMEM',env)
if (trim(env) /= '') then
call lock_io()
read(env,*) qp_max_mem
call unlock_io()
endif
call write_int(6,qp_max_mem,'Target maximum memory (GB)')
@ -25,7 +27,7 @@ subroutine resident_memory(value)
character*(32) :: key
double precision, intent(out) :: value
call omp_set_lock(file_lock)
call lock_io()
call usleep(10)
value = 0.d0
@ -40,7 +42,7 @@ subroutine resident_memory(value)
20 continue
close(iunit)
value = value / (1024.d0*1024.d0)
call omp_unset_lock(file_lock)
call unlock_io()
end function
subroutine total_memory(value)
@ -53,6 +55,7 @@ subroutine total_memory(value)
character*(32) :: key
double precision, intent(out) :: value
call lock_io()
iunit = getUnitAndOpen('/proc/self/status','r')
do
read(iunit,*,err=10,end=20) key, value
@ -64,6 +67,7 @@ subroutine total_memory(value)
20 continue
close(iunit)
value = value / (1024.d0*1024.d0)
call unlock_io()
end function
double precision function memory_of_double(n)