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
|
character*(32) :: env
|
||||||
call getenv('QP_NTHREADS_PT2',env)
|
call getenv('QP_NTHREADS_PT2',env)
|
||||||
if (trim(env) /= '') then
|
if (trim(env) /= '') then
|
||||||
|
call lock_io()
|
||||||
read(env,*) nthreads_pt2
|
read(env,*) nthreads_pt2
|
||||||
|
call unlock_io()
|
||||||
call write_int(6,nthreads_pt2,'Target number of threads for PT2')
|
call write_int(6,nthreads_pt2,'Target number of threads for PT2')
|
||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -150,7 +150,9 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
if(task_id == 0) exit
|
if(task_id == 0) exit
|
||||||
|
call lock_io()
|
||||||
read (msg,*) imin, imax, ishift, istep
|
read (msg,*) imin, imax, ishift, istep
|
||||||
|
call unlock_io()
|
||||||
integer :: k
|
integer :: k
|
||||||
do k=imin,imax
|
do k=imin,imax
|
||||||
v_t(:,k) = 0.d0
|
v_t(:,k) = 0.d0
|
||||||
@ -555,7 +557,9 @@ BEGIN_PROVIDER [ integer, nthreads_davidson ]
|
|||||||
character*(32) :: env
|
character*(32) :: env
|
||||||
call getenv('QP_NTHREADS_DAVIDSON',env)
|
call getenv('QP_NTHREADS_DAVIDSON',env)
|
||||||
if (trim(env) /= '') then
|
if (trim(env) /= '') then
|
||||||
|
call lock_io()
|
||||||
read(env,*) nthreads_davidson
|
read(env,*) nthreads_davidson
|
||||||
|
call unlock_io()
|
||||||
call write_int(6,nthreads_davidson,'Target number of threads for <Psi|H|Psi>')
|
call write_int(6,nthreads_davidson,'Target number of threads for <Psi|H|Psi>')
|
||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -9,4 +9,21 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), file_lock ]
|
|||||||
call omp_init_lock(file_lock)
|
call omp_init_lock(file_lock)
|
||||||
END_PROVIDER
|
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
|
integer*8 :: n, j
|
||||||
load_mo_integrals = 1
|
load_mo_integrals = 1
|
||||||
open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
|
open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
|
||||||
|
call lock_io()
|
||||||
read(66,err=98,end=98) iknd, kknd
|
read(66,err=98,end=98) iknd, kknd
|
||||||
if (iknd /= integral_kind) then
|
if (iknd /= integral_kind) then
|
||||||
print *, 'Wrong integrals kind in file :', iknd
|
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
|
n = mo_integrals_map%map(i)%n_elements
|
||||||
read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
|
read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
|
||||||
enddo
|
enddo
|
||||||
|
call unlock_io()
|
||||||
call map_sort(mo_integrals_map)
|
call map_sort(mo_integrals_map)
|
||||||
load_mo_integrals = 0
|
load_mo_integrals = 0
|
||||||
return
|
return
|
||||||
|
@ -241,13 +241,13 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
character*(80) :: buffer, dummy
|
character*(80) :: buffer, dummy
|
||||||
do
|
do
|
||||||
read(iunit,'(A80)',end=10) buffer
|
read(iunit,'(A80)',end=10) buffer
|
||||||
read(buffer,*) i ! First read i
|
read(buffer,*) i ! First read i
|
||||||
read(buffer,*) i, element_name(i), dummy, element_mass(i)
|
read(buffer,*) i, element_name(i), dummy, element_mass(i)
|
||||||
enddo
|
enddo
|
||||||
10 continue
|
10 continue
|
||||||
close(10)
|
close(10)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
IRP_IF MPI_DEBUG
|
IRP_IF MPI_DEBUG
|
||||||
print *, irp_here, mpi_rank
|
print *, irp_here, mpi_rank
|
||||||
|
@ -1,15 +1,17 @@
|
|||||||
subroutine write_array_two_rdm(n_orb,nstates,array_tmp,name_file)
|
subroutine write_array_two_rdm(n_orb,nstates,array_tmp,name_file)
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: n_orb,nstates
|
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)
|
double precision, intent(in) :: array_tmp(n_orb,n_orb,n_orb,n_orb,nstates)
|
||||||
|
|
||||||
character*(128) :: output
|
character*(128) :: output
|
||||||
integer :: i_unit_output,getUnitAndOpen
|
integer :: i_unit_output,getUnitAndOpen
|
||||||
PROVIDE ezfio_filename
|
PROVIDE ezfio_filename
|
||||||
output=trim(ezfio_filename)//'/work/'//trim(name_file)
|
output=trim(ezfio_filename)//'/work/'//trim(name_file)
|
||||||
i_unit_output = getUnitAndOpen(output,'W')
|
i_unit_output = getUnitAndOpen(output,'W')
|
||||||
|
call lock_io()
|
||||||
write(i_unit_output)array_tmp
|
write(i_unit_output)array_tmp
|
||||||
|
call unlock_io()
|
||||||
close(unit=i_unit_output)
|
close(unit=i_unit_output)
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -18,12 +20,14 @@ subroutine read_array_two_rdm(n_orb,nstates,array_tmp,name_file)
|
|||||||
character*(128) :: output
|
character*(128) :: output
|
||||||
integer :: i_unit_output,getUnitAndOpen
|
integer :: i_unit_output,getUnitAndOpen
|
||||||
integer, intent(in) :: n_orb,nstates
|
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)
|
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)
|
output=trim(ezfio_filename)//'/work/'//trim(name_file)
|
||||||
i_unit_output = getUnitAndOpen(output,'R')
|
i_unit_output = getUnitAndOpen(output,'R')
|
||||||
|
call lock_io()
|
||||||
read(i_unit_output)array_tmp
|
read(i_unit_output)array_tmp
|
||||||
|
call unlock_io()
|
||||||
close(unit=i_unit_output)
|
close(unit=i_unit_output)
|
||||||
end
|
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
|
character(len=20) :: str_size, str_nb_digits, str_exp
|
||||||
integer :: nb_digits
|
integer :: nb_digits
|
||||||
|
|
||||||
!$OMP CRITICAL
|
call lock_io()
|
||||||
! max_nb_digit: Y max
|
! max_nb_digit: Y max
|
||||||
! size_nb = Size of the double: X (FX.Y)
|
! size_nb = Size of the double: X (FX.Y)
|
||||||
write(str_size,'(I3)') size_nb
|
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
|
! FX.Y just for the value
|
||||||
format_value = 'F'//trim(adjustl(str_size))//'.'//trim(adjustl(str_nb_digits))
|
format_value = 'F'//trim(adjustl(str_size))//'.'//trim(adjustl(str_nb_digits))
|
||||||
!$OMP END CRITICAL
|
call unlock_io()
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -8,7 +8,9 @@ BEGIN_PROVIDER [ integer, qp_max_mem ]
|
|||||||
qp_max_mem = 2000
|
qp_max_mem = 2000
|
||||||
call getenv('QP_MAXMEM',env)
|
call getenv('QP_MAXMEM',env)
|
||||||
if (trim(env) /= '') then
|
if (trim(env) /= '') then
|
||||||
|
call lock_io()
|
||||||
read(env,*) qp_max_mem
|
read(env,*) qp_max_mem
|
||||||
|
call unlock_io()
|
||||||
endif
|
endif
|
||||||
call write_int(6,qp_max_mem,'Target maximum memory (GB)')
|
call write_int(6,qp_max_mem,'Target maximum memory (GB)')
|
||||||
|
|
||||||
@ -25,7 +27,7 @@ subroutine resident_memory(value)
|
|||||||
character*(32) :: key
|
character*(32) :: key
|
||||||
double precision, intent(out) :: value
|
double precision, intent(out) :: value
|
||||||
|
|
||||||
call omp_set_lock(file_lock)
|
call lock_io()
|
||||||
call usleep(10)
|
call usleep(10)
|
||||||
|
|
||||||
value = 0.d0
|
value = 0.d0
|
||||||
@ -40,7 +42,7 @@ subroutine resident_memory(value)
|
|||||||
20 continue
|
20 continue
|
||||||
close(iunit)
|
close(iunit)
|
||||||
value = value / (1024.d0*1024.d0)
|
value = value / (1024.d0*1024.d0)
|
||||||
call omp_unset_lock(file_lock)
|
call unlock_io()
|
||||||
end function
|
end function
|
||||||
|
|
||||||
subroutine total_memory(value)
|
subroutine total_memory(value)
|
||||||
@ -53,6 +55,7 @@ subroutine total_memory(value)
|
|||||||
character*(32) :: key
|
character*(32) :: key
|
||||||
double precision, intent(out) :: value
|
double precision, intent(out) :: value
|
||||||
|
|
||||||
|
call lock_io()
|
||||||
iunit = getUnitAndOpen('/proc/self/status','r')
|
iunit = getUnitAndOpen('/proc/self/status','r')
|
||||||
do
|
do
|
||||||
read(iunit,*,err=10,end=20) key, value
|
read(iunit,*,err=10,end=20) key, value
|
||||||
@ -64,6 +67,7 @@ subroutine total_memory(value)
|
|||||||
20 continue
|
20 continue
|
||||||
close(iunit)
|
close(iunit)
|
||||||
value = value / (1024.d0*1024.d0)
|
value = value / (1024.d0*1024.d0)
|
||||||
|
call unlock_io()
|
||||||
end function
|
end function
|
||||||
|
|
||||||
double precision function memory_of_double(n)
|
double precision function memory_of_double(n)
|
||||||
|
Loading…
Reference in New Issue
Block a user