From 097083db4743c88d5cea09044ae38eb841fdf936 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 30 Jan 2017 09:38:04 +0100 Subject: [PATCH 1/4] Repaired selection --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 38 ++++++------ plugins/Full_CI_ZMQ/selection.irp.f | 19 ++---- plugins/Psiref_CAS/psi_ref.irp.f | 1 + plugins/mrsc2_no_amp/mrsc2_no_amp.irp.f | 63 ++++++++++++++++++-- plugins/mrsc2_no_amp/sc2_no_amp.irp.f | 5 ++ src/Determinants/print_wf.irp.f | 46 +++++++------- 6 files changed, 109 insertions(+), 63 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 98ef0b49..f34242ab 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -1,7 +1,5 @@ - - BEGIN_PROVIDER [ integer, fragment_count ] -&BEGIN_PROVIDER [ integer, fragment_first ] - fragment_count = (elec_alpha_num-n_core_orb)**2 +BEGIN_PROVIDER [ integer, fragment_first ] + implicit none fragment_first = first_det_of_teeth(1) END_PROVIDER @@ -111,7 +109,7 @@ subroutine do_carlo(tbc, Ncomb, comb, pt2_detail, computed, sumabove, sum2above, myVal = 0d0 myVal2 = 0d0 do j=comb_teeth,1,-1 - myVal += pt2_detail(1, dets(j)) / weight(dets(j)) * comb_step + myVal += pt2_detail(1, dets(j)) / pt2_weight(dets(j)) * comb_step sumabove(j) += myVal sum2above(j) += myVal**2 Nabove(j) += 1 @@ -229,8 +227,8 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su end do E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1)) - prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - cweight(first_det_of_teeth(tooth)-1)) - prop = prop / weight(first_det_of_teeth(tooth)) + prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1)) + prop = prop / pt2_weight(first_det_of_teeth(tooth)) E0 += pt2_detail(1,first_det_of_teeth(tooth)) * prop avg = E0 + (sumabove(tooth) / Nabove(tooth)) eqt = sqrt(1d0 / (Nabove(tooth)-1) * abs(sum2above(tooth) / Nabove(tooth) - (sumabove(tooth)/Nabove(tooth))**2)) @@ -393,7 +391,7 @@ subroutine get_comb(stato, dets) curs = 1d0 - stato do j = comb_teeth, 1, -1 - dets(j) = pt2_find(curs, cweight) + dets(j) = pt2_find(curs, pt2_cweight) curs -= comb_step end do end subroutine @@ -421,8 +419,8 @@ end subroutine - BEGIN_PROVIDER [ double precision, weight, (N_det_generators) ] -&BEGIN_PROVIDER [ double precision, cweight, (N_det_generators) ] + BEGIN_PROVIDER [ double precision, pt2_weight, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, pt2_cweight, (N_det_generators) ] &BEGIN_PROVIDER [ double precision, comb_workload, (N_det_generators) ] &BEGIN_PROVIDER [ double precision, comb_step ] &BEGIN_PROVIDER [ integer, first_det_of_teeth, (comb_teeth+1) ] @@ -432,34 +430,34 @@ end subroutine double precision :: norm_left, stato integer, external :: pt2_find - weight(1) = psi_coef_generators(1,1)**2 - cweight(1) = psi_coef_generators(1,1)**2 + pt2_weight(1) = psi_coef_generators(1,1)**2 + pt2_cweight(1) = psi_coef_generators(1,1)**2 do i=2,N_det_generators - weight(i) = psi_coef_generators(i,1)**2 - cweight(i) = cweight(i-1) + psi_coef_generators(i,1)**2 + pt2_weight(i) = psi_coef_generators(i,1)**2 + pt2_cweight(i) = pt2_cweight(i-1) + psi_coef_generators(i,1)**2 end do - weight = weight / cweight(N_det_generators) - cweight = cweight / cweight(N_det_generators) + pt2_weight = pt2_weight / pt2_cweight(N_det_generators) + pt2_cweight = pt2_cweight / pt2_cweight(N_det_generators) comb_workload = 1d0 / dfloat(N_det_generators) norm_left = 1d0 comb_step = 1d0/dfloat(comb_teeth) do i=1,N_det_generators - if(weight(i)/norm_left < comb_step/2d0) then + if(pt2_weight(i)/norm_left < comb_step/2d0) then first_det_of_comb = i exit end if - norm_left -= weight(i) + norm_left -= pt2_weight(i) end do - comb_step = 1d0 / dfloat(comb_teeth) * (1d0 - cweight(first_det_of_comb-1)) + comb_step = 1d0 / dfloat(comb_teeth) * (1d0 - pt2_cweight(first_det_of_comb-1)) stato = 1d0 - comb_step! + 1d-5 do i=comb_teeth, 1, -1 - first_det_of_teeth(i) = pt2_find(stato, cweight) + first_det_of_teeth(i) = pt2_find(stato, pt2_cweight) stato -= comb_step end do first_det_of_teeth(comb_teeth+1) = N_det_generators + 1 diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 32c635ec..86e9e9f2 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -1,5 +1,10 @@ use bitmasks +BEGIN_PROVIDER [ integer, fragment_count ] + implicit none + fragment_count = (elec_alpha_num-n_core_orb)**2 +END_PROVIDER + double precision function integral8(i,j,k,l) implicit none @@ -356,20 +361,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p integer :: nb_count do s1=1,2 do i1=N_holes(s1),1,-1 ! Generate low excitations first -! will_compute = (subset == 0) -! nb_count = 0 -! if (s1==1) then -! nb_count = N_holes(1)-i1 + N_holes(2) -! else -! nb_count = N_holes(2)-i1 -! endif -! maskInd = 12345 -! fragment_count = 400 -! subset = 3 -! nb_count = 100 -! if( nb_count >= (fragment_count - mod(maskInd+1, fragment_count) + subset-1) ) then -! will_compute = .true. -! end if h1 = hole_list(i1,s1) call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) diff --git a/plugins/Psiref_CAS/psi_ref.irp.f b/plugins/Psiref_CAS/psi_ref.irp.f index ab9e6943..87439764 100644 --- a/plugins/Psiref_CAS/psi_ref.irp.f +++ b/plugins/Psiref_CAS/psi_ref.irp.f @@ -77,6 +77,7 @@ END_PROVIDER norm_psi_ref(j) += psi_ref_coef(i,j) * psi_ref_coef(i,j) enddo inv_norm_psi_ref(j) = 1.d0/(dsqrt(norm_psi_Ref(j))) + print *, inv_norm_psi_ref(j) enddo END_PROVIDER diff --git a/plugins/mrsc2_no_amp/mrsc2_no_amp.irp.f b/plugins/mrsc2_no_amp/mrsc2_no_amp.irp.f index b8b021e8..e4555d8c 100644 --- a/plugins/mrsc2_no_amp/mrsc2_no_amp.irp.f +++ b/plugins/mrsc2_no_amp/mrsc2_no_amp.irp.f @@ -4,44 +4,95 @@ implicit none integer :: i,j,k,l integer, allocatable :: idx(:) + integer, allocatable :: holes_part(:,:) double precision, allocatable :: e_corr(:,:) double precision, allocatable :: accu(:) double precision, allocatable :: ihpsi_current(:) double precision, allocatable :: H_jj(:),H_jj_total(:),S2_jj(:) + integer :: number_of_particles, number_of_holes, n_h,n_p allocate(e_corr(N_det_non_ref,N_states),ihpsi_current(N_states),accu(N_states),H_jj(N_det_non_ref),idx(0:N_det_non_ref)) allocate(H_jj_total(N_det),S2_jj(N_det)) + allocate(holes_part(N_det,2)) accu = 0.d0 do i = 1, N_det_non_ref - call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef_interm_norm, N_int, N_det_ref,& + holes_part(i,1) = number_of_holes(psi_non_ref(1,1,i)) + holes_part(i,2) = number_of_particles(psi_non_ref(1,1,i)) + call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& size(psi_ref_coef_interm_norm,1), N_states,ihpsi_current) do j = 1, N_states - e_corr(i,j) = psi_non_ref_coef_interm_norm(i,j) * ihpsi_current(j) + e_corr(i,j) = psi_non_ref_coef(i,j) * ihpsi_current(j) * inv_norm_psi_ref(j) accu(j) += e_corr(i,j) enddo enddo + print *, 'accu = ',accu double precision :: hjj,diag_h_mat_elem do i = 1, N_det_non_ref - call filter_not_connected(psi_non_ref,psi_non_ref(1,1,i),N_int,N_det_non_ref,idx) H_jj(i) = 0.d0 + n_h = holes_part(i,1) + n_p = holes_part(i,2) + integer :: degree +! do j = 1, N_det_non_ref +! call get_excitation_degree(psi_non_ref(1,1,i),psi_non_ref(1,1,j),degree,N_int) +! if(degree .gt. 2)then +! if(n_h + holes_part(j,1) .gt. 2 .or. n_p + holes_part(j,2) .gt. 2 ) then +! H_jj(i) += e_corr(j,1) +! endif +! endif +! enddo + call filter_not_connected(psi_non_ref,psi_non_ref(1,1,i),N_int,N_det_non_ref,idx) do j = 1, idx(0) - H_jj(i) += e_corr(idx(j),1) + if(n_h + holes_part(idx(j),1) .gt. 2 .or. n_p + holes_part(idx(j),2) .gt. 2 ) then + H_jj(i) += e_corr(idx(j),1) + endif enddo enddo + do i=1,N_Det H_jj_total(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) call get_s2(psi_det(1,1,i),psi_det(1,1,i),N_int,S2_jj(i)) enddo - do i=1, N_det_non_ref + do i = 1, N_det_non_ref H_jj_total(idx_non_ref(i)) += H_jj(i) enddo + print *, 'coef' call davidson_diag_hjj_sjj(psi_det,CI_eigenvectors_sc2_no_amp,H_jj_total,S2_jj,CI_electronic_energy_sc2_no_amp,size(CI_eigenvectors_sc2_no_amp,1),N_Det,N_states,N_states_diag,N_int,6) + do i = 1, N_det + hjj = diag_h_mat_elem(psi_det(1,1,i),N_int) + ! if(hjj<-210.d0)then + ! call debug_det(psi_det(1,1,i),N_int) + ! print *, CI_eigenvectors_sc2_no_amp((i),1),hjj, H_jj_total(i) + ! endif + enddo + + + + + + print *, 'ref',N_det_ref + do i =1, N_det_ref + call debug_det(psi_det(1,1,idx_ref(i)),N_int) + print *, CI_eigenvectors_sc2_no_amp(idx_ref(i),1), H_jj_total(idx_ref(i)) + enddo + print *, 'non ref',N_det_non_ref + do i=1, N_det_non_ref + hjj = diag_h_mat_elem(psi_non_ref(1,1,i),N_int) +! print *, CI_eigenvectors_sc2_no_amp(idx_non_ref(i),1),H_jj_total(idx_non_ref(i)), H_jj(i) +! if(dabs(CI_eigenvectors_sc2_no_amp(idx_non_ref(i),1)).gt.1.d-1)then +! if(hjj<-210.d0)then +! call debug_det(psi_det(1,1,idx_non_ref(i)),N_int) +! write(*,'(10(F16.10,X))') CI_eigenvectors_sc2_no_amp(idx_non_ref(i),1),hjj, H_jj(i),H_jj_total(idx_non_ref(i)) +! endif + enddo +! do i = 1, N_det +! print *, CI_eigenvectors_sc2_no_amp(i,1) +! enddo do i=1,N_states_diag CI_eigenvectors_s2_sc2_no_amp(i) = S2_jj(i) enddo - deallocate(e_corr,ihpsi_current,accu,H_jj,idx,H_jj_total,s2_jj) + deallocate(e_corr,ihpsi_current,accu,H_jj,idx,H_jj_total,s2_jj,holes_part) END_PROVIDER BEGIN_PROVIDER [ double precision, CI_energy_sc2_no_amp, (N_states_diag) ] diff --git a/plugins/mrsc2_no_amp/sc2_no_amp.irp.f b/plugins/mrsc2_no_amp/sc2_no_amp.irp.f index 622d7236..f557783b 100644 --- a/plugins/mrsc2_no_amp/sc2_no_amp.irp.f +++ b/plugins/mrsc2_no_amp/sc2_no_amp.irp.f @@ -1,9 +1,14 @@ program pouet + provide ao_bielec_integrals_in_map + call bla +end +subroutine bla implicit none integer :: i do i = 1, 10 call diagonalize_CI_sc2_no_amp TOUCH psi_coef enddo + print *, "E+PT2 = ", ci_energy_sc2_no_amp(:) end diff --git a/src/Determinants/print_wf.irp.f b/src/Determinants/print_wf.irp.f index af109e2d..737e4d3e 100644 --- a/src/Determinants/print_wf.irp.f +++ b/src/Determinants/print_wf.irp.f @@ -28,32 +28,32 @@ subroutine routine if(degree == 0)then print*,'Reference determinant ' else - call i_H_j(psi_det(1,1,i),psi_det(1,1,1),N_int,hij) + call i_H_j(psi_det(1,1,i),psi_det(1,1,i),N_int,hij) call get_excitation(psi_det(1,1,1),psi_det(1,1,i),exc,degree,phase,N_int) call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) print*,'phase = ',phase - if(degree == 1)then - print*,'s1',s1 - print*,'h1,p1 = ',h1,p1 - if(s1 == 1)then - norm_mono_a += dabs(psi_coef(i,1)/psi_coef(1,1)) - else - norm_mono_b += dabs(psi_coef(i,1)/psi_coef(1,1)) - endif - print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,list_act(1),list_act(1),p1,mo_integrals_map) - double precision :: hmono,hdouble - call i_H_j_verbose(psi_det(1,1,1),psi_det(1,1,i),N_int,hij,hmono,hdouble) - print*,'hmono = ',hmono - print*,'hdouble = ',hdouble - print*,'hmono+hdouble = ',hmono+hdouble - print*,'hij = ',hij - else - print*,'s1',s1 - print*,'h1,p1 = ',h1,p1 - print*,'s2',s2 - print*,'h2,p2 = ',h2,p2 - print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - endif +! if(degree == 1)then +! print*,'s1',s1 +! print*,'h1,p1 = ',h1,p1 +! if(s1 == 1)then +! norm_mono_a += dabs(psi_coef(i,1)/psi_coef(1,1)) +! else +! norm_mono_b += dabs(psi_coef(i,1)/psi_coef(1,1)) +! endif +! print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,list_act(1),list_act(1),p1,mo_integrals_map) +! double precision :: hmono,hdouble +! call i_H_j_verbose(psi_det(1,1,1),psi_det(1,1,i),N_int,hij,hmono,hdouble) +! print*,'hmono = ',hmono +! print*,'hdouble = ',hdouble +! print*,'hmono+hdouble = ',hmono+hdouble +! print*,'hij = ',hij +! else +! print*,'s1',s1 +! print*,'h1,p1 = ',h1,p1 +! print*,'s2',s2 +! print*,'h2,p2 = ',h2,p2 +! print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! endif print*,' = ',hij endif From 67fded7d18304b199080eb46eac6a072aa876c39 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 30 Jan 2017 20:15:28 +0100 Subject: [PATCH 2/4] work on pt2 stoch --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index f34242ab..48c6c155 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -192,6 +192,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su pt2_detail(:, index(i)) += pt2_mwen(:,i) parts_to_get(index(i)) -= 1 if(parts_to_get(index(i)) < 0) then + print *, "PARTS ??" stop "PARTS ??" end if if(parts_to_get(index(i)) == 0) actually_computed(index(i)) = .true. @@ -206,7 +207,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su time = omp_get_wtime() - if(time - timeLast > 30.0 .or. more /= 1) then + if(time - timeLast > 10.0 .or. more /= 1) then timeLast = time do i=1, first_det_of_teeth(1)-1 if(not(actually_computed(i))) then @@ -258,7 +259,7 @@ integer function pt2_find(v, w) h = N_det-1 do while(h >= l) - i = (h+l)/2 + i = ishft(h+l,-1) if(w(i+1) > v) then h = i-1 else @@ -374,7 +375,7 @@ subroutine reorder_tbc(tbc) ci = 0 do i=1,N_det_generators if(ltbc(i)) then - ci += 1 + ci = ci+1 tbc(ci) = i end if end do @@ -446,7 +447,7 @@ end subroutine comb_step = 1d0/dfloat(comb_teeth) do i=1,N_det_generators - if(pt2_weight(i)/norm_left < comb_step/2d0) then + if(pt2_weight(i)/norm_left < comb_step*.5d0) then first_det_of_comb = i exit end if @@ -462,7 +463,10 @@ end subroutine end do first_det_of_teeth(comb_teeth+1) = N_det_generators + 1 first_det_of_teeth(1) = first_det_of_comb - if(first_det_of_teeth(1) /= first_det_of_comb) stop "comb provider" + if(first_det_of_teeth(1) /= first_det_of_comb) then + print *, 'Error in ', irp_here + stop "comb provider" + endif END_PROVIDER From edc3cde21115de494188877751d2498bc537468b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 31 Jan 2017 21:52:31 +0100 Subject: [PATCH 3/4] Corrected bug in PT2 --- plugins/Full_CI_ZMQ/fci_zmq.irp.f | 4 +- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 94 +++++++++++++------- src/Utils/map_functions.irp.f | 15 +++- src/ZMQ/utils.irp.f | 47 +++++++++- 4 files changed, 117 insertions(+), 43 deletions(-) diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index 31d117a6..a0d1a5ea 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -102,10 +102,10 @@ program fci_zmq threshold_selectors = 1.d0 threshold_generators = 1d0 E_CI_before(1:N_states) = CI_energy(1:N_states) - !call ZMQ_selection(0, pt2)! pour non-stochastic double precision :: relative_error relative_error=1.d-3 - call ZMQ_pt2(pt2,relative_error) + !call ZMQ_pt2(pt2,relative_error) + call ZMQ_selection(0, pt2)! pour non-stochastic print *, 'Final step' print *, 'N_det = ', N_det print *, 'N_states = ', N_states diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 48c6c155..8c9db16d 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -27,16 +27,17 @@ subroutine ZMQ_pt2(pt2,relative_error) double precision, external :: omp_get_wtime double precision :: time0, time - allocate(pt2_detail(N_states, N_det_generators), comb(100000), computed(N_det_generators), tbc(0:N_det_generators)) + allocate(pt2_detail(N_states, N_det_generators), comb(10**5), computed(N_det_generators), tbc(0:size_tbc)) sumabove = 0d0 sum2above = 0d0 Nabove = 0d0 provide nproc - call random_seed() + !call random_seed() computed = .false. + tbc(0) = first_det_of_comb - 1 do i=1, tbc(0) tbc(i) = i @@ -44,19 +45,21 @@ subroutine ZMQ_pt2(pt2,relative_error) end do pt2_detail = 0d0 - time0 = omp_get_wtime() print *, "grep - time - avg - err - n_combs" do while(.true.) + call write_time(6) call new_parallel_job(zmq_to_qp_run_socket,"pt2") call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) call zmq_set_running(zmq_to_qp_run_socket) call create_selection_buffer(1, 1*2, b) ! TODO PARAMETER : 1.d-2 - call get_carlo_workbatch(1d-2, computed, comb, Ncomb, tbc) + Ncomb=size(comb) + call get_carlo_workbatch(1d0, computed, comb, Ncomb, tbc) generator_per_task = 1 + print *, 'Adding tasks...' do i=1,tbc(0) i_generator_end = min(i+generator_per_task-1, tbc(0)) if(tbc(i) > fragment_first) then @@ -71,6 +74,7 @@ subroutine ZMQ_pt2(pt2,relative_error) end do end if end do + call write_time(6) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, relative_error) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() @@ -91,7 +95,7 @@ end subroutine subroutine do_carlo(tbc, Ncomb, comb, pt2_detail, computed, sumabove, sum2above, Nabove) - integer, intent(in) :: tbc(0:N_det_generators), Ncomb + integer, intent(in) :: tbc(0:size_tbc), Ncomb logical, intent(in) :: computed(N_det_generators) double precision, intent(in) :: comb(Ncomb), pt2_detail(N_states, N_det_generators) double precision, intent(inout) :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth) @@ -101,7 +105,7 @@ subroutine do_carlo(tbc, Ncomb, comb, pt2_detail, computed, sumabove, sum2above, mainLoop : do i=1,Ncomb call get_comb(comb(i), dets) do j=1,comb_teeth - if(not(computed(dets(j)))) then + if(.not.(computed(dets(j)))) then exit mainLoop end if end do @@ -109,7 +113,7 @@ subroutine do_carlo(tbc, Ncomb, comb, pt2_detail, computed, sumabove, sum2above, myVal = 0d0 myVal2 = 0d0 do j=comb_teeth,1,-1 - myVal += pt2_detail(1, dets(j)) / pt2_weight(dets(j)) * comb_step + myVal += pt2_detail(1, dets(j)) * pt2_weight_inv(dets(j)) * comb_step sumabove(j) += myVal sum2above(j) += myVal**2 Nabove(j) += 1 @@ -136,7 +140,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su double precision, intent(inout) :: pt2_detail(N_states, N_det_generators) double precision, intent(in) :: comb(Ncomb) logical, intent(inout) :: computed(N_det_generators) - integer, intent(in) :: tbc(0:N_det_generators) + integer, intent(in) :: tbc(0:size_tbc) double precision, intent(inout) :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth), relative_error double precision, intent(out) :: pt2(N_states) @@ -164,7 +168,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su logical, allocatable :: actually_computed(:) allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators)) - actually_computed = computed + actually_computed(:) = computed(:) parts_to_get(:) = 1 if(fragment_first > 0) parts_to_get(1:fragment_first) = fragment_count @@ -192,7 +196,9 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su pt2_detail(:, index(i)) += pt2_mwen(:,i) parts_to_get(index(i)) -= 1 if(parts_to_get(index(i)) < 0) then + print *, i, index(i), parts_to_get(index(i)), Nindex print *, "PARTS ??" + print *, parts_to_get stop "PARTS ??" end if if(parts_to_get(index(i)) == 0) actually_computed(index(i)) = .true. @@ -207,10 +213,10 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su time = omp_get_wtime() - if(time - timeLast > 10.0 .or. more /= 1) then + if(time - timeLast > 1d1 .or. more /= 1) then timeLast = time do i=1, first_det_of_teeth(1)-1 - if(not(actually_computed(i))) then + if(.not.(actually_computed(i))) then print *, "PT2 : deterministic part not finished" cycle pullLoop end if @@ -219,7 +225,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su double precision :: E0, avg, eqt, prop call do_carlo(tbc, Ncomb+1-firstTBDcomb, comb(firstTBDcomb), pt2_detail, actually_computed, sumabove, sum2above, Nabove) firstTBDcomb = Nabove(1) - orgTBDcomb + 1 - if(Nabove(1) < 2.0) cycle + if(Nabove(1) < 2d0) cycle call get_first_tooth(actually_computed, tooth) done = 0 @@ -229,7 +235,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1)) prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1)) - prop = prop / pt2_weight(first_det_of_teeth(tooth)) + prop = prop * pt2_weight_inv(first_det_of_teeth(tooth)) E0 += pt2_detail(1,first_det_of_teeth(tooth)) * prop avg = E0 + (sumabove(tooth) / Nabove(tooth)) eqt = sqrt(1d0 / (Nabove(tooth)-1) * abs(sum2above(tooth) / Nabove(tooth) - (sumabove(tooth)/Nabove(tooth))**2)) @@ -250,9 +256,10 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su end subroutine -integer function pt2_find(v, w) +integer function pt2_find(v, w, sze) implicit none - double precision :: v, w(N_det) + integer, intent(in) :: sze + double precision, intent(in) :: v, w(sze) integer :: i,l,h l = 0 @@ -286,7 +293,7 @@ subroutine get_first_tooth(computed, first_teeth) first_det = 1 first_teeth = 1 do i=first_det_of_comb, N_det_generators - if(not(computed(i))) then + if(.not.(computed(i))) then first_det = i exit end if @@ -309,10 +316,10 @@ subroutine get_last_full_tooth(computed, last_tooth) integer :: i, j, missing last_tooth = 0 - combLoop : do i=comb_teeth-1, 1, -1 - missing = 1+ (first_det_of_teeth(i+1)-first_det_of_teeth(i))/100 + combLoop : do i=comb_teeth, 1, -1 + missing = 1+ ishft(first_det_of_teeth(i+1)-first_det_of_teeth(i),-7) ! /128 do j=first_det_of_teeth(i), first_det_of_teeth(i+1)-1 - if(not(computed(j))) then + if(.not.computed(j)) then missing -= 1 if(missing < 0) cycle combLoop end if @@ -323,29 +330,34 @@ subroutine get_last_full_tooth(computed, last_tooth) end subroutine +BEGIN_PROVIDER [ integer, size_tbc ] + size_tbc = N_det_generators + fragment_count*fragment_first +END_PROVIDER + subroutine get_carlo_workbatch(maxWorkload, computed, comb, Ncomb, tbc) implicit none double precision, intent(in) :: maxWorkload - double precision, intent(out) :: comb(N_det_generators) - integer, intent(inout) :: tbc(0:N_det_generators) - integer, intent(out) :: Ncomb + double precision, intent(out) :: comb(Ncomb) + integer, intent(inout) :: tbc(0:size_tbc) + integer, intent(inout) :: Ncomb logical, intent(inout) :: computed(N_det_generators) integer :: i, j, last_full, dets(comb_teeth) double precision :: myWorkload myWorkload = 0d0 + call RANDOM_NUMBER(comb) do i=1,size(comb) - call RANDOM_NUMBER(comb(i)) comb(i) = comb(i) * comb_step + !DIR$ FORCEINLINE call add_comb(comb(i), computed, tbc, myWorkload) Ncomb = i call get_last_full_tooth(computed, last_full) if(Ncomb >= 30 .and. last_full /= 0) then do j=1,first_det_of_teeth(last_full+1)-1 - if(not(computed(j))) then + if(.not.(computed(j))) then tbc(0) += 1 tbc(tbc(0)) = j computed(j) = .true. @@ -355,25 +367,25 @@ subroutine get_carlo_workbatch(maxWorkload, computed, comb, Ncomb, tbc) end do end if - if(myWorkload > maxWorkload .and. i >= 100) exit + if(myWorkload > maxWorkload) exit end do end subroutine subroutine reorder_tbc(tbc) implicit none - integer, intent(inout) :: tbc(0:N_det_generators) + integer, intent(inout) :: tbc(0:size_tbc) logical, allocatable :: ltbc(:) integer :: i, ci - allocate(ltbc(N_det_generators)) - ltbc = .false. + allocate(ltbc(size_tbc)) + ltbc(:) = .false. do i=1,tbc(0) ltbc(tbc(i)) = .true. end do ci = 0 - do i=1,N_det_generators + do i=1,size_tbc if(ltbc(i)) then ci = ci+1 tbc(ci) = i @@ -392,7 +404,8 @@ subroutine get_comb(stato, dets) curs = 1d0 - stato do j = comb_teeth, 1, -1 - dets(j) = pt2_find(curs, pt2_cweight) + !DIR$ FORCEINLINE + dets(j) = pt2_find(curs, pt2_cweight,N_det_generators) curs -= comb_step end do end subroutine @@ -403,13 +416,14 @@ subroutine add_comb(comb, computed, tbc, workload) double precision, intent(in) :: comb logical, intent(inout) :: computed(N_det_generators) double precision, intent(inout) :: workload - integer, intent(inout) :: tbc(0:N_det_generators) + integer, intent(inout) :: tbc(0:size_tbc) integer :: i, dets(comb_teeth) + !DIR$ FORCEINLINE call get_comb(comb, dets) do i = 1, comb_teeth - if(not(computed(dets(i)))) then + if(.not.(computed(dets(i)))) then tbc(0) += 1 tbc(tbc(0)) = dets(i) workload += comb_workload(dets(i)) @@ -454,11 +468,11 @@ end subroutine norm_left -= pt2_weight(i) end do - comb_step = 1d0 / dfloat(comb_teeth) * (1d0 - pt2_cweight(first_det_of_comb-1)) + comb_step = (1d0 - pt2_cweight(first_det_of_comb-1)) * comb_step stato = 1d0 - comb_step! + 1d-5 do i=comb_teeth, 1, -1 - first_det_of_teeth(i) = pt2_find(stato, pt2_cweight) + first_det_of_teeth(i) = pt2_find(stato, pt2_cweight, N_det_generators) stato -= comb_step end do first_det_of_teeth(comb_teeth+1) = N_det_generators + 1 @@ -470,6 +484,18 @@ end subroutine END_PROVIDER +BEGIN_PROVIDER [ double precision, pt2_weight_inv, (N_det_generators) ] + implicit none + BEGIN_DOC +! Inverse of pt2_weight array + END_DOC + integer :: i + do i=1,N_det_generators + pt2_weight_inv(i) = 1.d0/pt2_weight(i) + enddo + +END_PROVIDER + diff --git a/src/Utils/map_functions.irp.f b/src/Utils/map_functions.irp.f index 68ba342c..e3745d05 100644 --- a/src/Utils/map_functions.irp.f +++ b/src/Utils/map_functions.irp.f @@ -73,10 +73,11 @@ subroutine map_load_from_disk(filename,map) implicit none character*(*), intent(in) :: filename type(map_type), intent(inout) :: map + double precision :: x type(c_ptr) :: c_pointer(3) integer :: fd(3) - integer*8 :: i,k - integer :: n_elements + integer*8 :: i,k, l + integer :: n_elements, j @@ -95,7 +96,9 @@ subroutine map_load_from_disk(filename,map) call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., c_pointer(3)) call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /)) + l = 0_8 k = 1_8 + x = 0.d0 do i=0_8, map % map_size deallocate(map % map(i) % value) deallocate(map % map(i) % key) @@ -106,9 +109,15 @@ subroutine map_load_from_disk(filename,map) k = map % consolidated_idx (i+2) map % map(i) % map_size = n_elements map % map(i) % n_elements = n_elements + ! Load memory from disk + do j=1,n_elements + x = x + map % map(i) % value(j) + l = iand(l,map % map(i) % key(j)) + enddo enddo + map % sorted = x>0 .or. l == 0_8 map % n_elements = k-1 - map % sorted = .True. + map % sorted = map % sorted .or. .True. map % consolidated = .True. end diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 3177d3e3..5ffe9ee2 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -696,8 +696,7 @@ subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task) endif rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) - message = trim(message(1:rc)) - if (trim(message) /= 'ok') then + if (message(1:rc) /= 'ok') then print *, trim(task) print *, 'Unable to add the next task' stop -1 @@ -705,6 +704,47 @@ subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task) end +subroutine add_task_to_taskserver_send(zmq_to_qp_run_socket,task) + use f77_zmq + implicit none + BEGIN_DOC + ! Get a task from the task server + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + character*(*), intent(in) :: task + + integer :: rc, sze + character*(512) :: message + write(message,*) 'add_task '//trim(zmq_state)//' '//trim(task) + + sze = len(trim(message)) + rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0) + if (rc /= sze) then + print *, rc, sze + print *, irp_here,': f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)' + stop 'error' + endif + +end + +subroutine add_task_to_taskserver_recv(zmq_to_qp_run_socket) + use f77_zmq + implicit none + BEGIN_DOC + ! Get a task from the task server + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + + integer :: rc, sze + character*(512) :: message + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + if (message(1:rc) /= 'ok') then + print *, 'Unable to add the next task' + stop -1 + endif + +end + subroutine task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_id) use f77_zmq implicit none @@ -726,8 +766,7 @@ subroutine task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_id) endif rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) - message = trim(message(1:rc)) - if (trim(message) /= 'ok') then + if (trim(message(1:rc)) /= 'ok') then print *, 'Unable to send task_done message' stop -1 endif From aac30f9b66be285605b58980b29a809db0261718 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 1 Feb 2017 11:29:17 +0100 Subject: [PATCH 4/4] Removed PUSH/PULL --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 170 +++++++++++------- plugins/Full_CI_ZMQ/run_pt2_slave.irp.f | 4 +- plugins/Full_CI_ZMQ/run_selection_slave.irp.f | 4 +- .../ao_bielec_integrals_in_map_slave.irp.f | 22 +-- src/ZMQ/utils.irp.f | 8 +- 5 files changed, 123 insertions(+), 85 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 8c9db16d..b96cf883 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -10,7 +10,7 @@ subroutine ZMQ_pt2(pt2,relative_error) implicit none character*(512) :: task - integer(ZMQ_PTR) :: zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_to_qp_run_socket2 type(selection_buffer) :: b integer, external :: omp_get_thread_num double precision, intent(in) :: relative_error @@ -27,12 +27,12 @@ subroutine ZMQ_pt2(pt2,relative_error) double precision, external :: omp_get_wtime double precision :: time0, time - allocate(pt2_detail(N_states, N_det_generators), comb(10**5), computed(N_det_generators), tbc(0:size_tbc)) + allocate(pt2_detail(N_states, N_det_generators), comb(N_det_generators), computed(N_det_generators), tbc(0:size_tbc)) sumabove = 0d0 sum2above = 0d0 Nabove = 0d0 - provide nproc + provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral !call random_seed() @@ -47,42 +47,63 @@ subroutine ZMQ_pt2(pt2,relative_error) pt2_detail = 0d0 time0 = omp_get_wtime() print *, "grep - time - avg - err - n_combs" + generator_per_task = 1 do while(.true.) call write_time(6) call new_parallel_job(zmq_to_qp_run_socket,"pt2") call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) - call zmq_set_running(zmq_to_qp_run_socket) call create_selection_buffer(1, 1*2, b) - ! TODO PARAMETER : 1.d-2 Ncomb=size(comb) - call get_carlo_workbatch(1d0, computed, comb, Ncomb, tbc) - generator_per_task = 1 - print *, 'Adding tasks...' - do i=1,tbc(0) - i_generator_end = min(i+generator_per_task-1, tbc(0)) - if(tbc(i) > fragment_first) then - integer :: zero - zero = 0 - write(task,*) (i_generator_end-i+1), zero, tbc(i:i_generator_end) - call add_task_to_taskserver(zmq_to_qp_run_socket,task) - else - do j=1,fragment_count - write(task,*) (i_generator_end-i+1), j, tbc(i:i_generator_end) - call add_task_to_taskserver(zmq_to_qp_run_socket,task) - end do - end if - end do + call get_carlo_workbatch(computed, comb, Ncomb, tbc) + call write_time(6) - !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, relative_error) PRIVATE(i) NUM_THREADS(nproc+1) + + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + + !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, relative_error) NUM_THREADS(nproc+1) & + !$OMP PRIVATE(i,zmq_to_qp_run_socket2,i_generator_end,task,j) + zmq_to_qp_run_socket2 = new_zmq_to_qp_run_socket() + + !$OMP DO SCHEDULE(static,1) + do i=1,min(2000,tbc(0)) + i_generator_end = min(i+generator_per_task-1, tbc(0)) + if(tbc(i) > fragment_first) then + write(task,*) (i_generator_end-i+1), 0, tbc(i:i_generator_end) + call add_task_to_taskserver(zmq_to_qp_run_socket2,task) + else + do j=1,fragment_count + write(task,*) (i_generator_end-i+1), j, tbc(i:i_generator_end) + call add_task_to_taskserver(zmq_to_qp_run_socket2,task) + end do + end if + end do + !$OMP END DO NOWAIT + i = omp_get_thread_num() if (i==0) then + call zmq_set_running(zmq_to_qp_run_socket) call pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, sum2above, Nabove, relative_error, pt2) + else if (i==1) then + do i=2001,tbc(0) + i_generator_end = min(i+generator_per_task-1, tbc(0)) + if(tbc(i) > fragment_first) then + write(task,*) (i_generator_end-i+1), 0, tbc(i:i_generator_end) + call add_task_to_taskserver(zmq_to_qp_run_socket2,task) + else + do j=1,fragment_count + write(task,*) (i_generator_end-i+1), j, tbc(i:i_generator_end) + call add_task_to_taskserver(zmq_to_qp_run_socket2,task) + end do + end if + end do + call pt2_slave_inproc(1) else call pt2_slave_inproc(i) endif + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket2) !$OMP END PARALLEL call end_parallel_job(zmq_to_qp_run_socket, 'pt2') tbc(0) = 0 @@ -317,7 +338,7 @@ subroutine get_last_full_tooth(computed, last_tooth) last_tooth = 0 combLoop : do i=comb_teeth, 1, -1 - missing = 1+ ishft(first_det_of_teeth(i+1)-first_det_of_teeth(i),-7) ! /128 + missing = 1+ ishft(first_det_of_teeth(i+1)-first_det_of_teeth(i),-6) ! /64 do j=first_det_of_teeth(i), first_det_of_teeth(i+1)-1 if(.not.computed(j)) then missing -= 1 @@ -334,41 +355,57 @@ BEGIN_PROVIDER [ integer, size_tbc ] size_tbc = N_det_generators + fragment_count*fragment_first END_PROVIDER - -subroutine get_carlo_workbatch(maxWorkload, computed, comb, Ncomb, tbc) +subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc) implicit none - double precision, intent(in) :: maxWorkload double precision, intent(out) :: comb(Ncomb) integer, intent(inout) :: tbc(0:size_tbc) integer, intent(inout) :: Ncomb logical, intent(inout) :: computed(N_det_generators) - integer :: i, j, last_full, dets(comb_teeth) - double precision :: myWorkload + integer :: i, j, last_full, dets(comb_teeth), tbc_save - myWorkload = 0d0 - call RANDOM_NUMBER(comb) - do i=1,size(comb) - comb(i) = comb(i) * comb_step - !DIR$ FORCEINLINE - call add_comb(comb(i), computed, tbc, myWorkload) - Ncomb = i - - call get_last_full_tooth(computed, last_full) - if(Ncomb >= 30 .and. last_full /= 0) then - do j=1,first_det_of_teeth(last_full+1)-1 - if(.not.(computed(j))) then - tbc(0) += 1 - tbc(tbc(0)) = j - computed(j) = .true. - myWorkload += comb_workload(j) - print *, "filled ", j, "to reach tooth", last_full, "ending at", first_det_of_teeth(last_full+1) - end if + do j=1,size(comb),100 + do i=j,min(size(comb),j+99) + comb(i) = comb(i) * comb_step + tbc_save = tbc(0) + !DIR$ FORCEINLINE + call add_comb(comb(i), computed, tbc, size_tbc, comb_teeth) + if (tbc(0) < size(tbc)) then + Ncomb = i + else + tbc(0) = tbc_save + return + endif end do - end if + call get_filling_teeth(computed, tbc) + enddo + +end subroutine + + +subroutine get_filling_teeth(computed, tbc) + implicit none + integer, intent(inout) :: tbc(0:size_tbc) + logical, intent(inout) :: computed(N_det_generators) + integer :: i, j, k, last_full, dets(comb_teeth) + + call get_last_full_tooth(computed, last_full) + if(last_full /= 0) then + if (tbc(0) > size(tbc) - first_det_of_teeth(last_full+1) -2) then + return + endif + k = tbc(0)+1 + do j=1,first_det_of_teeth(last_full+1)-1 + if(.not.(computed(j))) then + tbc(k) = j + k=k+1 + computed(j) = .true. +! print *, "filled ", j, "to reach tooth", last_full, "ending at", first_det_of_teeth(last_full+1) + end if + end do + tbc(0) = k-1 + end if - if(myWorkload > maxWorkload) exit - end do end subroutine @@ -394,10 +431,11 @@ subroutine reorder_tbc(tbc) end subroutine -subroutine get_comb(stato, dets) +subroutine get_comb(stato, dets, ct) implicit none + integer, intent(in) :: ct double precision, intent(in) :: stato - integer, intent(out) :: dets(comb_teeth) + integer, intent(out) :: dets(ct) double precision :: curs integer :: j integer, external :: pt2_find @@ -405,38 +443,39 @@ subroutine get_comb(stato, dets) curs = 1d0 - stato do j = comb_teeth, 1, -1 !DIR$ FORCEINLINE - dets(j) = pt2_find(curs, pt2_cweight,N_det_generators) + dets(j) = pt2_find(curs, pt2_cweight,size(pt2_cweight)) curs -= comb_step end do end subroutine -subroutine add_comb(comb, computed, tbc, workload) +subroutine add_comb(comb, computed, tbc, stbc, ct) implicit none + integer, intent(in) :: stbc, ct double precision, intent(in) :: comb logical, intent(inout) :: computed(N_det_generators) - double precision, intent(inout) :: workload - integer, intent(inout) :: tbc(0:size_tbc) - integer :: i, dets(comb_teeth) + integer, intent(inout) :: tbc(0:stbc) + integer :: i, k, l, dets(ct) !DIR$ FORCEINLINE - call get_comb(comb, dets) + call get_comb(comb, dets, ct) - do i = 1, comb_teeth - if(.not.(computed(dets(i)))) then - tbc(0) += 1 - tbc(tbc(0)) = dets(i) - workload += comb_workload(dets(i)) - computed(dets(i)) = .true. + k=tbc(0)+1 + do i = 1, ct + l = dets(i) + if(.not.(computed(l))) then + tbc(k) = l + k = k+1 + computed(l) = .true. end if end do + tbc(0) = k-1 end subroutine BEGIN_PROVIDER [ double precision, pt2_weight, (N_det_generators) ] &BEGIN_PROVIDER [ double precision, pt2_cweight, (N_det_generators) ] -&BEGIN_PROVIDER [ double precision, comb_workload, (N_det_generators) ] &BEGIN_PROVIDER [ double precision, comb_step ] &BEGIN_PROVIDER [ integer, first_det_of_teeth, (comb_teeth+1) ] &BEGIN_PROVIDER [ integer, first_det_of_comb ] @@ -455,7 +494,6 @@ end subroutine pt2_weight = pt2_weight / pt2_cweight(N_det_generators) pt2_cweight = pt2_cweight / pt2_cweight(N_det_generators) - comb_workload = 1d0 / dfloat(N_det_generators) norm_left = 1d0 diff --git a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f index 949a6d28..070d3f97 100644 --- a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f @@ -124,7 +124,7 @@ subroutine push_pt2_results(zmq_socket_push, N, index, pt2_detail, task_id, ntas if(rc /= 4*ntask) stop "push" ! Activate is zmq_socket_push is a REQ -! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) + rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) end subroutine @@ -154,7 +154,7 @@ subroutine pull_pt2_results(zmq_socket_pull, N, index, pt2_detail, task_id, ntas if(rc /= 4*ntask) stop "pull" ! Activate is zmq_socket_pull is a REP -! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) + rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) end subroutine diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f index 7d48e5c0..5bf00a1d 100644 --- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f @@ -115,7 +115,7 @@ subroutine push_selection_results(zmq_socket_push, pt2, b, task_id, ntask) if(rc /= 4*ntask) stop "push" ! Activate is zmq_socket_push is a REQ -! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) + rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) end subroutine @@ -149,7 +149,7 @@ subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, nt if(rc /= 4*ntask) stop "pull" ! Activate is zmq_socket_pull is a REP -! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) + rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) end subroutine 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 ce4518cf..38c78388 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 @@ -187,11 +187,11 @@ subroutine ao_bielec_integrals_in_map_collector rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) ! 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 call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 5ffe9ee2..9e28aff5 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -235,8 +235,8 @@ function new_zmq_pull_socket() if (zmq_context == 0_ZMQ_PTR) then stop 'zmq_context is uninitialized' endif - 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' @@ -312,8 +312,8 @@ function new_zmq_push_socket(thread) if (zmq_context == 0_ZMQ_PTR) then stop 'zmq_context is uninitialized' endif - 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'