mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 04:12:00 +02:00
Merge pull request #273 from QuantumPackage/io
Some checks reported errors
continuous-integration/drone/push Build was killed
Some checks reported errors
continuous-integration/drone/push Build was killed
Improve thread-safety
This commit is contained in:
commit
25577131dd
@ -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
|
||||
|
@ -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
|
||||
|
@ -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()
|
||||
|
@ -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
|
||||
|
@ -9,7 +9,9 @@ subroutine write_array_two_rdm(n_orb,nstates,array_tmp,name_file)
|
||||
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
|
||||
|
||||
@ -23,7 +25,9 @@ subroutine read_array_two_rdm(n_orb,nstates,array_tmp,name_file)
|
||||
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
|
||||
|
||||
|
@ -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,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)
|
||||
|
Loading…
Reference in New Issue
Block a user