LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-25 17:54:44 +02:00
Code Releases Activity

Removed ZeroMQ from AO integrals calculation

Browse Source
This commit is contained in:
Anthony Scemama 2025-01-27 16:36:35 +01:00
parent d01e24c302
commit 7d46b5ce34
5 changed files with 63 additions and 533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/ao_two_e_ints/NEED
View File

@ -2,5 +2,4 @@ hamiltonian
ao_one_e_ints
pseudo
bitmask
zmq
ao_basis

194
src/ao_two_e_ints/integrals_erf_in_map_slave.irp.f
View File

@ -1,194 +0,0 @@
subroutine ao_two_e_integrals_erf_in_map_slave_tcp(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_erf_in_map_slave(0,i)
end
subroutine ao_two_e_integrals_erf_in_map_slave_inproc(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_erf_in_map_slave(1,i)
end
subroutine ao_two_e_integrals_erf_in_map_slave(thread,iproc)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Computes a buffer of integrals
END_DOC
integer, intent(in) :: thread, iproc
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer :: worker_id, task_id
character*(512) :: task
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
character*(64) :: state
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
integer, external :: connect_to_taskserver
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
return
endif
zmq_socket_push = new_zmq_push_socket(thread)
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
do
integer, external :: get_task_from_taskserver
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
exit
endif
if (task_id == 0) exit
read(task,*) j, l
integer, external :: task_done_to_taskserver
call compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
stop 'Unable to send task_done'
endif
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
enddo
integer, external :: disconnect_from_taskserver
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
continue
endif
deallocate( buffer_i, buffer_value )
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
end
subroutine ao_two_e_integrals_erf_in_map_collector(zmq_socket_pull)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Collects results from the AO integral calculation
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer*8 :: control, accu, sze
integer :: task_id, more
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
sze = ao_num*ao_num
allocate ( buffer_i(sze), buffer_value(sze) )
accu = 0_8
more = 1
do while (more == 1)
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
if (rc == -1) then
n_integrals = 0
return
endif
if (rc /= 4) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
stop 'error'
endif
if (n_integrals >= 0) then
if (n_integrals > sze) then
deallocate (buffer_value, buffer_i)
sze = n_integrals
allocate (buffer_value(sze), buffer_i(sze))
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
if (rc /= key_kind*n_integrals) then
print *, rc, key_kind, n_integrals
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
if (rc /= 4) then
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
stop 'error'
endif
IRP_ENDIF
call insert_into_ao_integrals_erf_map(n_integrals,buffer_i,buffer_value)
accu += n_integrals
if (task_id /= 0) then
integer, external :: zmq_delete_task
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
stop 'Unable to delete task'
endif
endif
endif
enddo
deallocate( buffer_i, buffer_value )
integer (map_size_kind) :: get_ao_erf_map_size
control = get_ao_erf_map_size(ao_integrals_erf_map)
if (control /= accu) then
print *, ''
print *, irp_here
print *, 'Control : ', control
print *, 'Accu : ', accu
print *, 'Some integrals were lost during the parallel computation.'
print *, 'Try to reduce the number of threads.'
stop
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end

244
src/ao_two_e_ints/integrals_in_map_slave.irp.f
View File

@ -1,244 +0,0 @@
subroutine ao_two_e_integrals_in_map_slave_tcp(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_in_map_slave(0,i)
end
subroutine ao_two_e_integrals_in_map_slave_inproc(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_in_map_slave(1,i)
end
subroutine push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
use f77_zmq
use map_module
implicit none
BEGIN_DOC
! Push integrals in the push socket
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
integer, intent(in) :: n_integrals
integer(key_kind), intent(in) :: buffer_i(*)
real(integral_kind), intent(in) :: buffer_value(*)
integer, intent(in) :: task_id
integer :: rc
rc = f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)
if (rc /= key_kind*n_integrals) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, ZMQ_SNDMORE)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
stop 'error'
endif
IRP_IF ZMQ_PUSH
IRP_ELSE
integer :: idummy
rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, idummy, 4, 0)'
stop 'error'
endif
IRP_ENDIF
end
subroutine ao_two_e_integrals_in_map_slave(thread,iproc)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Computes a buffer of integrals
END_DOC
integer, intent(in) :: thread, iproc
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer :: worker_id, task_id
character*(512) :: task
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
character*(64) :: state
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
integer, external :: connect_to_taskserver
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
return
endif
zmq_socket_push = new_zmq_push_socket(thread)
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
do
integer, external :: get_task_from_taskserver
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
exit
endif
if (task_id == 0) exit
call sscanf_dd(task, j, l)
integer, external :: task_done_to_taskserver
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
stop 'Unable to send task_done'
endif
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
enddo
integer, external :: disconnect_from_taskserver
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
continue
endif
deallocate( buffer_i, buffer_value )
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
end
subroutine ao_two_e_integrals_in_map_collector(zmq_socket_pull)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Collects results from the AO integral calculation
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer*8 :: control, accu, sze
integer :: task_id, more
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
sze = ao_num*ao_num
allocate ( buffer_i(sze), buffer_value(sze) )
accu = 0_8
more = 1
do while (more == 1)
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
if (rc == -1) then
n_integrals = 0
return
endif
if (rc /= 4) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
stop 'error'
endif
if (n_integrals >= 0) then
if (n_integrals > sze) then
deallocate (buffer_value, buffer_i)
sze = n_integrals
allocate (buffer_value(sze), buffer_i(sze))
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
if (rc /= key_kind*n_integrals) then
print *, rc, key_kind, n_integrals
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
if (rc /= 4) then
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
stop 'error'
endif
IRP_ENDIF
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
accu += n_integrals
if (task_id /= 0) then
integer, external :: zmq_delete_task
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
stop 'Unable to delete task'
endif
endif
endif
enddo
deallocate( buffer_i, buffer_value )
integer (map_size_kind) :: get_ao_map_size
control = get_ao_map_size(ao_integrals_map)
if (control /= accu) then
print *, ''
print *, irp_here
print *, 'Control : ', control
print *, 'Accu : ', accu
print *, 'Some integrals were lost during the parallel computation.'
print *, 'Try to reduce the number of threads.'
stop
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end

53
src/ao_two_e_ints/providers_ao_erf.irp.f
View File

@ -1,7 +1,5 @@
BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
implicit none
use f77_zmq
use map_module
BEGIN_DOC
! Map of Atomic integrals
@ -15,17 +13,16 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
! For integrals file
integer(key_kind),allocatable :: buffer_i(:)
integer,parameter :: size_buffer = 1024*64
integer :: size_buffer
real(integral_kind),allocatable :: buffer_value(:)
integer :: n_integrals, rc
integer :: kk, m, j1, i1, lmax
character*(64) :: fmt
integral = ao_two_e_integral_erf(1,1,1,1)
double precision :: map_mb
PROVIDE read_ao_two_e_integrals_erf io_ao_two_e_integrals_erf
PROVIDE read_ao_two_e_integrals_erf io_ao_two_e_integrals_erf ao_integrals_erf_map
if (read_ao_two_e_integrals_erf) then
print*,'Reading the AO ERF integrals'
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map)
@ -39,37 +36,27 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
call wall_time(wall_1)
call cpu_time(cpu_1)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals_erf')
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
endif
enddo
deallocate(task)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral_erf(1,1,1,1)
endif
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_erf_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_erf_in_map_slave_inproc(i)
endif
size_buffer = ao_num*ao_num
!$OMP PARALLEL DEFAULT(shared) private(j,l) &
!$OMP PRIVATE(buffer_i, buffer_value, n_integrals)
allocate(buffer_i(size_buffer), buffer_value(size_buffer))
n_integrals = 0
!$OMP DO COLLAPSE(1) SCHEDULE(dynamic)
do l=1,ao_num
do j=1,l
call compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
call insert_into_ao_integrals_erf_map(n_integrals,buffer_i,buffer_value)
enddo
enddo
!$OMP END DO
deallocate(buffer_i, buffer_value)
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals_erf')
print*, 'Sorting the map'

