LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-23 11:17:33 +02:00
Code Issues Releases Wiki Activity

parallel bug

Browse Source
This commit is contained in:
Yann Garniron 2018-08-30 15:24:07 +02:00
parent 2a6c1941d4
commit a254fdd7cf
3 changed files with 33 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -233,7 +233,6 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, absolute_error, pt2
end do end do
end if end if
end do end do
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end subroutine end subroutine

57
plugins/dress_zmq/dress_stoch_routines.irp.f
View File

@ -27,22 +27,10 @@ BEGIN_PROVIDER [ integer, dress_N_cp_max ]
dress_N_cp_max = 100 dress_N_cp_max = 100
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)]
implicit none
integer :: i
do i=1,dress_N_cp_max-1
dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1)
end do
dress_M_m(1) = 1
dress_M_m(dress_N_cp_max) = N_det_generators+1
END_PROVIDER
BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)]
&BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
&BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] &BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
&BEGIN_PROVIDER[ integer, dress_R, (0:N_det_generators)]
&BEGIN_PROVIDER[ integer, dress_R1, (0:N_det_generators)] &BEGIN_PROVIDER[ integer, dress_R1, (0:N_det_generators)]
&BEGIN_PROVIDER[ double precision, dress_M_mi, (dress_N_cp_max, N_det_generators+1)] &BEGIN_PROVIDER[ double precision, dress_M_mi, (dress_N_cp_max, N_det_generators+1)]
&BEGIN_PROVIDER [ integer, dress_P, (N_det_generators) ] &BEGIN_PROVIDER [ integer, dress_P, (N_det_generators) ]
@ -59,12 +47,17 @@ END_PROVIDER
dress_M_mi = 0d0 dress_M_mi = 0d0
tilde_M = 0d0 tilde_M = 0d0
dress_R(:) = 0
dress_R1(:) = 0 dress_R1(:) = 0
N_c = 0 N_c = 0
N_j = pt2_n_0(1) N_j = pt2_n_0(1)
d(:) = .false. d(:) = .false.
do i=1,dress_N_cp_max-1
dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1)
end do
dress_M_m(1) = 1
dress_M_m(dress_N_cp_max) = N_det_generators+1
do i=1,N_j do i=1,N_j
d(i) = .true. d(i) = .true.
pt2_J(i) = i pt2_J(i) = i
@ -103,7 +96,6 @@ END_PROVIDER
if(N_c == dress_M_m(m)) then if(N_c == dress_M_m(m)) then
dress_R1(m) = N_j dress_R1(m) = N_j
dress_R(N_j) = N_c
dress_M_mi(m, :N_det_generators) = tilde_M(:) dress_M_mi(m, :N_det_generators) = tilde_M(:)
m += 1 m += 1
end if end if
@ -111,7 +103,7 @@ END_PROVIDER
dress_N_cp = m-1 dress_N_cp = m-1
dress_R1(dress_N_cp) = N_j dress_R1(dress_N_cp) = N_j
dress_M_m(dress_N_cp) = N_c
!!!!!!!!!!!!!! !!!!!!!!!!!!!!
do m=1,dress_N_cp do m=1,dress_N_cp
do i=dress_R1(m-1)+1, dress_R1(m) do i=dress_R1(m-1)+1, dress_R1(m)
@ -263,6 +255,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
!!$OMP END PARALLEL !!$OMP END PARALLEL
delta_out(dress_stoch_istate,1:N_det) = delta(dress_stoch_istate,1:N_det) delta_out(dress_stoch_istate,1:N_det) = delta(dress_stoch_istate,1:N_det)
delta_s2_out(dress_stoch_istate,1:N_det) = delta_s2(dress_stoch_istate,1:N_det) delta_s2_out(dress_stoch_istate,1:N_det) = delta_s2(dress_stoch_istate,1:N_det)
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress')
print *, '========== ================= ================= =================' print *, '========== ================= ================= ================='
@ -401,25 +394,23 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
S2(p) += x**2 S2(p) += x**2
end do end do
end do end do
t = dress_dot_t(m) t = dress_dot_t(m)
avg = S(t) / dble(c) avg = S(t) / dble(c)
eqt = (S2(t) / c) - (S(t)/c)**2 eqt = (S2(t) / c) - (S(t)/c)**2
eqt = sqrt(eqt / dble(c-1)) eqt = sqrt(eqt / dble(c-1))
error = eqt error = eqt
time = omp_get_wtime() time = omp_get_wtime()
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, '' print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0, eqt, time-time0, ''
m += 1 m += 1
if(eqt <= relative_error) then if(eqt <= 0d0*relative_error) then
print *, "ABORT" if (zmq_abort(zmq_to_qp_run_socket) == -1) then
call sleep(1)
if (zmq_abort(zmq_to_qp_run_socket) == -1) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then
call sleep(1) print *, irp_here, ': Error in sending abort signal (2)'
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Error in sending abort signal (2)'
endif
endif endif
end if endif
end if
else else
task_id = 0
do do
call pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks) call pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks)
if(task_id == 0) exit if(task_id == 0) exit

24
plugins/dress_zmq/run_dress_slave.irp.f
View File

