mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Added ZMQ 4idx
This commit is contained in:
parent
44f91e4187
commit
d98805b3e5
@ -9,7 +9,7 @@
|
||||
FC : ifort
|
||||
LAPACK_LIB : -mkl=parallel
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 -DZMQ_PUSH
|
||||
IRPF90_FLAGS : --ninja --align=32
|
||||
|
||||
# Global options
|
||||
################
|
||||
|
||||
@ -88,7 +88,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
end do
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
|
||||
|
||||
@ -112,6 +112,8 @@ program fci_zmq
|
||||
write(*,fmt) '# Excit. (eV)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1))*27.211396641308d0, &
|
||||
dsqrt(error(k)*error(k)+error(1)*error(1))*27.211396641308d0, k=1,N_states_p)
|
||||
endif
|
||||
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))'
|
||||
write(*,fmt)
|
||||
print *, ''
|
||||
|
||||
print *, 'N_det = ', N_det
|
||||
|
||||
@ -73,7 +73,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
||||
end do
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
|
||||
|
||||
@ -93,7 +93,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
|
||||
|
||||
@ -208,7 +208,7 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
||||
|
||||
deallocate(delta)
|
||||
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
|
||||
@ -130,7 +130,7 @@ subroutine run_mrcc_slave(thread,iproc,energy)
|
||||
if(done) exit
|
||||
ctask = ctask + 1
|
||||
end do
|
||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||
! call delete_selection_buffer(buf)
|
||||
|
||||
@ -45,7 +45,7 @@ subroutine davidson_run_slave(thread,iproc)
|
||||
call davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_states_diag, N_det, worker_id)
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
|
||||
|
||||
@ -213,7 +213,7 @@ subroutine $subroutine_slave(thread, iproc)
|
||||
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||
|
||||
@ -261,10 +261,6 @@ subroutine four_index_transform_block(map_a,map_c,matrix_B,LDB, &
|
||||
enddo
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!$OMP CRITICAL
|
||||
call map_update(map_c, key, value, idx,1.d-15)
|
||||
!$OMP END CRITICAL
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
subroutine four_index_transform_slave_work(map_a,matrix_B,LDB, &
|
||||
i_start, j_start, k_start, l_start, &
|
||||
i_end , j_end , k_end , l_end , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
@ -13,7 +13,6 @@ subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
! Loops run over *_start->*_end
|
||||
END_DOC
|
||||
type(map_type), intent(in) :: map_a
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer, intent(in) :: LDB
|
||||
double precision, intent(in) :: matrix_B(LDB,*)
|
||||
integer, intent(in) :: i_start, j_start, k_start, l_start
|
||||
@ -66,7 +65,14 @@ subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
integer*8 :: new_size
|
||||
new_size = max(1024_8, 5_8 * map_a % n_elements )
|
||||
|
||||
allocate(a_array_ik(new_size), a_array_j(new_size), a_array_value(new_size))
|
||||
integer*8 :: tempspace
|
||||
integer :: npass, l_block
|
||||
|
||||
tempspace = (new_size * 16_8) / (1024_8 * 1024_8)
|
||||
npass = int(min(int(l_end-l_start,8),1_8 + tempspace / 2048_8),4) ! 2 GiB of scratch space
|
||||
l_block = (l_end-l_start+1)/npass
|
||||
|
||||
allocate(a_array_ik(new_size/npass), a_array_j(new_size/npass), a_array_value(new_size/npass))
|
||||
|
||||
|
||||
allocate(l_pointer(l_start:l_end+1), value((i_max*k_max)) )
|
||||
@ -127,18 +133,18 @@ subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
!open(unit=10,file='OUTPUT',form='FORMATTED')
|
||||
! END INPUT DATA
|
||||
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) SHARED(a_array_ik,a_array_j,a_array_value, &
|
||||
!$OMP a_start,a_end,b_start,b_end,c_start,c_end,d_start,d_end,&
|
||||
!$OMP i_start,i_end,j_start,j_end,k_start,k_end,l_start,l_end,&
|
||||
!$OMP i_min,i_max,j_min,j_max,k_min,k_max,l_min,l_max, &
|
||||
!$OMP map_c,matrix_B,l_pointer) &
|
||||
!$OMP matrix_B,l_pointer,thread,task_id) &
|
||||
!$OMP PRIVATE(key,value,T,U,V,i,j,k,l,idx,ik,ll, &
|
||||
!$OMP a,b,c,d,tmp,T2d,V2d,ii)
|
||||
!$OMP a,b,c,d,p,q,tmp,T2d,V2d,ii,zmq_socket_push)
|
||||
allocate( key(i_max*j_max*k_max), value(i_max*j_max*k_max) )
|
||||
allocate( U(a_start:a_end, c_start:c_end, b_start:b_end) )
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_socket_push
|
||||
integer(ZMQ_PTR), external :: new_zmq_push_socket
|
||||
zmq_socket_push = new_zmq_push_socket(thread)
|
||||
|
||||
|
||||
@ -232,22 +238,27 @@ subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
enddo
|
||||
|
||||
idx = 0_8
|
||||
|
||||
integer :: p, q
|
||||
do b=b_start,d
|
||||
q = b+ishft(d*d-d,-1)
|
||||
do c=c_start,c_end
|
||||
p = a_start+ishft(c*c-c,-1)
|
||||
do a=a_start,min(b,c)
|
||||
if (dabs(U(a,c,b)) < 1.d-15) then
|
||||
cycle
|
||||
endif
|
||||
if ((a==b).and.(p>q)) cycle
|
||||
p = p+1
|
||||
idx = idx+1_8
|
||||
call bielec_integrals_index(a,b,c,d,key(idx))
|
||||
!print *, int(key(idx),4), int(a,2),int(b,2),int(c,2),int(d,2), p, q
|
||||
value(idx) = U(a,c,b)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!$OMP CRITICAL
|
||||
call four_idx_push_results(zmq_socket_push, key, value, idx, task_id)
|
||||
!$OMP END CRITICAL
|
||||
call four_idx_push_results(zmq_socket_push, key, value, idx, -task_id)
|
||||
|
||||
!WRITE OUTPUT
|
||||
! OMP CRITICAL
|
||||
@ -268,10 +279,13 @@ subroutine four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
|
||||
enddo
|
||||
!$OMP END DO
|
||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||
deallocate(key,value,V,T)
|
||||
!$OMP BARRIER
|
||||
!$OMP MASTER
|
||||
call four_idx_push_results(zmq_socket_push, 0_8, 0.d0, 0, task_id)
|
||||
!$OMP END MASTER
|
||||
call end_zmq_push_socket(zmq_socket_push)
|
||||
!$OMP END PARALLEL
|
||||
call map_merge(map_c)
|
||||
|
||||
deallocate(l_pointer)
|
||||
deallocate(a_array_ik,a_array_j,a_array_value)
|
||||
361
src/FourIdx/four_index_zmq.irp.f
Normal file
361
src/FourIdx/four_index_zmq.irp.f
Normal file
@ -0,0 +1,361 @@
|
||||
subroutine four_index_transform_zmq(map_a,map_c,matrix_B,LDB, &
|
||||
i_start, j_start, k_start, l_start, &
|
||||
i_end , j_end , k_end , l_end , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end )
|
||||
implicit none
|
||||
use f77_zmq
|
||||
use map_module
|
||||
BEGIN_DOC
|
||||
! Performs a four-index transformation of map_a(N^4) into map_c(M^4) using b(NxM)
|
||||
! C_{abcd} = \sum_{ijkl} A_{ijkl}.B_{ia}.B_{jb}.B_{kc}.B_{ld}
|
||||
! Loops run over *_start->*_end
|
||||
END_DOC
|
||||
type(map_type), intent(in) :: map_a
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer, intent(in) :: LDB
|
||||
double precision, intent(in) :: matrix_B(LDB,*)
|
||||
integer, intent(in) :: i_start, j_start, k_start, l_start
|
||||
integer, intent(in) :: i_end , j_end , k_end , l_end
|
||||
integer, intent(in) :: a_start, b_start, c_start, d_start
|
||||
integer, intent(in) :: a_end , b_end , c_end , d_end
|
||||
|
||||
double precision, allocatable :: T(:,:), U(:,:,:), V(:,:)
|
||||
double precision, allocatable :: T2d(:,:), V2d(:,:)
|
||||
integer :: i_max, j_max, k_max, l_max
|
||||
integer :: i_min, j_min, k_min, l_min
|
||||
integer :: i, j, k, l, ik, ll
|
||||
integer :: l_start_block, l_end_block, l_block
|
||||
integer :: a, b, c, d
|
||||
double precision, external :: get_ao_bielec_integral
|
||||
integer*8 :: ii
|
||||
integer(key_kind) :: idx
|
||||
real(integral_kind) :: tmp
|
||||
integer(key_kind), allocatable :: key(:)
|
||||
real(integral_kind), allocatable :: value(:)
|
||||
integer*8, allocatable :: l_pointer(:)
|
||||
|
||||
ASSERT (k_start == i_start)
|
||||
ASSERT (l_start == j_start)
|
||||
ASSERT (a_start == c_start)
|
||||
ASSERT (b_start == d_start)
|
||||
|
||||
i_min = min(i_start,a_start)
|
||||
i_max = max(i_end ,a_end )
|
||||
j_min = min(j_start,b_start)
|
||||
j_max = max(j_end ,b_end )
|
||||
k_min = min(k_start,c_start)
|
||||
k_max = max(k_end ,c_end )
|
||||
l_min = min(l_start,d_start)
|
||||
l_max = max(l_end ,d_end )
|
||||
|
||||
ASSERT (0 < i_max)
|
||||
ASSERT (0 < j_max)
|
||||
ASSERT (0 < k_max)
|
||||
ASSERT (0 < l_max)
|
||||
ASSERT (LDB >= i_max)
|
||||
ASSERT (LDB >= j_max)
|
||||
ASSERT (LDB >= k_max)
|
||||
ASSERT (LDB >= l_max)
|
||||
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR) :: zmq_socket_pull
|
||||
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'four_idx')
|
||||
|
||||
integer*8 :: new_size
|
||||
new_size = max(1024_8, 5_8 * map_a % n_elements )
|
||||
|
||||
integer :: npass
|
||||
integer*8 :: tempspace
|
||||
|
||||
tempspace = (new_size * 16_8) / (1024_8 * 1024_8)
|
||||
npass = int(min(int(l_end-l_start,8),1_8 + tempspace / 2048_8),4) ! 2 GiB of scratch space
|
||||
l_block = (l_end-l_start+1)/npass
|
||||
|
||||
! Create tasks
|
||||
! ============
|
||||
|
||||
character(len=256) :: task
|
||||
|
||||
integer, external :: add_task_to_taskserver
|
||||
|
||||
do l_start_block = l_start, l_end, l_block
|
||||
l_end_block = min(l_end, l_start_block+l_block-1)
|
||||
write(task,'(16(I10,X))') &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end
|
||||
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
|
||||
stop 'Unable to add task to server'
|
||||
endif
|
||||
enddo
|
||||
|
||||
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
|
||||
|
||||
|
||||
PROVIDE nproc
|
||||
|
||||
call omp_set_nested(.True.)
|
||||
integer :: ithread
|
||||
!$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
|
||||
ithread = omp_get_thread_num()
|
||||
if (ithread==0) then
|
||||
call four_idx_collector(zmq_socket_pull,map_c)
|
||||
else
|
||||
call four_index_transform_slave_inproc(ithread)
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'four_idx')
|
||||
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine four_index_transform_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 four_index_transform_slave(0,i)
|
||||
end
|
||||
|
||||
|
||||
subroutine four_index_transform_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 four_index_transform_slave(1,i)
|
||||
end
|
||||
|
||||
|
||||
|
||||
subroutine four_index_transform_slave(thread,worker_id)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
integer,intent(in) :: worker_id, thread
|
||||
integer :: task_id
|
||||
character*(512) :: msg
|
||||
|
||||
integer :: i_start, j_start, k_start, l_start_block
|
||||
integer :: i_end , j_end , k_end , l_end_block
|
||||
integer :: a_start, b_start, c_start, d_start
|
||||
integer :: a_end , b_end , c_end , d_end
|
||||
|
||||
integer, external :: get_task_from_taskserver
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
|
||||
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
|
||||
|
||||
do
|
||||
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then
|
||||
exit
|
||||
endif
|
||||
if(task_id == 0) exit
|
||||
read (msg,*) &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end
|
||||
|
||||
call four_index_transform_slave_work(ao_integrals_map, &
|
||||
mo_coef, size(mo_coef,1), &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end, &
|
||||
task_id, thread)
|
||||
|
||||
integer, external :: task_done_to_taskserver
|
||||
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
|
||||
print *, irp_here, ': Unable to send task_done'
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,thread) == -1) then
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
return
|
||||
endif
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
|
||||
end
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, nthreads_four_idx ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of threads for 4-index transformation
|
||||
END_DOC
|
||||
nthreads_four_idx = nproc
|
||||
character*(32) :: env
|
||||
call getenv('NTHREADS_FOUR_IDX',env)
|
||||
if (trim(env) /= '') then
|
||||
read(env,*) nthreads_four_idx
|
||||
endif
|
||||
call write_int(6,nthreads_four_idx,'Number of threads for 4-index transformation')
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
subroutine four_idx_collector(zmq_socket_pull,map_c)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||
|
||||
integer :: more
|
||||
integer, external :: zmq_delete_task
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
integer :: task_id
|
||||
|
||||
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
|
||||
more = 1
|
||||
do while (more == 1)
|
||||
call four_idx_pull_results(zmq_socket_pull, map_c, task_id)
|
||||
if (task_id > 0) then
|
||||
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
|
||||
stop 'Unable to delete task'
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine four_idx_pull_results(zmq_socket_pull, map_c, task_id)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer(ZMQ_PTR), intent(inout) :: zmq_socket_pull
|
||||
|
||||
integer, intent(out) :: task_id
|
||||
|
||||
integer :: rc, sze
|
||||
integer*8 :: rc8
|
||||
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||
if(rc /= 4) stop 'four_idx_pull_results failed to pull task_id'
|
||||
|
||||
if (task_id > 0) then
|
||||
IRP_IF ZMQ_PUSH
|
||||
IRP_ELSE
|
||||
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
||||
if (rc /= 2) then
|
||||
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
|
||||
stop 'error'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
call map_merge(map_c)
|
||||
return
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, sze, 4, 0)
|
||||
if(rc /= 4) stop 'four_idx_pull_results failed to pull sze'
|
||||
|
||||
integer(key_kind), allocatable :: key(:)
|
||||
real(integral_kind), allocatable :: value(:)
|
||||
|
||||
allocate(key(sze), value(sze))
|
||||
|
||||
rc8 = f77_zmq_recv8( zmq_socket_pull, key, int(key_kind*sze,8), 0)
|
||||
if(rc8 /= key_kind*sze) stop 'four_idx_pull_results failed to pull key'
|
||||
|
||||
rc8 = f77_zmq_recv8( zmq_socket_pull, value, int(integral_kind*sze,8), 0)
|
||||
if(rc8 /= integral_kind*sze) stop 'four_idx_pull_results failed to pull value'
|
||||
|
||||
call map_update(map_c, key, value, sze, mo_integrals_threshold)
|
||||
|
||||
! Activate if zmq_socket_pull is a REP
|
||||
IRP_IF ZMQ_PUSH
|
||||
IRP_ELSE
|
||||
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
||||
if (rc /= 2) then
|
||||
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
|
||||
stop 'error'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
deallocate(key, value)
|
||||
end
|
||||
|
||||
|
||||
|
||||
subroutine four_idx_push_results(zmq_socket_push, key, value, sze, task_id)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
integer, intent(in) :: sze
|
||||
integer(key_kind), intent(in) :: key(sze)
|
||||
real(integral_kind), intent(in) :: value(sze)
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||
integer, intent(in) :: task_id
|
||||
|
||||
integer :: rc
|
||||
integer*8 :: rc8
|
||||
|
||||
|
||||
if (task_id > 0) then
|
||||
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
|
||||
if(rc /= 4) stop 'four_idx_push_results failed to push task_id'
|
||||
else
|
||||
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop 'four_idx_push_results failed to push task_id'
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, sze, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop 'four_idx_push_results failed to push sze'
|
||||
|
||||
rc8 = f77_zmq_send8( zmq_socket_push, key, int(key_kind*sze,8), ZMQ_SNDMORE)
|
||||
if(rc8 /= key_kind*sze) then
|
||||
print *, sze, key_kind, rc8
|
||||
stop 'four_idx_push_results failed to push key'
|
||||
endif
|
||||
|
||||
rc8 = f77_zmq_send8( zmq_socket_push, value, int(integral_kind*sze,8), 0)
|
||||
if(rc8 /= integral_kind*sze) then
|
||||
print *, sze, integral_kind, rc8
|
||||
stop 'four_idx_push_results failed to push value'
|
||||
endif
|
||||
endif
|
||||
|
||||
|
||||
! Activate if zmq_socket_push is a REP
|
||||
IRP_IF ZMQ_PUSH
|
||||
IRP_ELSE
|
||||
character*(2) :: reply
|
||||
rc = f77_zmq_recv( zmq_socket_push, reply, 2, 0)
|
||||
if (reply(1:2) /= 'ok') then
|
||||
print *, reply(1:rc)
|
||||
print *, irp_here, ' : f77_zmq_send (zmq_socket_push,...'
|
||||
stop 'error'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
|
||||
@ -1,273 +0,0 @@
|
||||
subroutine four_index_transform_zmq(map_a,map_c,matrix_B,LDB, &
|
||||
i_start, j_start, k_start, l_start, &
|
||||
i_end , j_end , k_end , l_end , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end )
|
||||
implicit none
|
||||
use f77_zmq
|
||||
use map_module
|
||||
BEGIN_DOC
|
||||
! Performs a four-index transformation of map_a(N^4) into map_c(M^4) using b(NxM)
|
||||
! C_{abcd} = \sum_{ijkl} A_{ijkl}.B_{ia}.B_{jb}.B_{kc}.B_{ld}
|
||||
! Loops run over *_start->*_end
|
||||
END_DOC
|
||||
type(map_type), intent(in) :: map_a
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer, intent(in) :: LDB
|
||||
double precision, intent(in) :: matrix_B(LDB,*)
|
||||
integer, intent(in) :: i_start, j_start, k_start, l_start
|
||||
integer, intent(in) :: i_end , j_end , k_end , l_end
|
||||
integer, intent(in) :: a_start, b_start, c_start, d_start
|
||||
integer, intent(in) :: a_end , b_end , c_end , d_end
|
||||
|
||||
double precision, allocatable :: T(:,:), U(:,:,:), V(:,:)
|
||||
double precision, allocatable :: T2d(:,:), V2d(:,:)
|
||||
integer :: i_max, j_max, k_max, l_max
|
||||
integer :: i_min, j_min, k_min, l_min
|
||||
integer :: i, j, k, l, ik, ll
|
||||
integer :: l_start_block, l_end_block, l_block
|
||||
integer :: a, b, c, d
|
||||
double precision, external :: get_ao_bielec_integral
|
||||
integer*8 :: ii
|
||||
integer(key_kind) :: idx
|
||||
real(integral_kind) :: tmp
|
||||
integer(key_kind), allocatable :: key(:)
|
||||
real(integral_kind), allocatable :: value(:)
|
||||
integer*8, allocatable :: l_pointer(:)
|
||||
|
||||
ASSERT (k_start == i_start)
|
||||
ASSERT (l_start == j_start)
|
||||
ASSERT (a_start == c_start)
|
||||
ASSERT (b_start == d_start)
|
||||
|
||||
i_min = min(i_start,a_start)
|
||||
i_max = max(i_end ,a_end )
|
||||
j_min = min(j_start,b_start)
|
||||
j_max = max(j_end ,b_end )
|
||||
k_min = min(k_start,c_start)
|
||||
k_max = max(k_end ,c_end )
|
||||
l_min = min(l_start,d_start)
|
||||
l_max = max(l_end ,d_end )
|
||||
|
||||
ASSERT (0 < i_max)
|
||||
ASSERT (0 < j_max)
|
||||
ASSERT (0 < k_max)
|
||||
ASSERT (0 < l_max)
|
||||
ASSERT (LDB >= i_max)
|
||||
ASSERT (LDB >= j_max)
|
||||
ASSERT (LDB >= k_max)
|
||||
ASSERT (LDB >= l_max)
|
||||
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
call new_parallel_job(zmq_to_qp_run_socket,'four_idx')
|
||||
|
||||
integer*8 :: new_size
|
||||
new_size = max(1024_8, 5_8 * map_a % n_elements )
|
||||
|
||||
integer :: npass
|
||||
integer*8 :: tempspace
|
||||
|
||||
tempspace = (new_size * 14_8) / (1024_8 * 1024_8)
|
||||
npass = min(l_end-l_start,1 + tempspace / 2048) ! 2 GiB of scratch space
|
||||
l_block = (l_end-l_start)/npass
|
||||
|
||||
! Create tasks
|
||||
! ============
|
||||
|
||||
character(len=64), allocatable :: task
|
||||
|
||||
do l_start_block = l_start, l_end, l_block
|
||||
l_end_block = min(l_end, l_start_block+l_block-1)
|
||||
write(task,'I10,X,I10') l_start_block, l_end_block
|
||||
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task))
|
||||
enddo
|
||||
|
||||
call zmq_set_running(zmq_to_qp_run_socket)
|
||||
|
||||
PROVIDE nproc
|
||||
|
||||
call omp_set_nested(.True.)
|
||||
integer :: ithread
|
||||
!$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
|
||||
ithread = omp_get_thread_num()
|
||||
if (ithread==0) then
|
||||
call four_idx_collector(zmq_to_qp_run_socket,map_c)
|
||||
else
|
||||
!TODO : Put strings of map_a and matrix_b on server and broadcast
|
||||
call four_index_transform_slave_inproc(map_a,map_c,matrix_B,LDB, &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end, 1 )
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call end_parallel_job(zmq_to_qp_run_socket, 'four_idx')
|
||||
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine four_idx_slave_work(zmq_to_qp_run_socket, worker_id)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
|
||||
integer(ZMQ_PTR),intent(in) :: zmq_to_qp_run_socket
|
||||
integer,intent(in) :: worker_id
|
||||
integer :: task_id
|
||||
character*(512) :: msg
|
||||
|
||||
integer :: i_start, j_start, k_start, l_start_block
|
||||
integer :: i_end , j_end , k_end , l_end_block
|
||||
integer :: a_start, b_start, c_start, d_start
|
||||
integer :: a_end , b_end , c_end , d_end
|
||||
|
||||
!TODO : get map_a and matrix_B from server
|
||||
do
|
||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg)
|
||||
if(task_id == 0) exit
|
||||
read (msg,*) LDB, &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end
|
||||
|
||||
call four_index_transform_slave(map_a,map_c,matrix_B,LDB, &
|
||||
i_start, j_start, k_start, l_start_block, &
|
||||
i_end , j_end , k_end , l_end_block , &
|
||||
a_start, b_start, c_start, d_start, &
|
||||
a_end , b_end , c_end , d_end, zmq_to_qp_run_socket, &
|
||||
task_id)
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||
|
||||
enddo
|
||||
end
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, nthreads_four_idx ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of threads for 4-index transformation
|
||||
END_DOC
|
||||
nthreads_four_idx = nproc
|
||||
character*(32) :: env
|
||||
call getenv('NTHREADS_FOUR_IDX',env)
|
||||
if (trim(env) /= '') then
|
||||
read(env,*) nthreads_four_idx
|
||||
endif
|
||||
call write_int(6,nthreads_davidson,'Number of threads for 4-index transformation')
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
subroutine four_idx_collector(zmq_to_qp_run_socket,map_c)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
type(map_type), intent(inout) :: map_c
|
||||
|
||||
integer :: more
|
||||
integer(ZMQ_PTR), external :: new_zmq_pull_socket
|
||||
integer(ZMQ_PTR) :: zmq_socket_pull
|
||||
|
||||
|
||||
more = 1
|
||||
zmq_socket_pull = new_zmq_pull_socket()
|
||||
|
||||
do while (more == 1)
|
||||
call four_idx_pull_results(zmq_socket_pull, map_c, task_id)
|
||||
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
|
||||
enddo
|
||||
|
||||
call end_zmq_pull_socket(zmq_socket_pull)
|
||||
|
||||
end
|
||||
|
||||
|
||||
subroutine four_idx_pull_results(zmq_socket_pull, map_c, task_id)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
type(map_type), intent(inout) :: map_c
|
||||
integer(ZMQ_PTR), intent(inout) :: zmq_socket_pull
|
||||
|
||||
integer, intent(out) :: task_id
|
||||
|
||||
integer :: rc, sze
|
||||
integer*8 :: rc8
|
||||
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||
if(rc /= 4) stop "four_idx_pull_results failed to pull task_id"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, sze, 4, 0)
|
||||
if(rc /= 4) stop "four_idx_pull_results failed to pull sze"
|
||||
|
||||
integer(key_kind), allocatable :: key(:)
|
||||
real(integral_kind), allocatable :: value(:)
|
||||
|
||||
allocate(key(sze), value(sze))
|
||||
|
||||
rc8 = f77_zmq_recv8( zmq_socket_pull, key, key_kind*sze, 0)
|
||||
if(rc8 /= key_kind*sze) stop "four_idx_pull_results failed to pull key"
|
||||
|
||||
rc8 = f77_zmq_recv8( zmq_socket_pull, value, integral_kind*sze, 0)
|
||||
if(rc8 /= integral_kind*sze) stop "four_idx_pull_results failed to pull value"
|
||||
|
||||
! Activate if zmq_socket_pull is a REP
|
||||
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 map_update(map_c, key, value, sze, 1.d-15) ! TODO : threshold
|
||||
|
||||
deallocate(key, value)
|
||||
end
|
||||
|
||||
|
||||
|
||||
subroutine four_idx_push_results(zmq_socket_push, key, value, sze, task_id)
|
||||
use f77_zmq
|
||||
use map_module
|
||||
implicit none
|
||||
integer, intent(in) :: sze
|
||||
integer(key_kind), intent(in) :: key(sze)
|
||||
real(integral_kind), intent(in) :: value(sze)
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||
integer, intent(in) :: task_id
|
||||
|
||||
integer :: rc, sze
|
||||
integer*8 :: rc8
|
||||
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop "four_idx_push_results failed to push task_id"
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, sze, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop "four_idx_push_results failed to push sze"
|
||||
|
||||
rc8 = f77_zmq_send8( zmq_socket_push, key, key_kind*sze, ZMQ_SNDMORE)
|
||||
if(rc8 /= key_kind*sze) stop "four_idx_push_results failed to push key"
|
||||
|
||||
rc8 = f77_zmq_send8( zmq_socket_push, value, integral_kind*sze, 0)
|
||||
if(rc8 /= integral_kind*sze) stop "four_idx_push_results failed to push value"
|
||||
|
||||
! Activate if zmq_socket_push is a REP
|
||||
IRP_IF ZMQ_PUSH
|
||||
IRP_ELSE
|
||||
rc = f77_zmq_send( zmq_socket_push, 0, 4, 0)
|
||||
if (rc /= 4) then
|
||||
print *, irp_here, ' : f77_zmq_send (zmq_socket_push,...'
|
||||
stop 'error'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
|
||||
@ -126,7 +126,7 @@ subroutine ao_bielec_integrals_in_map_slave(thread,iproc)
|
||||
enddo
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
continue
|
||||
endif
|
||||
deallocate( buffer_i, buffer_value )
|
||||
|
||||
@ -119,11 +119,16 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
|
||||
else
|
||||
! call add_integrals_to_map(full_ijkl_bitmask_4)
|
||||
|
||||
call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
|
||||
call four_index_transform_zmq(ao_integrals_map,mo_integrals_map, &
|
||||
mo_coef, size(mo_coef,1), &
|
||||
1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
|
||||
1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num)
|
||||
!
|
||||
! call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
|
||||
! mo_coef, size(mo_coef,1), &
|
||||
! 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
|
||||
! 1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num)
|
||||
!
|
||||
! call four_index_transform(ao_integrals_map,mo_integrals_map, &
|
||||
! mo_coef, size(mo_coef,1), &
|
||||
! 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
|
||||
|
||||
@ -691,15 +691,13 @@ integer function connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||
connect_to_taskserver = -1
|
||||
end
|
||||
|
||||
integer function disconnect_from_taskserver(zmq_to_qp_run_socket, &
|
||||
zmq_socket_push, worker_id)
|
||||
integer function disconnect_from_taskserver(zmq_to_qp_run_socket, worker_id)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Disconnect from the task server
|
||||
END_DOC
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||
integer, intent(in) :: worker_id
|
||||
|
||||
integer :: rc, sze
|
||||
|
||||
Loading…
Reference in New Issue
Block a user