mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-26 14:31:44 +02:00
shifted-bk selection iterates
This commit is contained in:
parent
9823fed7be
commit
7cc33f1ab3
@ -56,7 +56,6 @@ subroutine run_wf
|
|||||||
! call dress_slave_tcp(i+1, energy)
|
! call dress_slave_tcp(i+1, energy)
|
||||||
call dress_slave_tcp(0, energy)
|
call dress_slave_tcp(0, energy)
|
||||||
!!$OMP END PARALLEL
|
!!$OMP END PARALLEL
|
||||||
print *, 'dress done'
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
@ -122,14 +122,6 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
|
|||||||
block(block_i) = dress_jobs(i)
|
block(block_i) = dress_jobs(i)
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
print *, "ACTUAL TASK NUM", ntas
|
|
||||||
!stop
|
|
||||||
|
|
||||||
!if (ipos > 1) then
|
|
||||||
! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
|
|
||||||
! stop 'Unable to add task to task server'
|
|
||||||
! endif
|
|
||||||
!endif
|
|
||||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
print *, irp_here, ': Failed in zmq_set_running'
|
print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
endif
|
||||||
@ -196,7 +188,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
double precision, save :: time0 = -1.d0
|
double precision, save :: time0 = -1.d0
|
||||||
double precision :: time
|
double precision :: time
|
||||||
double precision, external :: omp_get_wtime
|
double precision, external :: omp_get_wtime
|
||||||
integer :: cur_cp
|
integer :: cur_cp, last_cp
|
||||||
integer :: delta_loc_cur, is, N_buf(3)
|
integer :: delta_loc_cur, is, N_buf(3)
|
||||||
integer, allocatable :: int_buf(:), agreg_for_cp(:)
|
integer, allocatable :: int_buf(:), agreg_for_cp(:)
|
||||||
double precision, allocatable :: double_buf(:)
|
double precision, allocatable :: double_buf(:)
|
||||||
@ -222,8 +214,6 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
call wall_time(time0)
|
call wall_time(time0)
|
||||||
endif
|
endif
|
||||||
logical :: loop, floop
|
logical :: loop, floop
|
||||||
integer :: finalcp
|
|
||||||
finalcp = N_cp*2
|
|
||||||
|
|
||||||
floop = .true.
|
floop = .true.
|
||||||
loop = .true.
|
loop = .true.
|
||||||
@ -232,29 +222,23 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
call pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, dress_mwen)
|
call pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, dress_mwen)
|
||||||
if(floop) then
|
if(floop) then
|
||||||
call wall_time(time)
|
call wall_time(time)
|
||||||
print *, "FIRST PULL", time-time0
|
|
||||||
time0 = time
|
time0 = time
|
||||||
floop = .false.
|
floop = .false.
|
||||||
end if
|
end if
|
||||||
if(cur_cp == -1 .and. ind == N_det_generators) then
|
if(cur_cp == -1 .and. ind == N_det_generators) then
|
||||||
call wall_time(time)
|
call wall_time(time)
|
||||||
print *, "FINISHED_CPL", N_cp-1, time-time0
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
|
||||||
if(cur_cp == -1) then
|
if(cur_cp == -1) then
|
||||||
!print *, "TASK DEL", task_id
|
|
||||||
call dress_pulled(ind, int_buf, double_buf, det_buf, N_buf)
|
call dress_pulled(ind, int_buf, double_buf, det_buf, N_buf)
|
||||||
if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,1,more) == -1) then
|
if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,1,more) == -1) then
|
||||||
print *, "TASK ID", task_id
|
|
||||||
stop 'Unable to delete tasks'
|
stop 'Unable to delete tasks'
|
||||||
endif
|
endif
|
||||||
!if(more == 0) stop 'loop = .false.' !!!!!!!!!!!!!!!!
|
if(more == 0) loop = .false. !stop 'loop = .false.' !!!!!!!!!!!!!!!!
|
||||||
dress_detail(:, ind) = dress_mwen(:)
|
dress_detail(:, ind) = dress_mwen(:)
|
||||||
else if(cur_cp > 0) then
|
else if(cur_cp > 0) then
|
||||||
|
|
||||||
if(ind == 0) cycle
|
if(ind == 0) cycle
|
||||||
|
|
||||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i)
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
cp(:,i,cur_cp,1) += delta_loc(:,i,1)
|
cp(:,i,cur_cp,1) += delta_loc(:,i,1)
|
||||||
@ -273,8 +257,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
|
|
||||||
call wall_time(time)
|
call wall_time(time)
|
||||||
|
|
||||||
print *, "FINISHED_CP", cur_cp, time-time0
|
last_cp = cur_cp
|
||||||
|
|
||||||
double precision :: su, su2, eqt, avg, E0, val
|
double precision :: su, su2, eqt, avg, E0, val
|
||||||
integer, external :: zmq_abort
|
integer, external :: zmq_abort
|
||||||
|
|
||||||
@ -296,7 +279,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, ''
|
print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, ''
|
||||||
if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. cur_cp == N_cp) then
|
if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. cur_cp == cur_cp-2) then
|
||||||
! Termination
|
! Termination
|
||||||
print *, "TERMINATE"
|
print *, "TERMINATE"
|
||||||
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
||||||
@ -305,18 +288,14 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
print *, irp_here, ': Error in sending abort signal (2)'
|
print *, irp_here, ': Error in sending abort signal (2)'
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
exit pullLoop
|
|
||||||
endif
|
endif
|
||||||
end if
|
end if
|
||||||
end do pullLoop
|
end do pullLoop
|
||||||
print *, "exited"
|
|
||||||
|
|
||||||
|
delta(:,:) = cp(:,:,last_cp,1)
|
||||||
|
delta_s2(:,:) = cp(:,:,last_cp,2)
|
||||||
|
|
||||||
delta(:,:) = cp(:,:,cur_cp,1)
|
dress(istate) = E(istate)+E0+avg
|
||||||
delta_s2(:,:) = cp(:,:,cur_cp,2)
|
|
||||||
|
|
||||||
|
|
||||||
dress(istate) = E(istate)+E0
|
|
||||||
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
|
||||||
|
|
||||||
@ -405,13 +384,11 @@ END_PROVIDER
|
|||||||
|
|
||||||
integer :: fragsize
|
integer :: fragsize
|
||||||
fragsize = N_det_generators / ((N_cps_max-1+1)*(N_cps_max-1+2)/2)
|
fragsize = N_det_generators / ((N_cps_max-1+1)*(N_cps_max-1+2)/2)
|
||||||
print *, "FRAGSIZE", fragsize
|
|
||||||
|
|
||||||
do i=1,N_cps_max
|
do i=1,N_cps_max
|
||||||
cp_limit(i) = fragsize * i * (i+1) / 2
|
cp_limit(i) = fragsize * i * (i+1) / 2
|
||||||
end do
|
end do
|
||||||
cp_limit(N_cps_max) = N_det*2
|
cp_limit(N_cps_max) = N_det*2
|
||||||
print *, "CP_LIMIT", cp_limit
|
|
||||||
|
|
||||||
N_dress_jobs = first_det_of_comb - 1
|
N_dress_jobs = first_det_of_comb - 1
|
||||||
do i=1, N_dress_jobs
|
do i=1, N_dress_jobs
|
||||||
@ -420,7 +397,7 @@ END_PROVIDER
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
l=first_det_of_comb
|
l=first_det_of_comb
|
||||||
call random_seed(put=(/321,654,65,321,65/))
|
call random_seed(put=(/321,654,65,321,65,321,654,65,321,65321,654,65,321,65321,654,65,321,65321,654,65,321,65/))
|
||||||
call RANDOM_NUMBER(comb)
|
call RANDOM_NUMBER(comb)
|
||||||
lfiller = 1
|
lfiller = 1
|
||||||
nfiller = 1
|
nfiller = 1
|
||||||
@ -432,7 +409,6 @@ END_PROVIDER
|
|||||||
|
|
||||||
!if(N_dress_jobs / gen_per_cp > (cur_cp-1) .or. N_dress_jobs == N_det_generators) then
|
!if(N_dress_jobs / gen_per_cp > (cur_cp-1) .or. N_dress_jobs == N_det_generators) then
|
||||||
if(N_dress_jobs > cp_limit(cur_cp) .or. N_dress_jobs == N_det_generators) then
|
if(N_dress_jobs > cp_limit(cur_cp) .or. N_dress_jobs == N_det_generators) then
|
||||||
print *, "END CUR_CP", cur_cp, N_dress_jobs
|
|
||||||
first_cp(cur_cp+1) = N_dress_jobs
|
first_cp(cur_cp+1) = N_dress_jobs
|
||||||
done_cp_at(N_dress_jobs) = cur_cp
|
done_cp_at(N_dress_jobs) = cur_cp
|
||||||
cps_N(cur_cp) = dfloat(i)
|
cps_N(cur_cp) = dfloat(i)
|
||||||
|
@ -100,7 +100,7 @@ BEGIN_PROVIDER [ double precision, delta_ij_tmp, (N_states,N_det_delta_ij,2) ]
|
|||||||
! else
|
! else
|
||||||
! errr = 1d-4
|
! errr = 1d-4
|
||||||
! end if
|
! end if
|
||||||
relative_error = 0d0! 1.d-5
|
relative_error = 1.d-5
|
||||||
|
|
||||||
call write_double(6,relative_error,"Convergence of the stochastic algorithm")
|
call write_double(6,relative_error,"Convergence of the stochastic algorithm")
|
||||||
|
|
||||||
|
@ -9,14 +9,16 @@
|
|||||||
integer :: i,ii,k,j, l
|
integer :: i,ii,k,j, l
|
||||||
double precision :: f, tmp
|
double precision :: f, tmp
|
||||||
double precision, external :: u_dot_v
|
double precision, external :: u_dot_v
|
||||||
|
logical, external :: detEq
|
||||||
|
|
||||||
dressing_column_h(:,:) = 0.d0
|
dressing_column_h(:,:) = 0.d0
|
||||||
dressing_column_s(:,:) = 0.d0
|
dressing_column_s(:,:) = 0.d0
|
||||||
|
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do j = 1, n_det
|
do j = 1, n_det
|
||||||
dressing_column_h(j,k) = delta_ij(k,j,1)
|
dressing_column_h(j,k) = delta_ij(k,j,1)
|
||||||
dressing_column_s(j,k) = delta_ij(k,j,2)
|
dressing_column_s(j,k) = delta_ij(k,j,2)
|
||||||
|
! print *, j, delta_ij(k,j,:)
|
||||||
enddo
|
enddo
|
||||||
! tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) &
|
! tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) &
|
||||||
! - dressing_column_h(l,k) * psi_coef(l,k)
|
! - dressing_column_h(l,k) * psi_coef(l,k)
|
||||||
@ -25,6 +27,5 @@
|
|||||||
! - dressing_column_s(l,k) * psi_coef(l,k)
|
! - dressing_column_s(l,k) * psi_coef(l,k)
|
||||||
! dressing_column_s(l,k) -= tmp * f
|
! dressing_column_s(l,k) -= tmp * f
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -81,8 +81,10 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
done_for = 0
|
done_for = 0
|
||||||
|
|
||||||
double precision :: hij, sij
|
double precision :: hij, sij
|
||||||
call i_h_j_s2(psi_det(1,1,1),psi_det(1,1,2),N_int,hij, sij)
|
!call i_h_j_s2(psi_det(1,1,1),psi_det(1,1,2),N_int,hij, sij)
|
||||||
print *, E0_denominator(1)
|
|
||||||
|
hij = E0_denominator(1) !PROVIDE BEFORE OMP PARALLEL
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(SHARED) &
|
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||||
!$OMP PRIVATE(int_buf, double_buf, det_buf, delta_ij_loc, task, task_id) &
|
!$OMP PRIVATE(int_buf, double_buf, det_buf, delta_ij_loc, task, task_id) &
|
||||||
!$OMP PRIVATE(lastSendable, toothMwen, fracted, fac) &
|
!$OMP PRIVATE(lastSendable, toothMwen, fracted, fac) &
|
||||||
@ -93,7 +95,6 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
zmq_socket_push = new_zmq_push_socket(thread)
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
if(worker_id == -1) then
|
if(worker_id == -1) then
|
||||||
print *, "WORKER -1"
|
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
stop "WORKER -1"
|
stop "WORKER -1"
|
||||||
@ -106,18 +107,54 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
allocate(det_buf(N_int, 2, N_dress_det_buffer))
|
allocate(det_buf(N_int, 2, N_dress_det_buffer))
|
||||||
allocate(delta_ij_loc(N_states,N_det,2))
|
allocate(delta_ij_loc(N_states,N_det,2))
|
||||||
do
|
do
|
||||||
!!1$OMP CRITICAL (SENDAGE)
|
|
||||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
||||||
!!1$OMP END CRITICAL (SENDAGE)
|
|
||||||
task = task//" 0"
|
task = task//" 0"
|
||||||
if(task_id == 0) then
|
if(task_id == 0) exit
|
||||||
print *, "DONEDONE"
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
exit !! LAST MESSAGE ???
|
if(task_id /= 0) then
|
||||||
|
read (task,*) subset, i_generator
|
||||||
|
|
||||||
|
!$OMP ATOMIC
|
||||||
|
done_for(done_cp_at_det(i_generator)) += 1
|
||||||
|
|
||||||
|
delta_ij_loc(:,:,:) = 0d0
|
||||||
|
call generator_start(i_generator, iproc)
|
||||||
|
call alpha_callback(delta_ij_loc, i_generator, subset, iproc)
|
||||||
|
call generator_done(i_generator, int_buf, double_buf, det_buf, N_buf, iproc)
|
||||||
|
|
||||||
|
do i=1,N_cp
|
||||||
|
fac = cps(i_generator, i) * dress_weight_inv(i_generator) * comb_step
|
||||||
|
if(fac == 0d0) cycle
|
||||||
|
call omp_set_lock(lck_sto(i))
|
||||||
|
cp(:,:,i,1) += (delta_ij_loc(:,:,1) * fac)
|
||||||
|
cp(:,:,i,2) += (delta_ij_loc(:,:,2) * fac)
|
||||||
|
call omp_unset_lock(lck_sto(i))
|
||||||
|
end do
|
||||||
|
|
||||||
|
|
||||||
|
toothMwen = tooth_of_det(i_generator)
|
||||||
|
fracted = (toothMwen /= 0)
|
||||||
|
if(fracted) fracted = (i_generator == first_det_of_teeth(toothMwen))
|
||||||
|
if(fracted) then
|
||||||
|
call omp_set_lock(lck_det(toothMwen))
|
||||||
|
call omp_set_lock(lck_det(toothMwen-1))
|
||||||
|
delta_det(:,:,toothMwen-1, 1) += delta_ij_loc(:,:,1) * (1d0-fractage(toothMwen))
|
||||||
|
delta_det(:,:,toothMwen-1, 2) += delta_ij_loc(:,:,2) * (1d0-fractage(toothMwen))
|
||||||
|
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1) * (fractage(toothMwen))
|
||||||
|
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2) * (fractage(toothMwen))
|
||||||
|
call omp_unset_lock(lck_det(toothMwen))
|
||||||
|
call omp_unset_lock(lck_det(toothMwen-1))
|
||||||
|
else
|
||||||
|
call omp_set_lock(lck_det(toothMwen))
|
||||||
|
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1)
|
||||||
|
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2)
|
||||||
|
call omp_unset_lock(lck_det(toothMwen))
|
||||||
|
end if
|
||||||
|
call push_dress_results(zmq_socket_push, i_generator, -1, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, task_id)
|
||||||
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||||
|
lastCp(iproc) = done_cp_at_det(i_generator)
|
||||||
end if
|
end if
|
||||||
read (task,*) subset, i_generator
|
|
||||||
|
|
||||||
|
|
||||||
if(done_cp_at_det(i_generator) < lastCp(iproc)) stop 'loop = .false.'
|
|
||||||
!$OMP CRITICAL
|
!$OMP CRITICAL
|
||||||
send = .false.
|
send = .false.
|
||||||
lastSendable = N_cp*2
|
lastSendable = N_cp*2
|
||||||
@ -125,18 +162,17 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
lastSendable = min(lastCp(i), lastSendable)
|
lastSendable = min(lastCp(i), lastSendable)
|
||||||
end do
|
end do
|
||||||
lastSendable -= 1
|
lastSendable -= 1
|
||||||
if(lastSendable > lastSent) then
|
if(lastSendable > lastSent .or. (lastSendable == N_cp-1 .and. lastSent /= N_cp-1)) then
|
||||||
lastSent = lastSendable
|
lastSent = lastSendable
|
||||||
|
cur_cp = lastSent
|
||||||
send = .true.
|
send = .true.
|
||||||
end if
|
end if
|
||||||
!$OMP END CRITICAL
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
if(send) then
|
if(send) then
|
||||||
!!1$OMP CRITICAL
|
|
||||||
N_buf = (/0,1,0/)
|
N_buf = (/0,1,0/)
|
||||||
|
|
||||||
delta_ij_loc = 0d0
|
delta_ij_loc = 0d0
|
||||||
cur_cp = lastSent
|
|
||||||
if(cur_cp < 1) stop "cur_cp < 1"
|
if(cur_cp < 1) stop "cur_cp < 1"
|
||||||
do i=1,cur_cp
|
do i=1,cur_cp
|
||||||
delta_ij_loc(:,:,:) += cp(:,:,i,:)
|
delta_ij_loc(:,:,:) += cp(:,:,i,:)
|
||||||
@ -146,61 +182,13 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
do i=cp_first_tooth(cur_cp)-1,0,-1
|
do i=cp_first_tooth(cur_cp)-1,0,-1
|
||||||
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) +delta_det(:,:,i,:)
|
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) +delta_det(:,:,i,:)
|
||||||
end do
|
end do
|
||||||
!!1$OMP END CRITICAL
|
|
||||||
!!1$OMP CRITICAL (SENDAGE)
|
|
||||||
call push_dress_results(zmq_socket_push, done_for(cur_cp), cur_cp, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, -1)
|
call push_dress_results(zmq_socket_push, done_for(cur_cp), cur_cp, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, -1)
|
||||||
!!1$OMP END CRITICAL (SENDAGE)
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
if(task_id == 0) exit
|
||||||
!$OMP ATOMIC
|
|
||||||
done_for(done_cp_at_det(i_generator)) += 1
|
|
||||||
|
|
||||||
delta_ij_loc(:,:,:) = 0d0
|
|
||||||
call generator_start(i_generator, iproc)
|
|
||||||
call alpha_callback(delta_ij_loc, i_generator, subset, iproc)
|
|
||||||
call generator_done(i_generator, int_buf, double_buf, det_buf, N_buf, iproc)
|
|
||||||
|
|
||||||
!!1$OMP CRITICAL
|
|
||||||
do i=1,N_cp
|
|
||||||
fac = cps(i_generator, i) * dress_weight_inv(i_generator) * comb_step
|
|
||||||
if(fac == 0d0) cycle
|
|
||||||
call omp_set_lock(lck_sto(i))
|
|
||||||
cp(:,:,i,1) += (delta_ij_loc(:,:,1) * fac)
|
|
||||||
cp(:,:,i,2) += (delta_ij_loc(:,:,2) * fac)
|
|
||||||
call omp_unset_lock(lck_sto(i))
|
|
||||||
end do
|
|
||||||
|
|
||||||
|
|
||||||
toothMwen = tooth_of_det(i_generator)
|
|
||||||
fracted = (toothMwen /= 0)
|
|
||||||
if(fracted) fracted = (i_generator == first_det_of_teeth(toothMwen))
|
|
||||||
if(fracted) then
|
|
||||||
call omp_set_lock(lck_det(toothMwen))
|
|
||||||
call omp_set_lock(lck_det(toothMwen-1))
|
|
||||||
delta_det(:,:,toothMwen-1, 1) += delta_ij_loc(:,:,1) * (1d0-fractage(toothMwen))
|
|
||||||
delta_det(:,:,toothMwen-1, 2) += delta_ij_loc(:,:,2) * (1d0-fractage(toothMwen))
|
|
||||||
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1) * (fractage(toothMwen))
|
|
||||||
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2) * (fractage(toothMwen))
|
|
||||||
call omp_unset_lock(lck_det(toothMwen))
|
|
||||||
call omp_unset_lock(lck_det(toothMwen-1))
|
|
||||||
else
|
|
||||||
call omp_set_lock(lck_det(toothMwen))
|
|
||||||
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1)
|
|
||||||
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2)
|
|
||||||
call omp_unset_lock(lck_det(toothMwen))
|
|
||||||
end if
|
|
||||||
!!!&$OMP END CRITICAL
|
|
||||||
|
|
||||||
!!1$OMP CRITICAL (SENDAGE)
|
|
||||||
call push_dress_results(zmq_socket_push, i_generator, -1, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, task_id)
|
|
||||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
|
||||||
!!1$OMP END CRITICAL (SENDAGE)
|
|
||||||
lastCp(iproc) = done_cp_at_det(i_generator)
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call sleep(10)
|
call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
|
||||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
@ -211,7 +199,6 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
do i=0,comb_teeth+1
|
do i=0,comb_teeth+1
|
||||||
call omp_destroy_lock(lck_det(i))
|
call omp_destroy_lock(lck_det(i))
|
||||||
end do
|
end do
|
||||||
stop
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
@ -220,7 +207,8 @@ end subroutine
|
|||||||
subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_bufi, task_id)
|
subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_bufi, task_id)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
|
integer, parameter :: sendt = 4
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
double precision, intent(inout) :: delta_loc(N_states, N_det, 2)
|
double precision, intent(inout) :: delta_loc(N_states, N_det, 2)
|
||||||
real(kind=4), allocatable :: delta_loc4(:,:,:)
|
real(kind=4), allocatable :: delta_loc4(:,:,:)
|
||||||
@ -232,7 +220,7 @@ subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf,
|
|||||||
integer, intent(in) :: ind, cur_cp, task_id
|
integer, intent(in) :: ind, cur_cp, task_id
|
||||||
integer :: rc, i, j, k, l
|
integer :: rc, i, j, k, l
|
||||||
double precision :: contrib(N_states)
|
double precision :: contrib(N_states)
|
||||||
real(4), allocatable :: r4buf(:,:,:)
|
real(sendt), allocatable :: r4buf(:,:,:)
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, ind, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, ind, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) stop "push"
|
if(rc /= 4) stop "push"
|
||||||
@ -246,16 +234,16 @@ subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf,
|
|||||||
do i=1,2
|
do i=1,2
|
||||||
do j=1,N_det
|
do j=1,N_det
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
r4buf(k,j,i) = real(delta_loc(k,j,i), 4)
|
r4buf(k,j,i) = real(delta_loc(k,j,i), sendt)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, r4buf(1,1,1), 4*N_states*N_det, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, r4buf(1,1,1), sendt*N_states*N_det, ZMQ_SNDMORE)
|
||||||
if(rc /= 4*N_states*N_det) stop "push"
|
if(rc /= sendt*N_states*N_det) stop "push"
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, r4buf(1,1,2), 4*N_states*N_det, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, r4buf(1,1,2), sendt*N_states*N_det, ZMQ_SNDMORE)
|
||||||
if(rc /= 4*N_states*N_det) stop "push"
|
if(rc /= sendt*N_states*N_det) stop "push"
|
||||||
else
|
else
|
||||||
contrib = 0d0
|
contrib = 0d0
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -266,7 +254,7 @@ subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf,
|
|||||||
if(rc /= 8*N_states) stop "push"
|
if(rc /= 8*N_states) stop "push"
|
||||||
|
|
||||||
N_buf = N_bufi
|
N_buf = N_bufi
|
||||||
N_buf = (/0,1,0/)
|
!N_buf = (/0,1,0/)
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
|
||||||
if(rc /= 4*3) stop "push5"
|
if(rc /= 4*3) stop "push5"
|
||||||
@ -313,6 +301,7 @@ END_PROVIDER
|
|||||||
subroutine pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, contrib)
|
subroutine pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, contrib)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
|
integer, parameter :: sendt = 4
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
integer, intent(out) :: cur_cp
|
integer, intent(out) :: cur_cp
|
||||||
double precision, intent(inout) :: delta_loc(N_states, N_det, 2)
|
double precision, intent(inout) :: delta_loc(N_states, N_det, 2)
|
||||||
@ -335,11 +324,11 @@ subroutine pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf,
|
|||||||
|
|
||||||
if(cur_cp /= -1) then
|
if(cur_cp /= -1) then
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, real4buf(1,1,1), N_states*4*N_det, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, real4buf(1,1,1), N_states*sendt*N_det, 0)
|
||||||
if(rc /= 4*N_states*N_det) stop "pullc"
|
if(rc /= sendt*N_states*N_det) stop "pullc"
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, real4buf(1,1,2), N_states*4*N_det, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, real4buf(1,1,2), N_states*sendt*N_det, 0)
|
||||||
if(rc /= 4*N_states*N_det) stop "pulld"
|
if(rc /= sendt*N_states*N_det) stop "pulld"
|
||||||
|
|
||||||
do i=1,2
|
do i=1,2
|
||||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(j,k)
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(j,k)
|
||||||
|
@ -8,7 +8,6 @@ subroutine create_selection_buffer(N, siz_, res)
|
|||||||
|
|
||||||
integer :: siz
|
integer :: siz
|
||||||
siz = max(siz_,1)
|
siz = max(siz_,1)
|
||||||
|
|
||||||
allocate(res%det(N_int, 2, siz), res%val(siz))
|
allocate(res%det(N_int, 2, siz), res%val(siz))
|
||||||
|
|
||||||
res%val(:) = 0d0
|
res%val(:) = 0d0
|
||||||
@ -18,19 +17,6 @@ subroutine create_selection_buffer(N, siz_, res)
|
|||||||
res%cur = 0
|
res%cur = 0
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
subroutine reset_selection_buffer(res)
|
|
||||||
use selection_types
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
type(selection_buffer), intent(out) :: res
|
|
||||||
|
|
||||||
res%val(:) = 0d0
|
|
||||||
res%det(:,:,:) = 0_8
|
|
||||||
res%mini = 0d0
|
|
||||||
res%cur = 0
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine delete_selection_buffer(b)
|
subroutine delete_selection_buffer(b)
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
@ -53,7 +39,7 @@ subroutine add_to_selection_buffer(b, det, val)
|
|||||||
double precision, intent(in) :: val
|
double precision, intent(in) :: val
|
||||||
integer :: i
|
integer :: i
|
||||||
|
|
||||||
if(b%N > 0 .and. val < b%mini) then
|
if(b%N > 0 .and. val <= b%mini) then
|
||||||
b%cur += 1
|
b%cur += 1
|
||||||
b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2)
|
b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2)
|
||||||
b%val(b%cur) = val
|
b%val(b%cur) = val
|
||||||
|
9
plugins/shiftedbk/selection_types.f90
Normal file
9
plugins/shiftedbk/selection_types.f90
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
module selection_types
|
||||||
|
type selection_buffer
|
||||||
|
integer :: N, cur
|
||||||
|
integer(8) , pointer :: det(:,:,:)
|
||||||
|
double precision, pointer :: val(:)
|
||||||
|
double precision :: mini
|
||||||
|
endtype
|
||||||
|
end module
|
||||||
|
|
@ -33,7 +33,6 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
<<<<<<< HEAD
|
|
||||||
BEGIN_PROVIDER [ integer, N_dress_int_buffer ]
|
BEGIN_PROVIDER [ integer, N_dress_int_buffer ]
|
||||||
&BEGIN_PROVIDER [ integer, N_dress_double_buffer ]
|
&BEGIN_PROVIDER [ integer, N_dress_double_buffer ]
|
||||||
&BEGIN_PROVIDER [ integer, N_dress_det_buffer ]
|
&BEGIN_PROVIDER [ integer, N_dress_det_buffer ]
|
||||||
@ -197,14 +196,15 @@ subroutine undress_with_alpha(old_generators, old_det_gen, alpha, n_alpha)
|
|||||||
c_alpha(:,1) += c_alpha(:,i)
|
c_alpha(:,1) += c_alpha(:,i)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
delta_ij_tmp(:,:,:) -= delta_ij_loc(:,:,:,1)
|
delta_ij_tmp(:,:,1) -= delta_ij_loc(:,:,1,1)
|
||||||
|
delta_ij_tmp(:,:,2) -= delta_ij_loc(:,:,2,1)
|
||||||
|
|
||||||
|
!print *, "SUM ALPHA2 PRE", global_sum_alpha2
|
||||||
print *, "SUM ALPHA2 PRE", global_sum_alpha2
|
|
||||||
!global_sum_alpha2(:) -= c_alpha(:,1)
|
!global_sum_alpha2(:) -= c_alpha(:,1)
|
||||||
print *, "SUM ALPHA2 POST", c_alpha(:,1)
|
print *, "SUM C_ALPHA^2 ", global_sum_alpha2(:)
|
||||||
|
print *, "*** DRESSINS DIVIDED BY 1+SUM C_ALPHA^2 ***"
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
! delta_ij_tmp(i,:,:) = delta_ij_tmp(i,:,:) / (1d0 + global_sum_alpha2(i))
|
delta_ij_tmp(i,:,:) = delta_ij_tmp(i,:,:) / (1d0 + global_sum_alpha2(i))
|
||||||
end do
|
end do
|
||||||
global_sum_alpha2 = 0d0
|
global_sum_alpha2 = 0d0
|
||||||
end subroutine
|
end subroutine
|
||||||
@ -257,6 +257,10 @@ subroutine dress_with_alpha_(Nstates,Ndet,Nint,delta_ij_loc,minilist, det_minili
|
|||||||
do l_sd=1,n_minilist
|
do l_sd=1,n_minilist
|
||||||
hdress = c_alpha(i) * a_h_i(l_sd, iproc)
|
hdress = c_alpha(i) * a_h_i(l_sd, iproc)
|
||||||
sdress = c_alpha(i) * a_s2_i(l_sd, iproc)
|
sdress = c_alpha(i) * a_s2_i(l_sd, iproc)
|
||||||
|
!if(c_alpha(i) * a_s2_i(l_sd, iproc) > 1d-1) then
|
||||||
|
! call debug_det(det_minilist(1,1,l_sd), N_int)
|
||||||
|
! call debug_det(alpha,N_int)
|
||||||
|
!end if
|
||||||
delta_ij_loc(i, minilist(l_sd), 1) += hdress
|
delta_ij_loc(i, minilist(l_sd), 1) += hdress
|
||||||
delta_ij_loc(i, minilist(l_sd), 2) += sdress
|
delta_ij_loc(i, minilist(l_sd), 2) += sdress
|
||||||
end do
|
end do
|
||||||
|
Loading…
Reference in New Issue
Block a user