@ -46,7 +46,7 @@ subroutine run_dress_slave(thread,iproce,energy)
edI = 0d0 edI = 0d0
f = 0 f = 0
delta_det = 0d9 delta_det = 0d0
cp = 0d0 cp = 0d0
task(:) = CHAR(0) task(:) = CHAR(0)
@ -64,14 +64,13 @@ subroutine run_dress_slave(thread,iproce,energy)
will_send = 0 will_send = 0
double precision :: hij, sij, tmp double precision :: hij, sij, tmp
!call i_h_j_s2(psi_det(1,1,1),psi_det(1,1,2),N_int,hij, sij)
hij = E0_denominator(1) !PROVIDE BEFORE OMP PARALLEL hij = E0_denominator(1) !PROVIDE BEFORE OMP PARALLEL
!$OMP PARALLEL DEFAULT(SHARED) & !$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(breve_delta_m, task, task_id) & !$OMP PRIVATE(breve_delta_m, task, task_id) &
!$OMP PRIVATE(fac,m) & !$OMP PRIVATE(tmp,fac,m,l,t,sum_f,n_tasks) &
!$OMP PRIVATE(i, will_send, i_generator, subset, iproc) & !$OMP PRIVATE(i,p,will_send, i_generator, subset, iproc) &
!$OMP PRIVATE(zmq_to_qp_run_socket, zmq_socket_push, worker_id) !$OMP PRIVATE(zmq_to_qp_run_socket, zmq_socket_push, worker_id)
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
@ -117,15 +116,13 @@ subroutine run_dress_slave(thread,iproce,energy)
breve_delta_m(:,:,2) += cp(:,:,l,2) breve_delta_m(:,:,2) += cp(:,:,l,2)
end do end do
breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send) !/ cps_N(cur_cp) breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send)
do t=dress_dot_t(will_send)-1,0,-1 do t=dress_dot_t(will_send)-1,0,-1
breve_delta_m(:,:,1) = breve_delta_m(:,:,1) + delta_det(:,:,t,1) breve_delta_m(:,:,1) = breve_delta_m(:,:,1) + delta_det(:,:,t,1)
breve_delta_m(:,:,2) = breve_delta_m(:,:,2) + delta_det(:,:,t,2) breve_delta_m(:,:,2) = breve_delta_m(:,:,2) + delta_det(:,:,t,2)
end do end do
call omp_set_lock(sending) call omp_set_lock(sending)
n_tasks = 0 n_tasks = 0
sum_f = 0 sum_f = 0
@ -137,7 +134,6 @@ subroutine run_dress_slave(thread,iproce,energy)
sum_f += f(i) sum_f += f(i)
end if end if
end do end do
!!!!call pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks)
call push_dress_results(zmq_socket_push, will_send, sum_f, edI_task, edI_index, breve_delta_m, 0, n_tasks) call push_dress_results(zmq_socket_push, will_send, sum_f, edI_task, edI_index, breve_delta_m, 0, n_tasks)
call omp_unset_lock(sending) call omp_unset_lock(sending)
end if end if
@ -145,11 +141,9 @@ subroutine run_dress_slave(thread,iproce,energy)
if(m /= dress_N_cp+1) then if(m /= dress_N_cp+1) then
!UPDATE i_generator !UPDATE i_generator
breve_delta_m(:,:,:) = 0d0 breve_delta_m(:,:,:) = 0d0
call generator_start(i_generator, iproc) call generator_start(i_generator, iproc)
call alpha_callback(breve_delta_m, i_generator, subset, pt2_F(i_generator)*0 + 1, iproc) call alpha_callback(breve_delta_m, i_generator, subset, pt2_F(i_generator)*0 + 1, iproc)
t = dress_T(i_generator) t = dress_T(i_generator)
@ -159,9 +153,9 @@ subroutine run_dress_slave(thread,iproce,energy)
delta_det(:,:,t, 2) += breve_delta_m(:,:,2) delta_det(:,:,t, 2) += breve_delta_m(:,:,2)
call omp_unset_lock(lck_det(t)) call omp_unset_lock(lck_det(t))
do p=1,dress_N_cp ! m, dress_N_cp do p=1,dress_N_cp
if(dress_e(i_generator, p) /= 0) then if(dress_e(i_generator, p) /= 0d0) then
fac = dress_e(i_generator, p) * pt2_W_T / pt2_w(i_generator) fac = dress_e(i_generator, p)
call omp_set_lock(lck_sto(p)) call omp_set_lock(lck_sto(p))
cp(:,:,p,1) += breve_delta_m(:,:,1) * fac cp(:,:,p,1) += breve_delta_m(:,:,1) * fac
cp(:,:,p,2) += breve_delta_m(:,:,2) * fac cp(:,:,p,2) += breve_delta_m(:,:,2) * fac
@ -170,11 +164,11 @@ subroutine run_dress_slave(thread,iproce,energy)
end do end do
tmp = 0d0 tmp = 0d0
do i=1,N_det do i=N_det,1,-1
tmp += psi_coef(i, dress_stoch_istate)*breve_delta_m(dress_stoch_istate, i, 1) tmp += psi_coef(i, dress_stoch_istate)*breve_delta_m(dress_stoch_istate, i, 1)
end do end do
!$OMP ATOMIC !$OMP ATOMIC
edI(i_generator) += tmp! dot_product(psi_det_coef(:, dress_stoch_istate), breve_delta_m(dress_stoch_istate, :, 1)) edI(i_generator) += tmp
!$OMP ATOMIC !$OMP ATOMIC
f(i_generator) += 1 f(i_generator) += 1
!push bidon !push bidon