104
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -397,7 +397,6 @@ end
BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
implicit none
use f77_zmq
use map_module
BEGIN_DOC
! Map of Atomic integrals
@ -411,7 +410,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
! For integrals file
integer(key_kind),allocatable :: buffer_i(:)
integer,parameter :: size_buffer = 1024*64
integer :: size_buffer
real(integral_kind),allocatable :: buffer_value(:)
integer :: n_integrals, rc
@ -419,78 +418,61 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
character*(64) :: fmt
double precision :: map_mb
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals ao_integrals_map
if (read_ao_two_e_integrals) then
print*,'Reading the AO integrals'
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
print*, 'AO integrals provided'
ao_two_e_integrals_in_map = .True.
else
return
endif
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral(1,1,1,1)
endif
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral(1,1,1,1)
endif
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals')
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
endif
size_buffer = ao_num*ao_num
!$OMP PARALLEL DEFAULT(shared) private(j,l) &
!$OMP PRIVATE(buffer_i, buffer_value, n_integrals)
allocate(buffer_i(size_buffer), buffer_value(size_buffer))
n_integrals = 0
!$OMP DO COLLAPSE(1) SCHEDULE(dynamic)
do l=1,ao_num
do j=1,l
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
enddo
deallocate(task)
enddo
!$OMP END DO
deallocate(buffer_i, buffer_value)
!$OMP END PARALLEL
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_in_map_slave_inproc(i)
endif
!$OMP END PARALLEL
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals')
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
ao_two_e_integrals_in_map = .True.
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
ao_two_e_integrals_in_map = .True.
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
END_PROVIDER