From 1013b6f7f7f578fe43d6f4a3b3004feba3aeadc8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 18 Apr 2016 12:51:50 +0200 Subject: [PATCH 01/12] Replaced PUSH/PULL by REQ/REP --- src/Determinants/H_apply.irp.f | 22 +++++++++---------- .../ao_bielec_integrals_in_map_slave.irp.f | 22 +++++++++---------- src/ZMQ/utils.irp.f | 8 +++---- 3 files changed, 26 insertions(+), 26 deletions(-) diff --git a/src/Determinants/H_apply.irp.f b/src/Determinants/H_apply.irp.f index 28513597..b8604e8b 100644 --- a/src/Determinants/H_apply.irp.f +++ b/src/Determinants/H_apply.irp.f @@ -350,12 +350,12 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) endif ! Activate if zmq_socket_push is a REQ -! 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 + 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 end subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) @@ -411,11 +411,11 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) endif ! Activate if zmq_socket_pull is a REP -! rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0) -! if (rc /= 4) then -! print *, irp_here, 'f77_zmq_send( zmq_socket_pull, 0, 4, 0)' -! stop 'error' -! endif + rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_pull, 0, 4, 0)' + stop 'error' + endif end diff --git a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f index 6102d119..4e2f7152 100644 --- a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f +++ b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f @@ -57,12 +57,12 @@ subroutine push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, endif ! Activate is zmq_socket_push is a REQ -! 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 + 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 end @@ -167,11 +167,11 @@ subroutine pull_integrals(zmq_socket_pull, n_integrals, buffer_i, buffer_value, endif ! Activate if zmq_socket_pull is a REP -! 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 + 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 end diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index d730f612..b161f26d 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -217,8 +217,8 @@ function new_zmq_pull_socket() integer(ZMQ_PTR) :: new_zmq_pull_socket call omp_set_lock(zmq_lock) - new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_PULL) -! new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_REP) +! new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_PULL) + new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_REP) call omp_unset_lock(zmq_lock) if (new_zmq_pull_socket == 0_ZMQ_PTR) then stop 'Unable to create zmq pull socket' @@ -267,8 +267,8 @@ function new_zmq_push_socket(thread) integer(ZMQ_PTR) :: new_zmq_push_socket call omp_set_lock(zmq_lock) - new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_PUSH) -! new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) +! new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_PUSH) + new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) call omp_unset_lock(zmq_lock) if (new_zmq_push_socket == 0_ZMQ_PTR) then stop 'Unable to create zmq push socket' From 68247ee14a471cae48e3db526f03178e56bf02ed Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 19 Apr 2016 20:34:43 +0200 Subject: [PATCH 02/12] Repaired qp_ao_ints --- src/Integrals_Bielec/qp_ao_ints.irp.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Integrals_Bielec/qp_ao_ints.irp.f b/src/Integrals_Bielec/qp_ao_ints.irp.f index f932df0f..c60b4e5d 100644 --- a/src/Integrals_Bielec/qp_ao_ints.irp.f +++ b/src/Integrals_Bielec/qp_ao_ints.irp.f @@ -8,7 +8,8 @@ program qp_ao_ints call switch_qp_run_to_master - PROVIDE zmq_context + zmq_context = f77_zmq_ctx_new () + ! Set the state of the ZMQ zmq_state = 'ao_integrals' From d35d555eda722a1940a52b789067e203717d9615 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 2 May 2016 10:31:57 +0200 Subject: [PATCH 03/12] Davidson thresold --- plugins/Full_CI/H_apply.irp.f | 2 +- src/Determinants/H_apply.irp.f | 22 ++-- src/Determinants/davidson.irp.f | 16 ++- src/Determinants/slater_rules.irp.f | 104 +++++++----------- .../ao_bielec_integrals_in_map_slave.irp.f | 28 ++--- src/Utils/util.irp.f | 2 + src/ZMQ/utils.irp.f | 10 +- 7 files changed, 89 insertions(+), 95 deletions(-) diff --git a/plugins/Full_CI/H_apply.irp.f b/plugins/Full_CI/H_apply.irp.f index 3dc1e0f0..d6888dc3 100644 --- a/plugins/Full_CI/H_apply.irp.f +++ b/plugins/Full_CI/H_apply.irp.f @@ -9,7 +9,7 @@ print s s = H_apply_zmq("FCI_PT2") s.set_perturbation("epstein_nesbet_2x2") -#s.unset_openmp() +s.unset_openmp() print s s = H_apply("FCI_no_skip") diff --git a/src/Determinants/H_apply.irp.f b/src/Determinants/H_apply.irp.f index b8604e8b..28513597 100644 --- a/src/Determinants/H_apply.irp.f +++ b/src/Determinants/H_apply.irp.f @@ -350,12 +350,12 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) endif ! Activate if zmq_socket_push is a REQ - 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 +! 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 end subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) @@ -411,11 +411,11 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) endif ! Activate if zmq_socket_pull is a REP - rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0) - if (rc /= 4) then - print *, irp_here, 'f77_zmq_send( zmq_socket_pull, 0, 4, 0)' - stop 'error' - endif +! rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0) +! if (rc /= 4) then +! print *, irp_here, 'f77_zmq_send( zmq_socket_pull, 0, 4, 0)' +! stop 'error' +! endif end diff --git a/src/Determinants/davidson.irp.f b/src/Determinants/davidson.irp.f index deba43c5..c78a3826 100644 --- a/src/Determinants/davidson.irp.f +++ b/src/Determinants/davidson.irp.f @@ -315,6 +315,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun double precision, intent(inout) :: u_in(dim_in,N_st) double precision, intent(out) :: energies(N_st) + integer :: sze_8 integer :: iter integer :: i,j,k,l,m logical :: converged @@ -334,6 +335,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun double precision :: to_print(2,N_st) double precision :: cpu, wall + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, R, Wt, y, h, lambda call write_time(iunit) @@ -362,12 +364,15 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun enddo write(iunit,'(A)') trim(write_buffer) + integer, external :: align_double + sze_8 = align_double(sze) + allocate( & kl_pairs(2,N_st*(N_st+1)/2), & - W(sze,N_st,davidson_sze_max), & + W(sze_8,N_st,davidson_sze_max), & Wt(sze), & - U(sze,N_st,davidson_sze_max), & - R(sze,N_st), & + U(sze_8,N_st,davidson_sze_max), & + R(sze_8,N_st), & h(N_st,davidson_sze_max,N_st,davidson_sze_max), & y(N_st,davidson_sze_max,N_st,davidson_sze_max), & lambda(N_st*davidson_sze_max)) @@ -473,7 +478,10 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun ! Express eigenvectors of h in the determinant basis ! -------------------------------------------------- + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(k,i,l,iter2) SHARED(U,W,R,y,iter,lambda,N_st,sze) do k=1,N_st + !$OMP DO do i=1,sze U(i,k,iter+1) = 0.d0 W(i,k,iter+1) = 0.d0 @@ -484,7 +492,9 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun enddo enddo enddo + !$OMP END DO enddo + !$OMP END PARALLEL ! Compute residual vector ! ----------------------- diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 4ab9deda..9bcc95f9 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -1608,12 +1608,11 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint) integer :: i,j,k,l, jj,ii integer :: i0, j0 - integer, allocatable :: shortcut(:), sort_idx(:) - integer(bit_kind), allocatable :: sorted(:,:), version(:,:) + integer, allocatable :: shortcut(:,:), sort_idx(:,:) + integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) integer(bit_kind) :: sorted_i(Nint) integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi - double precision :: local_threshold ASSERT (Nint > 0) @@ -1621,104 +1620,83 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint) ASSERT (n>0) PROVIDE ref_bitmask_energy davidson_criterion - allocate (shortcut(0:n+1), sort_idx(n), sorted(Nint,n), version(Nint,n)) + allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) v_0 = 0.d0 - call sort_dets_ab_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint) + call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) + call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,hij,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,local_threshold,sorted_i)& - !$OMP SHARED(n,H_jj,u_0,keys_tmp,Nint,v_0,threshold_davidson,sorted,shortcut,sort_idx,version) + !$OMP PRIVATE(i,hij,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i)& + !$OMP SHARED(n,H_jj,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version) allocate(vt(n)) Vt = 0.d0 !$OMP DO SCHEDULE(dynamic) - do sh=1,shortcut(0) - do sh2=1,sh + do sh=1,shortcut(0,1) + do sh2=sh,shortcut(0,1) exa = 0 do ni=1,Nint - exa = exa + popcnt(xor(version(ni,sh), version(ni,sh2))) + exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) end do if(exa > 2) then cycle end if - do i=shortcut(sh),shortcut(sh+1)-1 - org_i = sort_idx(i) - local_threshold = threshold_davidson - dabs(u_0(org_i)) + do i=shortcut(sh,1),shortcut(sh+1,1)-1 + org_i = sort_idx(i,1) if(sh==sh2) then endi = i-1 else - endi = shortcut(sh2+1)-1 + endi = shortcut(sh2+1,1)-1 end if do ni=1,Nint - sorted_i(ni) = sorted(ni,i) + sorted_i(ni) = sorted(ni,i,1) enddo - do j=shortcut(sh2),endi - org_j = sort_idx(j) - if ( dabs(u_0(org_j)) > local_threshold ) then - ext = exa - do ni=1,Nint - ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j))) - end do - if(ext <= 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - vt (org_i) = vt (org_i) + hij*u_0(org_j) - vt (org_j) = vt (org_j) + hij*u_0(org_i) - endif + do j=shortcut(sh2,1),endi + org_j = sort_idx(j,1) + ext = exa + do ni=1,Nint + ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + end do + if(ext <= 4) then + call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) + vt (org_i) = vt (org_i) + hij*u_0(org_j) + vt (org_j) = vt (org_j) + hij*u_0(org_i) endif enddo enddo enddo enddo - !$OMP END DO - - !$OMP CRITICAL - do i=1,n - v_0(i) = v_0(i) + vt(i) - enddo - !$OMP END CRITICAL - - deallocate(vt) - !$OMP END PARALLEL - - call sort_dets_ba_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint) - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,hij,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,local_threshold)& - !$OMP SHARED(n,H_jj,u_0,keys_tmp,Nint,v_0,threshold_davidson,sorted,shortcut,sort_idx,version) - allocate(vt(n)) - Vt = 0.d0 + !$OMP END DO NOWAIT !$OMP DO SCHEDULE(dynamic) - do sh=1,shortcut(0) - do i=shortcut(sh),shortcut(sh+1)-1 - org_i = sort_idx(i) - local_threshold = threshold_davidson - dabs(u_0(org_i)) - do j=shortcut(sh),i-1 - org_j = sort_idx(j) - if ( dabs(u_0(org_j)) > local_threshold ) then - ext = 0 - do ni=1,Nint - ext = ext + popcnt(xor(sorted(ni,i), sorted(ni,j))) - end do - if(ext == 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - vt (org_i) = vt (org_i) + hij*u_0(org_j) - vt (org_j) = vt (org_j) + hij*u_0(org_i) - end if + do sh=1,shortcut(0,2) + do i=shortcut(sh,2),shortcut(sh+1,2)-1 + org_i = sort_idx(i,2) + do j=shortcut(sh,2),i-1 + org_j = sort_idx(j,2) + ext = 0 + do ni=1,Nint + ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) + end do + if(ext == 4) then + call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) + vt (org_i) = vt (org_i) + hij*u_0(org_j) + vt (org_j) = vt (org_j) + hij*u_0(org_i) end if end do end do enddo - !$OMP END DO + !$OMP END DO NOWAIT !$OMP CRITICAL - do i=1,n + do i=n,1,-1 v_0(i) = v_0(i) + vt(i) enddo !$OMP END CRITICAL + deallocate(vt) !$OMP END PARALLEL diff --git a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f index 4e2f7152..f15376b5 100644 --- a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f +++ b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f @@ -57,16 +57,18 @@ subroutine push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, endif ! Activate is zmq_socket_push is a REQ - 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 +! 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 end + + subroutine ao_bielec_integrals_in_map_slave(thread,iproc) use map_module use f77_zmq @@ -107,7 +109,7 @@ subroutine ao_bielec_integrals_in_map_slave(thread,iproc) call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, 0) enddo call compute_ao_integrals_jl(l,l,n_integrals,buffer_i,buffer_value) - call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_integrals) + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id) enddo @@ -127,7 +129,7 @@ subroutine pull_integrals(zmq_socket_pull, n_integrals, buffer_i, buffer_value, BEGIN_DOC ! How the collector pulls the computed integrals END_DOC - integer(ZMQ_PTR), intent(out) :: zmq_socket_pull + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull integer, intent(out) :: n_integrals integer(key_kind), intent(out) :: buffer_i(*) real(integral_kind), intent(out) :: buffer_value(*) @@ -167,11 +169,11 @@ subroutine pull_integrals(zmq_socket_pull, n_integrals, buffer_i, buffer_value, endif ! Activate if zmq_socket_pull is a REP - 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 +! 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 end diff --git a/src/Utils/util.irp.f b/src/Utils/util.irp.f index a5904183..a0ea668d 100644 --- a/src/Utils/util.irp.f +++ b/src/Utils/util.irp.f @@ -324,6 +324,7 @@ double precision function u_dot_v(u,v,sze) t3 = t2+t2 t4 = t3+t2 u_dot_v = 0.d0 + !DIR$ VECTOR ALWAYS do i=1,t2 u_dot_v = u_dot_v + u(t1+i)*v(t1+i) + u(t2+i)*v(t2+i) + & u(t3+i)*v(t3+i) + u(t4+i)*v(t4+i) @@ -359,6 +360,7 @@ double precision function u_dot_u(u,sze) ! u_dot_u = u_dot_u+u(i)*u(i) ! enddo + !DIR$ VECTOR ALWAYS do i=1,sze u_dot_u = u_dot_u + u(i)*u(i) enddo diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index b161f26d..af97161b 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -217,8 +217,8 @@ function new_zmq_pull_socket() integer(ZMQ_PTR) :: new_zmq_pull_socket call omp_set_lock(zmq_lock) -! new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_PULL) - new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_REP) + new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_PULL) +! new_zmq_pull_socket = f77_zmq_socket(zmq_context, ZMQ_REP) call omp_unset_lock(zmq_lock) if (new_zmq_pull_socket == 0_ZMQ_PTR) then stop 'Unable to create zmq pull socket' @@ -267,8 +267,8 @@ function new_zmq_push_socket(thread) integer(ZMQ_PTR) :: new_zmq_push_socket call omp_set_lock(zmq_lock) -! new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_PUSH) - new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) + new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_PUSH) +! new_zmq_push_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) call omp_unset_lock(zmq_lock) if (new_zmq_push_socket == 0_ZMQ_PTR) then stop 'Unable to create zmq push socket' @@ -361,6 +361,8 @@ subroutine end_zmq_pull_socket(zmq_socket_pull) stop 'error' endif + call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922 + rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,0,4) if (rc /= 0) then stop 'Unable to set ZMQ_LINGER on zmq_socket_pull' From 1354ab86fbb54ae1948245858b6d775add03ef63 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 2 May 2016 17:06:18 +0200 Subject: [PATCH 04/12] Optim MRCC + davidson --- plugins/MRCC_Utils/mrcc_dress.irp.f | 26 +++++++++++++++----------- plugins/Psiref_CAS/psi_ref.irp.f | 14 ++++++++++++++ 2 files changed, 29 insertions(+), 11 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index b2304818..1c2e8b74 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -274,7 +274,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge enddo do i_state=1,Nstates - ci_inv(i_state) = 1.d0/psi_ref_coef(i_I,i_state) + ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) enddo do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) @@ -285,16 +285,20 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge enddo enddo call omp_set_lock( psi_ref_lock(i_I) ) - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - do i_state=1,Nstates - delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) - if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5)then - delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) - else - delta_ii_(i_state,i_I) = 0.d0 - endif - enddo + do i_state=1,Nstates + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5)then + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) + delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) + enddo + else + delta_ii_(i_state,i_I) = 0.d0 + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) + enddo + endif enddo call omp_unset_lock( psi_ref_lock(i_I) ) enddo diff --git a/plugins/Psiref_CAS/psi_ref.irp.f b/plugins/Psiref_CAS/psi_ref.irp.f index 6beca8f2..d3b6c28f 100644 --- a/plugins/Psiref_CAS/psi_ref.irp.f +++ b/plugins/Psiref_CAS/psi_ref.irp.f @@ -24,6 +24,20 @@ use bitmasks enddo enddo +END_PROVIDER + +BEGIN_PROVIDER [ double precision, psi_ref_coef_inv, (psi_det_size,n_states) ] + implicit none + BEGIN_DOC + ! 1/psi_ref_coef + END_DOC + integer :: i, i_state + do i_state=1,N_states + do i=1,N_det_ref + psi_ref_coef_inv(i,i_state) = 1.d0/psi_ref_coef(i,i_state) + enddo + enddo + END_PROVIDER From 078ee95e123aab4119fa91850aa9a4a48afda647 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 4 May 2016 16:14:59 +0200 Subject: [PATCH 05/12] Bug in ei_handler --- scripts/ezfio_interface/ei_handler.py | 2 +- .../ezfio_generate_provider.py | 2 ++ src/Determinants/H_apply_zmq.template.f | 29 +++++++++---------- src/Integrals_Bielec/ao_bi_integrals.irp.f | 18 +++++------- src/Utils/util.irp.f | 12 -------- 5 files changed, 24 insertions(+), 39 deletions(-) diff --git a/scripts/ezfio_interface/ei_handler.py b/scripts/ezfio_interface/ei_handler.py index a3f3600b..d7cd9c95 100755 --- a/scripts/ezfio_interface/ei_handler.py +++ b/scripts/ezfio_interface/ei_handler.py @@ -345,7 +345,7 @@ def save_ezfio_provider(path_head, dict_code_provider): path = "{0}/ezfio_interface.irp.f".format(path_head) l_output = ["! DO NOT MODIFY BY HAND", - "! Created by $QP_ROOT/scripts/ezfio_interface.py", + "! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py", "! from file {0}/EZFIO.cfg".format(path_head), "\n"] diff --git a/scripts/ezfio_interface/ezfio_generate_provider.py b/scripts/ezfio_interface/ezfio_generate_provider.py index 6cd919dc..7d6e1ead 100755 --- a/scripts/ezfio_interface/ezfio_generate_provider.py +++ b/scripts/ezfio_interface/ezfio_generate_provider.py @@ -56,6 +56,8 @@ END_PROVIDER def set_write(self): self.write = "" + if "size" in self.__dict__: + return if self.type in self.write_correspondance: write = self.write_correspondance[self.type] output = self.output diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index c492a739..1ce7e726 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -10,6 +10,7 @@ subroutine $subroutine($params_main) $decls_main + integer :: i integer :: i_generator double precision :: wall_0, wall_1 integer(omp_lock_kind) :: lck @@ -37,24 +38,22 @@ subroutine $subroutine($params_main) call add_task_to_taskserver(zmq_to_qp_run_socket,task) enddo - integer(ZMQ_PTR) :: collector_thread - external :: $subroutine_collector - rc = pthread_create(collector_thread, $subroutine_collector) - - !$OMP PARALLEL DEFAULT(private) - !$OMP TASK PRIVATE(rc) - rc = omp_get_thread_num() - call $subroutine_slave_inproc(rc) - !$OMP END TASK - !$OMP TASKWAIT + PROVIDE nproc + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i, pt2, norm_pert, H_pert_diag, N_st, n, task_id) & + !$OMP SHARED(zmq_socket_pair) & + !$OMP num_threads(nproc+1) + i = omp_get_thread_num() + if (i == 0) then + call $subroutine_collector() + integer :: n, task_id + call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_st, n, task_id) + else + call $subroutine_slave_inproc(i) + endif !$OMP END PARALLEL - integer :: n, task_id - call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_st, n, task_id) - - rc = pthread_join(collector_thread) - call end_zmq_pair_socket(zmq_socket_pair) call end_parallel_job(zmq_to_qp_run_socket,'$subroutine') diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index eb443701..3b754dfc 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -374,20 +374,16 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] call add_task_to_taskserver(zmq_to_qp_run_socket,task) enddo - integer(ZMQ_PTR) :: collector_thread - external :: ao_bielec_integrals_in_map_collector - rc = pthread_create(collector_thread, ao_bielec_integrals_in_map_collector) - - !$OMP PARALLEL DEFAULT(private) - !$OMP TASK PRIVATE(i) + PROVIDE nproc + !$OMP PARALLEL DEFAULT(private) num_threads(nproc+1) i = omp_get_thread_num() - call ao_bielec_integrals_in_map_slave_inproc(i) - !$OMP END TASK - !$OMP TASKWAIT + if (i==0) then + call ao_bielec_integrals_in_map_collector(i) + else + call ao_bielec_integrals_in_map_slave_inproc(i) + endif !$OMP END PARALLEL - rc = pthread_join(collector_thread) - call end_parallel_job(zmq_to_qp_run_socket, 'ao_integrals') diff --git a/src/Utils/util.irp.f b/src/Utils/util.irp.f index a0ea668d..91a61a43 100644 --- a/src/Utils/util.irp.f +++ b/src/Utils/util.irp.f @@ -295,18 +295,6 @@ BEGIN_PROVIDER [ integer, nproc ] !$OMP END PARALLEL END_PROVIDER -BEGIN_PROVIDER [ integer, iproc_save, (nproc) ] - implicit none - BEGIN_DOC - ! iproc_save(i) = i-1. Used to start threads with pthreads. - END_DOC - integer :: i - do i=1,nproc - iproc_save(i) = i-1 - enddo - -END_PROVIDER - double precision function u_dot_v(u,v,sze) implicit none From 330de7b32f11d2cd45961462e7f58980df3c0de4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 10 May 2016 18:38:54 +0200 Subject: [PATCH 06/12] H with pseudo doesnt segfault --- .../ezfio_generate_provider.py | 31 +++++++++++++------ .../pot_ao_pseudo_ints.irp.f | 10 ++++-- 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/scripts/ezfio_interface/ezfio_generate_provider.py b/scripts/ezfio_interface/ezfio_generate_provider.py index 7d6e1ead..89fdfa03 100755 --- a/scripts/ezfio_interface/ezfio_generate_provider.py +++ b/scripts/ezfio_interface/ezfio_generate_provider.py @@ -22,6 +22,7 @@ BEGIN_PROVIDER [ %(type)s, %(name)s %(size)s ] logical :: has PROVIDE ezfio_filename + %(test_null_size)s call ezfio_has_%(ezfio_dir)s_%(ezfio_name)s(has) if (has) then call ezfio_get_%(ezfio_dir)s_%(ezfio_name)s(%(name)s) @@ -44,6 +45,7 @@ END_PROVIDER def __repr__(self): self.set_write() + self.set_test_null_size() for v in self.values: if not v: msg = "Error : %s is not set in EZFIO.cfg" % (v) @@ -54,22 +56,31 @@ END_PROVIDER return self.data % self.__dict__ + def set_test_null_size(self): + if "size" not in self.__dict__: + self.__dict__["size"] = "" + if self.size != "": + self.test_null_size = "if (size(%s) == 0) return\n" % ( self.name ) + else: + self.test_null_size = "" + def set_write(self): self.write = "" if "size" in self.__dict__: return - if self.type in self.write_correspondance: - write = self.write_correspondance[self.type] - output = self.output - name = self.name + else: + if self.type in self.write_correspondance: + write = self.write_correspondance[self.type] + output = self.output + name = self.name - l_write = ["", - " call write_time(%(output)s)", - " call %(write)s(%(output)s, %(name)s, &", - " '%(name)s')", - ""] + l_write = ["", + " call write_time(%(output)s)", + " call %(write)s(%(output)s, %(name)s, &", + " '%(name)s')", + ""] - self.write = "\n".join(l_write) % locals() + self.write = "\n".join(l_write) % locals() def set_type(self, t): self.type = t.lower() diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index 615ed127..789bc9ea 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -3,10 +3,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral, (ao_num_align,ao_num)] BEGIN_DOC ! Pseudo-potential END_DOC + ao_pseudo_integral = 0.d0 if (do_pseudo) then - ao_pseudo_integral = ao_pseudo_integral_local + ao_pseudo_integral_non_local - else - ao_pseudo_integral = 0.d0 + if (pseudo_klocmax > 0) then + ao_pseudo_integral += ao_pseudo_integral_local + endif + if (pseudo_kmax > 0) then + ao_pseudo_integral += ao_pseudo_integral_non_local + endif endif END_PROVIDER From 08e557dac4a435eee4447d5fc67bd2a58b7d3e8e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 10 May 2016 23:21:38 +0200 Subject: [PATCH 07/12] Repaired ZMQ --- plugins/Full_CI/H_apply.irp.f | 5 +++++ plugins/MRCC_CASSD/mrcc_cassd.irp.f | 13 +++++++++++-- plugins/MRCC_Utils/H_apply.irp.f | 8 +++++++- src/Determinants/H_apply.irp.f | 6 +++++- src/Determinants/H_apply_zmq.template.f | 8 ++++---- 5 files changed, 32 insertions(+), 8 deletions(-) diff --git a/plugins/Full_CI/H_apply.irp.f b/plugins/Full_CI/H_apply.irp.f index d6888dc3..596c947a 100644 --- a/plugins/Full_CI/H_apply.irp.f +++ b/plugins/Full_CI/H_apply.irp.f @@ -7,6 +7,11 @@ s.set_selection_pt2("epstein_nesbet_2x2") #s.unset_openmp() print s +#s = H_apply("FCI_PT2") +#s.set_perturbation("epstein_nesbet_2x2") +#s.unset_openmp() +#print s + s = H_apply_zmq("FCI_PT2") s.set_perturbation("epstein_nesbet_2x2") s.unset_openmp() diff --git a/plugins/MRCC_CASSD/mrcc_cassd.irp.f b/plugins/MRCC_CASSD/mrcc_cassd.irp.f index 38cd3c55..0d49be89 100644 --- a/plugins/MRCC_CASSD/mrcc_cassd.irp.f +++ b/plugins/MRCC_CASSD/mrcc_cassd.irp.f @@ -65,8 +65,17 @@ subroutine run_pt2(N_st,energy) threshold_selectors = 1.d0 threshold_generators = 0.999d0 - N_det_generators = lambda_mrcc_pt2(0) - do i=1,N_det_generators + N_det_generators = lambda_mrcc_pt2(0) + N_det_cas + do i=1,N_det_cas + do k=1,N_int + psi_det_generators(k,1,i) = psi_ref(k,1,i) + psi_det_generators(k,2,i) = psi_ref(k,2,i) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_ref_coef(i,k) + enddo + enddo + do i=N_det_cas+1,N_det_generators j = lambda_mrcc_pt2(i) do k=1,N_int psi_det_generators(k,1,i) = psi_non_ref(k,1,j) diff --git a/plugins/MRCC_Utils/H_apply.irp.f b/plugins/MRCC_Utils/H_apply.irp.f index df2b67a0..449d262c 100644 --- a/plugins/MRCC_Utils/H_apply.irp.f +++ b/plugins/MRCC_Utils/H_apply.irp.f @@ -25,11 +25,17 @@ print s -s = H_apply_zmq("mrcc_PT2") +s = H_apply("mrcc_PT2") s.energy = "ci_electronic_energy_dressed" s.set_perturbation("epstein_nesbet_2x2") s.unset_openmp() print s +#s = H_apply_zmq("mrcc_PT2") +#s.energy = "ci_electronic_energy_dressed" +#s.set_perturbation("epstein_nesbet_2x2") +#s.unset_openmp() +#print s + END_SHELL diff --git a/src/Determinants/H_apply.irp.f b/src/Determinants/H_apply.irp.f index 28513597..e84e133e 100644 --- a/src/Determinants/H_apply.irp.f +++ b/src/Determinants/H_apply.irp.f @@ -386,7 +386,11 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) rc = f77_zmq_recv( zmq_socket_pull, pt2(1), 8*N_st, 0) if (rc /= 8*N_st) then - print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, pt2(1,1) , 8*N_st, 0)' + print *, '' + print *, '' + print *, '' + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, pt2(1) , 8*N_st, 0)' + print *, rc stop 'error' endif diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index 1ce7e726..ccb01254 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -38,16 +38,16 @@ subroutine $subroutine($params_main) call add_task_to_taskserver(zmq_to_qp_run_socket,task) enddo - PROVIDE nproc + PROVIDE nproc N_states !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i, pt2, norm_pert, H_pert_diag, N_st, n, task_id) & - !$OMP SHARED(zmq_socket_pair) & + !$OMP PRIVATE(i) & + !$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id) & !$OMP num_threads(nproc+1) i = omp_get_thread_num() if (i == 0) then call $subroutine_collector() integer :: n, task_id - call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_st, n, task_id) + call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_states, n, task_id) else call $subroutine_slave_inproc(i) endif From 9bbf5b398afce7fc27406631fbaa690125e190fd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 10 May 2016 23:26:38 +0200 Subject: [PATCH 08/12] Repaired tests --- tests/bats/qp.bats | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/bats/qp.bats b/tests/bats/qp.bats index 1ced9e1d..78ed973d 100644 --- a/tests/bats/qp.bats +++ b/tests/bats/qp.bats @@ -155,7 +155,7 @@ function run_all_1h_1p() { ezfio set determinants read_wf True qp_run mrcc_cassd $INPUT energy="$(ezfio get mrcc_cassd energy)" - eq $energy -76.2284994316618 1.e-4 + eq $energy -76.2288648023833 1.e-4 } @@ -166,7 +166,7 @@ function run_all_1h_1p() { } @test "SCF H2O VDZ pseudo" { - run_HF h2o_pseudo.ezfio -16.9483708495521 + run_HF h2o_pseudo.ezfio -16.9483703905461 } @test "FCI H2O VDZ pseudo" { From 7b1a5efb886e04c65a13c6aaf00c0fe19d421539 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 11 May 2016 21:45:56 +0200 Subject: [PATCH 09/12] Corrected SVD 1x1 bug --- src/Determinants/davidson.irp.f | 77 +++++++++++++++++++-------------- src/Utils/LinearAlgebra.irp.f | 8 ++++ 2 files changed, 53 insertions(+), 32 deletions(-) diff --git a/src/Determinants/davidson.irp.f b/src/Determinants/davidson.irp.f index c78a3826..7c1f43c2 100644 --- a/src/Determinants/davidson.irp.f +++ b/src/Determinants/davidson.irp.f @@ -386,39 +386,52 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun ! ============== - k_pairs=0 - do l=1,N_st - do k=1,l - k_pairs+=1 - kl_pairs(1,k_pairs) = k - kl_pairs(2,k_pairs) = l - enddo - enddo - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs, & - !$OMP Nint,dets_in,u_in) & - !$OMP PRIVATE(k,l,kl,i) - - - ! Orthonormalize initial guess - ! ============================ - - !$OMP DO - do kl=1,k_pairs - k = kl_pairs(1,kl) - l = kl_pairs(2,kl) - if (k/=l) then - overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze) - overlap(l,k) = overlap(k,l) - else - overlap(k,k) = u_dot_u(U_in(1,k),sze) - endif - enddo - !$OMP END DO - !$OMP END PARALLEL + if (N_st > 1) then - call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze) + k_pairs=0 + do l=1,N_st + do k=1,l + k_pairs+=1 + kl_pairs(1,k_pairs) = k + kl_pairs(2,k_pairs) = l + enddo + enddo + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs, & + !$OMP Nint,dets_in,u_in) & + !$OMP PRIVATE(k,l,kl) + + + ! Orthonormalize initial guess + ! ============================ + + !$OMP DO + do kl=1,k_pairs + k = kl_pairs(1,kl) + l = kl_pairs(2,kl) + if (k/=l) then + overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze) + overlap(l,k) = overlap(k,l) + else + overlap(k,k) = u_dot_u(U_in(1,k),sze) + endif + enddo + !$OMP END DO + !$OMP END PARALLEL + + call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze) + + else + + overlap(1,1) = u_dot_u(U_in(1,1),sze) + double precision :: f + f = 1.d0 / dsqrt(overlap(1,1)) + do i=1,sze + U_in(i,1) = U_in(i,1) * f + enddo + + endif ! Davidson iterations ! =================== diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index 13138499..11de1270 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -73,6 +73,10 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m) !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D integer :: info, i, j + if (n < 2) then + return + endif + allocate (U(ldc,n), Vt(lda,n), D(n), S_half(lda,n)) call svd(overlap,lda,U,ldc,D,Vt,lda,n,n) @@ -151,6 +155,10 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D integer :: info, i, j, k + if (n < 2) then + return + endif + call svd(overlap,lda,U,ldc,D,Vt,lda,m,n) !$OMP PARALLEL DEFAULT(NONE) & From 3f2f870281d1373117409237d733d7a3bb3179cd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 26 May 2016 12:12:43 +0200 Subject: [PATCH 10/12] ZMQ socket options --- plugins/Full_CI/micro_pt2.irp.f | 2 ++ src/ZMQ/utils.irp.f | 17 ++++++----------- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/plugins/Full_CI/micro_pt2.irp.f b/plugins/Full_CI/micro_pt2.irp.f index d78a942d..1d4d7eaa 100644 --- a/plugins/Full_CI/micro_pt2.irp.f +++ b/plugins/Full_CI/micro_pt2.irp.f @@ -24,6 +24,8 @@ subroutine run_wf integer(ZMQ_PTR) :: zmq_to_qp_run_socket print *, 'Getting wave function' + zmq_context = f77_zmq_ctx_new () + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() call zmq_get_psi(zmq_to_qp_run_socket, 1) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index af97161b..0bbba56e 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -181,14 +181,14 @@ function new_zmq_pair_socket(bind) endif endif - rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4) + rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 1, 4) if (rc /= 0) then - stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 0, 4)' + stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_SNDHWM, 1, 4)' endif - rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4) + rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 1, 4) if (rc /= 0) then - stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 0, 4)' + stop 'f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_RCVHWM, 1, 4)' endif rc = f77_zmq_setsockopt(new_zmq_pair_socket, ZMQ_IMMEDIATE, 1, 4) @@ -229,16 +229,11 @@ function new_zmq_pull_socket() stop 'Unable to set ZMQ_LINGER on pull socket' endif - rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,100000,4) + rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1000,4) if (rc /= 0) then stop 'Unable to set ZMQ_RCVHWM on pull socket' endif - rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_IMMEDIATE,1,4) - if (rc /= 0) then - stop 'Unable to set ZMQ_IMMEDIATE on pull socket' - endif - rc = f77_zmq_bind(new_zmq_pull_socket, zmq_socket_pull_tcp_address) if (rc /= 0) then print *, 'Unable to bind new_zmq_pull_socket (tcp)', zmq_socket_pull_tcp_address @@ -279,7 +274,7 @@ function new_zmq_push_socket(thread) stop 'Unable to set ZMQ_LINGER on push socket' endif - rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,100,4) + rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1000,4) if (rc /= 0) then stop 'Unable to set ZMQ_SNDHWM on push socket' endif From e2f4857b8383dac2b30433477531d98fc13987e0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 29 May 2016 22:38:06 +0200 Subject: [PATCH 11/12] Fetch i_generator from ZMQ --- src/Determinants/H_apply.irp.f | 20 ++++++++++++++++---- src/Determinants/H_apply_zmq.template.f | 12 ++++++------ 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/src/Determinants/H_apply.irp.f b/src/Determinants/H_apply.irp.f index e84e133e..abb251db 100644 --- a/src/Determinants/H_apply.irp.f +++ b/src/Determinants/H_apply.irp.f @@ -307,14 +307,14 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc) end -subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) +subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id) use f77_zmq implicit none BEGIN_DOC ! Push PT2 calculation to the collector END_DOC integer(ZMQ_PTR), intent(in) :: zmq_socket_push - integer, intent(in) :: N_st + integer, intent(in) :: N_st, i_generator double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) integer, intent(in) :: task_id integer :: rc @@ -343,6 +343,12 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) stop 'error' endif + rc = f77_zmq_send( zmq_socket_push, i_generator, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_generator, 4, 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)' @@ -358,7 +364,7 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) ! endif end -subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) +subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,i_generator,N_st,n,task_id) use f77_zmq implicit none BEGIN_DOC @@ -368,7 +374,7 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) integer, intent(in) :: N_st double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) integer, intent(out) :: task_id - integer, intent(out) :: n + integer, intent(out) :: n, i_generator integer :: rc n=0 @@ -406,6 +412,12 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) stop 'error' endif + rc = f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0)' + stop 'error' + endif + rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) if (rc /= 4) then print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)' diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index ccb01254..fcf8cbe5 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -41,13 +41,13 @@ subroutine $subroutine($params_main) PROVIDE nproc N_states !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i) & - !$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id) & + !$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id, i_generator) & !$OMP num_threads(nproc+1) i = omp_get_thread_num() if (i == 0) then call $subroutine_collector() integer :: n, task_id - call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_states, n, task_id) + call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) else call $subroutine_slave_inproc(i) endif @@ -168,7 +168,7 @@ subroutine $subroutine_slave(thread, iproc) endif call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1) - call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) + call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id) enddo @@ -193,7 +193,7 @@ subroutine $subroutine_collector integer(ZMQ_PTR), external :: new_zmq_pull_socket integer(ZMQ_PTR) :: zmq_socket_pull integer*8 :: control, accu - integer :: n, more, task_id + integer :: n, more, task_id, i_generator integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket @@ -211,7 +211,7 @@ subroutine $subroutine_collector more = 1 do while (more == 1) - call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, N_states, n, task_id) + call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) if (n > 0) then do k=1,N_states pt2(k,2) = pt2(k,1) + pt2(k,2) @@ -233,7 +233,7 @@ subroutine $subroutine_collector socket_result = new_zmq_pair_socket(.False.) - call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), N_states,0) + call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), i_generator, N_states,0) deallocate ( pt2, norm_pert, H_pert_diag) From fbd2b11fc9b881d87a4c2b2f9085a354f7c5e8e2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 29 May 2016 23:24:18 +0200 Subject: [PATCH 12/12] Introduce PT2 by generator in ZMQ --- scripts/generate_h_apply.py | 12 +++++++- src/Determinants/H_apply_zmq.template.f | 38 ++++++++++++++++--------- 2 files changed, 36 insertions(+), 14 deletions(-) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 436f092d..90f997ed 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -401,7 +401,16 @@ class H_apply_zmq(H_apply): H_pert_diag(k) = 0.d0 norm_psi(k) = 0.d0 enddo - """ + """ + self.data["copy_buffer"] = """ + do i=1,N_det_generators + do k=1,N_st + pt2(k) = pt2(k) + pt2_generators(k,i) + norm_pert(k) = norm_pert(k) + norm_pert_generators(k,i) + H_pert_diag(k) = H_pert_diag(k) + H_pert_diag_generators(k,i) + enddo + enddo + """ def set_selection_pt2(self,pert): H_apply.set_selection_pt2(self,pert) @@ -416,3 +425,4 @@ class H_apply_zmq(H_apply): select_max(i_generator) = 0.d0 endif """ + diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index fcf8cbe5..c1f6ceed 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -27,6 +27,9 @@ subroutine $subroutine($params_main) integer(ZMQ_PTR) :: zmq_socket_pair integer(ZMQ_PTR) :: zmq_to_qp_run_socket + double precision, allocatable :: pt2_generators(:,:), norm_pert_generators(:,:) + double precision, allocatable :: H_pert_diag_generators(:,:) + call new_parallel_job(zmq_to_qp_run_socket,'$subroutine') zmq_socket_pair = new_zmq_pair_socket(.True.) @@ -38,16 +41,20 @@ subroutine $subroutine($params_main) call add_task_to_taskserver(zmq_to_qp_run_socket,task) enddo + allocate ( pt2_generators(N_states,N_det_generators), & + norm_pert_generators(N_states,N_det_generators), & + H_pert_diag_generators(N_states,N_det_generators) ) + PROVIDE nproc N_states !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i) & - !$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id, i_generator) & + !$OMP SHARED(zmq_socket_pair,N_states, pt2_generators, norm_pert_generators, H_pert_diag_generators, n, task_id, i_generator) & !$OMP num_threads(nproc+1) i = omp_get_thread_num() if (i == 0) then call $subroutine_collector() integer :: n, task_id - call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) + call pull_pt2(zmq_socket_pair, pt2_generators, norm_pert_generators, H_pert_diag_generators, i_generator, size(pt2_generators), n, task_id) else call $subroutine_slave_inproc(i) endif @@ -61,6 +68,7 @@ subroutine $subroutine($params_main) $copy_buffer $generate_psi_guess + deallocate ( pt2_generators, norm_pert_generators, H_pert_diag_generators) end subroutine $subroutine_slave_tcp(iproc) @@ -185,7 +193,7 @@ subroutine $subroutine_collector use f77_zmq implicit none BEGIN_DOC -! Collects results from the selection +! Collects results from the selection in an array of generators END_DOC integer :: k, rc @@ -201,12 +209,15 @@ subroutine $subroutine_collector zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_pull = new_zmq_pull_socket() - double precision, allocatable :: pt2(:,:), norm_pert(:,:), H_pert_diag(:,:) - allocate ( pt2(N_states,2), norm_pert(N_states,2), H_pert_diag(N_states,2)) + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + double precision, allocatable :: pt2_result(:,:), norm_pert_result(:,:), H_pert_diag_result(:,:) + allocate (pt2(N_states), norm_pert(N_states), H_pert_diag(N_states)) + allocate (pt2_result(N_states,N_det_generators), norm_pert_result(N_states,N_det_generators), & + H_pert_diag_result(N_states,N_det_generators)) - pt2 = 0.d0 - norm_pert = 0.d0 - H_pert_diag = 0.d0 + pt2_result = 0.d0 + norm_pert_result = 0.d0 + H_pert_diag_result = 0.d0 accu = 0_8 more = 1 do while (more == 1) @@ -214,9 +225,9 @@ subroutine $subroutine_collector call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) if (n > 0) then do k=1,N_states - pt2(k,2) = pt2(k,1) + pt2(k,2) - norm_pert(k,2) = norm_pert(k,1) + norm_pert(k,2) - H_pert_diag(k,2) = H_pert_diag(k,1) + H_pert_diag(k,2) + pt2_result(k,i_generator) = pt2(k) + norm_pert_result(k,i_generator) = norm_pert(k) + H_pert_diag_result(k,i_generator) = H_pert_diag(k) enddo accu = accu + 1_8 call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) @@ -233,9 +244,10 @@ subroutine $subroutine_collector socket_result = new_zmq_pair_socket(.False.) - call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), i_generator, N_states,0) + call push_pt2(socket_result, pt2_result, norm_pert_result, H_pert_diag_result, i_generator, & + N_states*N_det_generators,0) - deallocate ( pt2, norm_pert, H_pert_diag) + deallocate (pt2, norm_pert, H_pert_diag, pt2_result, norm_pert_result, H_pert_diag_result) call end_zmq_pair_socket(socket_result)