From f65aae95384225da778ec03fa4b1ae376b842fff Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 4 Mar 2016 16:52:46 +0100 Subject: [PATCH 01/42] init mrcepa0 --- plugins/MRCC_Utils/mrcc_utils.irp.f | 13 ++ plugins/mrcepa0/dressing.irp.f | 234 ++++++++++++++++++++++++++ plugins/mrcepa0/mrcepa0.irp.f | 24 +++ plugins/mrcepa0/mrcepa0_general.irp.f | 96 +++++++++++ 4 files changed, 367 insertions(+) create mode 100644 plugins/mrcepa0/dressing.irp.f create mode 100644 plugins/mrcepa0/mrcepa0.irp.f create mode 100644 plugins/mrcepa0/mrcepa0_general.irp.f diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 1e2f974d..866a6e3b 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -110,6 +110,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref,N_det_ref,N_states) ] implicit none BEGIN_DOC ! Dressing matrix in N_det basis @@ -117,6 +118,7 @@ END_PROVIDER integer :: i,j,m delta_ij = 0.d0 delta_ii = 0.d0 + call H_apply_mrcc(delta_ij,delta_ii,N_det_ref,N_det_non_ref) double precision :: max_delta double precision :: accu @@ -157,6 +159,17 @@ BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] h_matrix_dressed(i,j,istate) = h_matrix_all_dets(i,j) enddo enddo + + !!!!!!!!!! + do ii = 1, N_det_ref + do jj = 1, N_det_ref + i = idx_ref(ii) + j = idx_ref(jj) + h_matrix_dressed(i,j,istate) += delta_cas(ii,jj,istate) + h_matrix_dressed(j,i,istate) += delta_cas(ii,jj,istate) + end do + end do + !!!!!!!!!!!!! do ii = 1, N_det_ref i =idx_ref(ii) h_matrix_dressed(i,i,istate) += delta_ii(ii,istate) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f new file mode 100644 index 00000000..53a9417b --- /dev/null +++ b/plugins/mrcepa0/dressing.irp.f @@ -0,0 +1,234 @@ +use bitmasks + + + BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] +&BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_det_non_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_det_ref) ] + use bitmasks + implicit none + + integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), active_sorb(2) + integer i, II, j, k + logical, external :: detEq + + print *, "provide cepa0" + active_sorb = (/b'001100000000', b'001100000000'/) + do i=1, N_det_non_ref + det_noactive(1,1,i) = iand(psi_non_ref(1,1,i), not(active_sorb(1))) + det_noactive(1,2,i) = iand(psi_non_ref(1,2,i), not(active_sorb(2))) + end do + + call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) + do i=1,N_det_ref + det_ref_active(i) = iand(psi_ref(1,1,i), active_sorb(1)) + det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 + end do + + cepa0_shortcut(0) = 1 + cepa0_shortcut(1) = 1 + det_cepa0_active(1) = iand(psi_non_ref(1,1,det_cepa0_idx(1)), active_sorb(1)) + det_cepa0_active(1) = det_cepa0_active(1) + iand(psi_non_ref(1,2,det_cepa0_idx(1)), active_sorb(2)) * 2_8**32_8 + + do i=2,N_det_non_ref + det_cepa0_active(i) = iand(psi_non_ref(1,1,det_cepa0_idx(i)), active_sorb(1)) + det_cepa0_active(i) = det_cepa0_active(i) + iand(psi_non_ref(1,2,det_cepa0_idx(i)), active_sorb(2)) * 2_8**32_8 + + if(.not. detEq(det_noactive(1,1,i), det_noactive(1,1,i-1), N_int)) then + cepa0_shortcut(0) += 1 + cepa0_shortcut(cepa0_shortcut(0)) = i + end if + end do + cepa0_shortcut(0) += 1 + cepa0_shortcut(cepa0_shortcut(0)) = N_det_non_ref+1 + +END_PROVIDER + + + + BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] + use bitmasks + implicit none + integer :: i,j,k + double precision :: Hjk, Hki + integer i_state + + i_state = 1 + + do i=1,N_det_ref + do j=1,i + delta_cas(i,j,i_state) = 0d0 + do k=1,N_det_non_ref + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) + call i_h_j(psi_ref(1,1,i), psi_non_ref(1,1,k),N_int,Hki) + delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) + end do + delta_cas(j,i,i_state) = delta_cas(i,j,i_state) + end do + end do + + print *, "mrcepa0_cas_dressing", delta_cas(:,:,1) + END_PROVIDER + +logical function detEq(a,b,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) + integer :: ni, i + + detEq = .false. + do i=1,2 + do ni=1,Nint + if(a(ni,i) /= b(ni,i)) return + end do + end do + detEq = .true. +end function + + + + BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: contrib + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + + integer :: II, blok + + provide det_cepa0_active + + if(N_int /= 1) then + print *, "mrcepa0 experimental N_int==1" + stop + end if + + i_state = 1 + delta_ii(:,:) = 0 + delta_ij(:,:,:) = 0 + +! do i=1,N_det_ref +! delta_ii(i,i_state) = delta_cas(i,i) +! end do + + provide mo_bielec_integrals_in_map + allocate(idx_sorted_bit(N_det)) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + + !sd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij, delta_ii) + do blok=1,cepa0_shortcut(0) + do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do II=1,N_det_ref + + made_hole = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) + + if(popcnt(made_hole) + popcnt(made_particle) > 2) cycle + + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do J=1,N_det_ref + if(iand(made_hole, det_ref_active(J)) /= made_hole) cycle + if(iand(made_particle, det_ref_active(J)) /= 0) cycle + call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,det_cepa0_idx(k)),N_int,Hki) + contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state) + delta_ij(II, det_cepa0_idx(i), i_state) += contrib + +! if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then +! !qs$OMP CRITICAL +! delta_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) +! !dsd$OMP END CRITICAL +! endif + + end do + end do + end do + end do + end do + !qsd $OMP END PARALLEL DO + deallocate(idx_sorted_bit) +END_PROVIDER + + +subroutine set_det_bit(det, p, s) + use bitmasks + implicit none + integer(bit_kind),intent(inout) :: det(N_int, 2) + integer, intent(in) :: p, s + integer :: ni, pos + + ni = (p-1)/bit_kind_size + 1 + pos = mod(p-1, bit_kind_size) + det(ni,s) = ibset(det(ni,s), pos) +end subroutine + + + +subroutine apply_excitation(det, exc, res, ok, Nint) + use bitmasks + implicit none + + integer, intent(in) :: Nint + integer, intent(in) :: exc(0:2,2,2) + integer(bit_kind),intent(in) :: det(Nint, 2) + integer(bit_kind),intent(out) :: res(Nint, 2) + logical, intent(out) :: ok + integer :: h1,p1,h2,p2,s1,s2,degree + integer :: ii, pos + + + ok = .false. + degree = exc(0,1,1) + exc(0,1,2) + if(.not. (degree > 0 .and. degree <= 2)) then + print *, "apply ex" + STOP + endif + + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + res = det + + ii = (h1-1)/bit_kind_size + 1 + pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s1) = ibclr(res(ii, s1), pos) + + ii = (p1-1)/bit_kind_size + 1 + pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s1) = ibset(res(ii, s1), pos) + + if(degree == 2) then + ii = (h2-1)/bit_kind_size + 1 + pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s2) = ibclr(res(ii, s2), pos) + + ii = (p2-1)/bit_kind_size + 1 + pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s2) = ibset(res(ii, s2), pos) + endif + + ok = .true. +end subroutine + + + + + + + + diff --git a/plugins/mrcepa0/mrcepa0.irp.f b/plugins/mrcepa0/mrcepa0.irp.f new file mode 100644 index 00000000..b9eb2fc5 --- /dev/null +++ b/plugins/mrcepa0/mrcepa0.irp.f @@ -0,0 +1,24 @@ +program mrcepa0 + implicit none + if (.not.read_wf) then + print *, 'read_wf has to be true.' + stop 1 + endif + call print_cas_coefs + call run_mrcepa0 +end + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, psi_cas_coef(i,:) + call debug_det(psi_cas(1,1,i),N_int) + enddo + + call write_double(6,ci_energy(1),"Initial CI energy") +end + diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f new file mode 100644 index 00000000..3f892887 --- /dev/null +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -0,0 +1,96 @@ +subroutine run_mrcepa0 + implicit none + call set_generators_bitmasks_as_holes_and_particles + call mrcepa0_iterations +end + +subroutine mrcepa0_iterations + implicit none + + integer :: i,j + + double precision :: E_new, E_old, delta_e + integer :: iteration,i_oscillations + double precision :: E_past(4) + E_new = 0.d0 + delta_E = 1.d0 + iteration = 0 + j = 1 + i_oscillations = 0 + do while (delta_E > 1.d-7) + iteration += 1 + print *, '===========================' + print *, 'MRCEPA0 Iteration', iteration + print *, '===========================' + print *, '' + E_old = sum(ci_energy_dressed) + call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") + call diagonalize_ci_dressed + E_new = sum(ci_energy_dressed) + delta_E = dabs(E_new - E_old) + E_past(j) = E_new + j +=1 + if(j>4)then + j=1 + endif + if(iteration > 4) then + if(delta_E > 1.d-10)then + if(dabs(E_past(1) - E_past(3)) .le. delta_E .and. dabs(E_past(2) - E_past(4)).le. delta_E)then + print*,'OSCILLATIONS !!!' +! oscillations = .True. + i_oscillations +=1 + lambda_mrcc_tmp = lambda_mrcc + endif + endif + endif + call save_wavefunction +! if (i_oscillations > 5) then +! exit +! endif + if (iteration > 100) then + exit + endif + print*,'------------' + print*,'VECTOR' + do i = 1, N_det_ref + print*,'' + print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) + print*,'delta_ii(i,1) = ',delta_ii(i,1) + enddo + print*,'------------' + enddo + call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") + call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) + call save_wavefunction + +end + +subroutine set_generators_bitmasks_as_holes_and_particles + implicit none + integer :: i,k + do k = 1, N_generators_bitmask + do i = 1, N_int + ! Pure single part + generators_bitmask(i,1,1,k) = holes_operators(i,1) ! holes for pure single exc alpha + generators_bitmask(i,1,2,k) = particles_operators(i,1) ! particles for pure single exc alpha + generators_bitmask(i,2,1,k) = holes_operators(i,2) ! holes for pure single exc beta + generators_bitmask(i,2,2,k) = particles_operators(i,2) ! particles for pure single exc beta + + ! Double excitation + generators_bitmask(i,1,3,k) = holes_operators(i,1) ! holes for first single exc alpha + generators_bitmask(i,1,4,k) = particles_operators(i,1) ! particles for first single exc alpha + generators_bitmask(i,2,3,k) = holes_operators(i,2) ! holes for first single exc beta + generators_bitmask(i,2,4,k) = particles_operators(i,2) ! particles for first single exc beta + + generators_bitmask(i,1,5,k) = holes_operators(i,1) ! holes for second single exc alpha + generators_bitmask(i,1,6,k) = particles_operators(i,1) ! particles for second single exc alpha + generators_bitmask(i,2,5,k) = holes_operators(i,2) ! holes for second single exc beta + generators_bitmask(i,2,6,k) = particles_operators(i,2) ! particles for second single exc beta + + enddo + enddo + touch generators_bitmask + + + +end From 7f583946c27ccb9b4689790ce29b2f45f56d4553 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 11 Mar 2016 19:35:57 +0100 Subject: [PATCH 02/42] experimental mrcepa0/mrsc2 --- ocaml/.gitignore | 1 - ocaml/qp_edit.ml | 66 ++-- plugins/MRCC_Utils/davidson.irp.f | 1 - plugins/MRCC_Utils/mrcc_utils.irp.f | 21 +- plugins/mrcepa0/dressing.irp.f | 439 +++++++++++++++++++++++--- plugins/mrcepa0/mrcepa0_general.irp.f | 2 +- 6 files changed, 432 insertions(+), 98 deletions(-) diff --git a/ocaml/.gitignore b/ocaml/.gitignore index 45d71ee3..0f0c1ef9 100644 --- a/ocaml/.gitignore +++ b/ocaml/.gitignore @@ -4,7 +4,6 @@ ezfio.ml Git.ml Input_auto_generated.ml Input_determinants.ml -Input_foboci.ml Input_hartree_fock.ml Input_integrals_bielec.ml Input_perturbation.ml diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index 67dc9501..409387b2 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -17,13 +17,12 @@ type keyword = | Electrons | Mo_basis | Nuclei -| Hartree_fock -| Pseudo -| Integrals_bielec -| Perturbation -| Properties -| Foboci | Determinants +| Integrals_bielec +| Pseudo +| Perturbation +| Hartree_fock +| Properties ;; @@ -33,13 +32,12 @@ let keyword_to_string = function | Electrons -> "Electrons" | Mo_basis -> "MO basis" | Nuclei -> "Molecule" -| Hartree_fock -> "Hartree_fock" -| Pseudo -> "Pseudo" -| Integrals_bielec -> "Integrals_bielec" -| Perturbation -> "Perturbation" -| Properties -> "Properties" -| Foboci -> "Foboci" | Determinants -> "Determinants" +| Integrals_bielec -> "Integrals_bielec" +| Pseudo -> "Pseudo" +| Perturbation -> "Perturbation" +| Hartree_fock -> "Hartree_fock" +| Properties -> "Properties" ;; @@ -88,20 +86,18 @@ let get s = f Ao_basis.(read, to_rst) | Determinants_by_hand -> f Determinants_by_hand.(read, to_rst) - | Hartree_fock -> - f Hartree_fock.(read, to_rst) - | Pseudo -> - f Pseudo.(read, to_rst) - | Integrals_bielec -> - f Integrals_bielec.(read, to_rst) - | Perturbation -> - f Perturbation.(read, to_rst) - | Properties -> - f Properties.(read, to_rst) - | Foboci -> - f Foboci.(read, to_rst) | Determinants -> f Determinants.(read, to_rst) + | Integrals_bielec -> + f Integrals_bielec.(read, to_rst) + | Pseudo -> + f Pseudo.(read, to_rst) + | Perturbation -> + f Perturbation.(read, to_rst) + | Hartree_fock -> + f Hartree_fock.(read, to_rst) + | Properties -> + f Properties.(read, to_rst) end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") @@ -139,13 +135,12 @@ let set str s = in let open Input in match s with - | Hartree_fock -> write Hartree_fock.(of_rst, write) s - | Pseudo -> write Pseudo.(of_rst, write) s - | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s - | Perturbation -> write Perturbation.(of_rst, write) s - | Properties -> write Properties.(of_rst, write) s - | Foboci -> write Foboci.(of_rst, write) s | Determinants -> write Determinants.(of_rst, write) s + | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s + | Pseudo -> write Pseudo.(of_rst, write) s + | Perturbation -> write Perturbation.(of_rst, write) s + | Hartree_fock -> write Hartree_fock.(of_rst, write) s + | Properties -> write Properties.(of_rst, write) s | Electrons -> write Electrons.(of_rst, write) s | Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s | Nuclei -> write Nuclei.(of_rst, write) s @@ -193,13 +188,12 @@ let run check_only ezfio_filename = Nuclei ; Ao_basis; Electrons ; - Hartree_fock ; - Pseudo ; - Integrals_bielec ; - Perturbation ; - Properties ; - Foboci ; Determinants ; + Integrals_bielec ; + Pseudo ; + Perturbation ; + Hartree_fock ; + Properties ; Mo_basis; Determinants_by_hand ; ] diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index 6752afcb..d278ba13 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -359,7 +359,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin y, & lambda & ) - abort_here = abort_all end diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 866a6e3b..155c52ae 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -1,3 +1,4 @@ + BEGIN_PROVIDER [integer, pert_determinants, (N_states, psi_det_size) ] END_PROVIDER @@ -47,6 +48,7 @@ endif enddo endif + i_pert = 0 if( i_pert == 1)then pert_determinants(k,i) = i_pert endif @@ -110,7 +112,6 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref,N_det_ref,N_states) ] implicit none BEGIN_DOC ! Dressing matrix in N_det basis @@ -118,7 +119,6 @@ END_PROVIDER integer :: i,j,m delta_ij = 0.d0 delta_ii = 0.d0 - call H_apply_mrcc(delta_ij,delta_ii,N_det_ref,N_det_non_ref) double precision :: max_delta double precision :: accu @@ -135,6 +135,7 @@ END_PROVIDER endif enddo enddo + !stop "movais delta" print*,'' print*,'' print*,' = ',accu @@ -159,17 +160,6 @@ BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] h_matrix_dressed(i,j,istate) = h_matrix_all_dets(i,j) enddo enddo - - !!!!!!!!!! - do ii = 1, N_det_ref - do jj = 1, N_det_ref - i = idx_ref(ii) - j = idx_ref(jj) - h_matrix_dressed(i,j,istate) += delta_cas(ii,jj,istate) - h_matrix_dressed(j,i,istate) += delta_cas(ii,jj,istate) - end do - end do - !!!!!!!!!!!!! do ii = 1, N_det_ref i =idx_ref(ii) h_matrix_dressed(i,i,istate) += delta_ii(ii,istate) @@ -272,11 +262,14 @@ subroutine diagonalize_CI_dressed ! eigenstates of the CI matrix END_DOC integer :: i,j + double precision, parameter :: speed = 1d0 + do j=1,N_states_diag do i=1,N_det - psi_coef(i,j) = CI_eigenvectors_dressed(i,j) + psi_coef(i,j) = CI_eigenvectors_dressed(i,j) * speed + psi_coef(i,j) * (1d0 - speed) enddo enddo SOFT_TOUCH psi_coef end + diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 53a9417b..30b161d4 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -1,30 +1,63 @@ use bitmasks + + BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] + use bitmasks + implicit none + +! delta_ij(:,:,:) = delta_ij_old(:,:,:) +! delta_ii(:,:) = delta_ii_old(:,:) + delta_ij(:,:,:) = delta_mrcepa0_ij(:,:,:)! - delta_sub_ij(:,:,:) + delta_ii(:,:)= delta_mrcepa0_ii(:,:)! - delta_sub_ii(:,:) +END_PROVIDER + + + BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] &BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_det_non_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_det_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (2) ] use bitmasks implicit none - integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), active_sorb(2) + integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(2) integer i, II, j, k logical, external :: detEq print *, "provide cepa0" - active_sorb = (/b'001100000000', b'001100000000'/) + active_sorb(:) = 0_8 + nonactive_sorb(:) = not(0_8) + + if(N_det_ref > 1) then + do i=1, N_det_ref + active_sorb(1) = ior(psi_ref(1,1,i), active_sorb(1)) + active_sorb(2) = ior(psi_ref(1,2,i), active_sorb(2)) + nonactive_sorb(1) = iand(psi_ref(1,1,i), nonactive_sorb(1)) + nonactive_sorb(2) = iand(psi_ref(1,2,i), nonactive_sorb(2)) + end do + active_sorb(1) = iand(active_sorb(1), not(nonactive_sorb(1))) + active_sorb(2) = iand(active_sorb(2), not(nonactive_sorb(2))) + end if + do i=1, N_det_non_ref det_noactive(1,1,i) = iand(psi_non_ref(1,1,i), not(active_sorb(1))) det_noactive(1,2,i) = iand(psi_non_ref(1,2,i), not(active_sorb(2))) end do call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) + +! do i=1, N_det_non_ref +! print "(B30,B30)", det_noactive(1,1,i), det_noactive(1,2,i) +! end do +! stop do i=1,N_det_ref det_ref_active(i) = iand(psi_ref(1,1,i), active_sorb(1)) det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 end do - + cepa0_shortcut(0) = 1 cepa0_shortcut(1) = 1 det_cepa0_active(1) = iand(psi_non_ref(1,1,det_cepa0_idx(1)), active_sorb(1)) @@ -39,8 +72,8 @@ use bitmasks cepa0_shortcut(cepa0_shortcut(0)) = i end if end do - cepa0_shortcut(0) += 1 - cepa0_shortcut(cepa0_shortcut(0)) = N_det_non_ref+1 + !cepa0_shortcut(0) += 1 + cepa0_shortcut(cepa0_shortcut(0)+1) = N_det_non_ref+1 END_PROVIDER @@ -50,24 +83,22 @@ END_PROVIDER use bitmasks implicit none integer :: i,j,k - double precision :: Hjk, Hki + double precision :: Hjk, Hki, Hij, mat(2,2) integer i_state + provide lambda_mrcc i_state = 1 - do i=1,N_det_ref do j=1,i delta_cas(i,j,i_state) = 0d0 do k=1,N_det_non_ref call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) - call i_h_j(psi_ref(1,1,i), psi_non_ref(1,1,k),N_int,Hki) + call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) end do delta_cas(j,i,i_state) = delta_cas(i,j,i_state) end do end do - - print *, "mrcepa0_cas_dressing", delta_cas(:,:,1) END_PROVIDER logical function detEq(a,b,Nint) @@ -88,8 +119,9 @@ end function - BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] + + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] use bitmasks implicit none @@ -99,14 +131,14 @@ end function double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) double precision :: contrib integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle + integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction integer :: II, blok - provide det_cepa0_active + provide det_cepa0_active delta_cas lambda_mrcc if(N_int /= 1) then print *, "mrcepa0 experimental N_int==1" @@ -114,11 +146,11 @@ end function end if i_state = 1 - delta_ii(:,:) = 0 - delta_ij(:,:,:) = 0 - + delta_mrcepa0_ii(:,:) = 0d0 + delta_mrcepa0_ij(:,:,:) = 0d0 + ! do i=1,N_det_ref -! delta_ii(i,i_state) = delta_cas(i,i) +! delta_ii(i,i_state) = delta_cas(i,i,i_state) ! end do provide mo_bielec_integrals_in_map @@ -128,53 +160,370 @@ end function do i=1,N_det_non_ref idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - - !sd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij, delta_ii) + !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij, delta_ii) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref - made_hole = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) - made_particle = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) - - if(popcnt(made_hole) + popcnt(made_particle) > 2) cycle + made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) + if (degree > 2 .or. popcnt(made_hole) * popcnt(made_particle) /= degree*2) cycle do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + if(iand(not(active_sorb(1)), xor(psi_non_ref(1,1,det_cepa0_idx(k)), psi_non_ref(1,1,det_cepa0_idx(i)))) /= 0) stop "STOOOP" + !do k=1,N_det_non_ref + if(iand(made_hole, det_cepa0_active(k)) /= 0) cycle + if(iand(made_particle, det_cepa0_active(k)) /= made_particle) cycle + myActive = xor(det_cepa0_active(k), made_hole) + myActive = xor(myActive, made_particle) + if(i==k .and. myActive /= det_ref_active(II)) stop "AAAA" + !if(i==k) print *, "i=k" do J=1,N_det_ref - if(iand(made_hole, det_ref_active(J)) /= made_hole) cycle - if(iand(made_particle, det_ref_active(J)) /= 0) cycle - call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,det_cepa0_idx(k)),N_int,Hki) - contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state) - delta_ij(II, det_cepa0_idx(i), i_state) += contrib + if(det_ref_active(J) /= myActive) cycle -! if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then -! !qs$OMP CRITICAL -! delta_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) -! !dsd$OMP END CRITICAL -! endif - + !!!!! + call get_excitation_degree(psi_ref(1,1,J),psi_non_ref(1,1,det_cepa0_idx(k)),degree,N_int) + if(degree > 2) stop "BBBB" + !!!!!!!!! +! if(i/=k .and. popcnt(made_hole) /= popcnt(made_particle)) then +! print *, "=================", made_hole, made_particle +! call debug_det(psi_ref(1,1,II),N_int) +! call debug_det(psi_non_ref(1,1,det_cepa0_idx(i)),N_int) +! call debug_det(psi_ref(1,1,J),N_int) +! call debug_det(psi_non_ref(1,1,det_cepa0_idx(k)),N_int) +! print *, "=================" +! end if + + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,II),N_int,Hki) + + contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state) + delta_mrcepa0_ij(II, det_cepa0_idx(i), i_state) += contrib +! + if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then + !-$OMP CRITICAL + delta_mrcepa0_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + !-$OMP END CRITICAL + endif end do end do end do end do end do - !qsd $OMP END PARALLEL DO + !- qs $OMP END PARALLEL DO + !print *, "MMMMMMMMMM ", delta_cas(2,2,i_state) , delta_ii(2,i_state) +! do i=1,N_det_ref +! delta_cas(i,i,i_state) += delta_ii(i,i_state) +! end do + + deallocate(idx_sorted_bit) +END_PROVIDER + + + + + BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_sub_ii, (N_det_ref, N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + logical :: ok + double precision :: phase_Ji, phase_Ik, phase_Ii + double precision :: contrib, delta_IJk, HJk, HIk, HIl + integer, dimension(0:2,2,2) :: exc_Ik, exc_Ji, exc_Ii + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + + integer :: II, blok + + provide det_cepa0_active delta_cas lambda_mrcc + + if(N_int /= 1) then + print *, "mrsc2 experimental N_int==1" + stop + end if + + i_state = 1 + delta_sub_ij(:,:,:) = 0d0 + delta_sub_ii(:,:) = 0d0 + + provide mo_bielec_integrals_in_map + allocate(idx_sorted_bit(N_det)) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + + !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_sub_ij, delta_sub_ii) + do i=1,N_det_non_ref + if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪" + do J=1,N_det_ref + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_Ji,degree,phase_Ji,N_int) + if(degree == -1) cycle + + + do II=1,N_det_ref + call apply_excitation(psi_ref(1,1,II),exc_Ji,det_tmp,ok,N_int) + !call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,i),exc_Ii,degree,phase_Ii,N_int) + + if(.not. ok) cycle + l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) + if(l == 0) cycle + l = idx_sorted_bit(l) + + if(psi_non_ref(1,1,l) /= det_tmp(1,1)) stop "sdf" + call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) + + do k=1,N_det_non_ref + call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) + + det_tmp(:,:) = 0_bit_kind + det_tmp2(:,:) = 0_bit_kind + + det_tmp(1,1) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,k)), not(active_sorb(1))) + det_tmp(1,2) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,i)), not(active_sorb(1))) + ok = (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) + + det_tmp(1,1) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,k)), not(active_sorb(2))) + det_tmp(1,2) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,i)), not(active_sorb(2))) + ok = ok .and. (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) + + if(ok) cycle + + +! call decode_exc(exc_Ii,degree,h1_,p1_,h2_,p2_,s1_,s2_) +! call decode_exc(exc_Ik,degree2,h1,p1,h2,p2,s1,s2) +! +! +! det_tmp(:,:) = 0_bit_kind +! call set_det_bit(det_tmp, p1, s1) +! call set_det_bit(det_tmp, h1, s1) +! call set_det_bit(det_tmp, p1_, s1_) +! call set_det_bit(det_tmp, h1_, s1_) +! if(degree == 2) then +! call set_det_bit(det_tmp, p2_, s2_) +! call set_det_bit(det_tmp, h2_, s2_) +! end if +! if(degree2 == 2) then +! call set_det_bit(det_tmp, p2, s2) +! call set_det_bit(det_tmp, h2, s2) +! end if +! deg = 0 +! do ni = 1, N_int +! deg += popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) +! end do +! if(deg == 2*degree2 + 2*degree) cycle + + + + + +! if(degree == -1) cycle + call i_h_j(psi_ref(1,1,J), psi_non_ref(1,1,k), N_int, HJk) + call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,k), N_int, HIk) + if(HJk == 0) cycle + !assert HIk == 0 + delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(ok) cycle + contrib = delta_IJk * HIl * lambda_mrcc(i_state, l) + !$OMP CRITICAL + delta_sub_ij(II, i, i_state) += contrib + if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then + delta_sub_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) + endif + !$OMP END CRITICAL + end do + end do + end do + end do + !$OMP END PARALLEL DO deallocate(idx_sorted_bit) END_PROVIDER subroutine set_det_bit(det, p, s) - use bitmasks - implicit none - integer(bit_kind),intent(inout) :: det(N_int, 2) - integer, intent(in) :: p, s - integer :: ni, pos - - ni = (p-1)/bit_kind_size + 1 - pos = mod(p-1, bit_kind_size) - det(ni,s) = ibset(det(ni,s), pos) + implicit none + integer(bit_kind),intent(inout) :: det(N_int, 2) + integer, intent(in) :: p, s + integer :: ni, pos + + ni = (p-1)/bit_kind_size + 1 + pos = mod(p-1, bit_kind_size) + det(ni,s) = ibset(det(ni,s), pos) end subroutine + + + BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] +implicit none + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, x(2), y(2) + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: contrib + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + + delta_ii_old(:,:) = 0 + delta_ij_old(:,:,:) = 0 + + i_state = 1 + provide mo_bielec_integrals_in_map + allocate(idx_sorted_bit(N_det)) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + + !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij_old, delta_ii_old) + do i = 1 , N_det_non_ref + if(mod(i,1000) == 0) print *, i, N_det_non_ref + do i_I = 1 , N_det_ref + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) + if(degree2 == -1) cycle + ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) + + call decode_exc(exc_iI,degree2,h1,p1,h2,p2,s1,s2) + + call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) + diI = hIi * lambda_mrcc(i_state,i) + do J = 1 , N_det_ref !!! + call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) + call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) + delta_JI = hJi * diI + do k = 1 , N_det_non_ref + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) + if(degree == -1) cycle + + call decode_exc(exc_Ik,degree,h1_,p1_,h2_,p2_,s1_,s2_) + + + det_tmp(:,:) = 0_bit_kind + det_tmp2(:,:) = 0_bit_kind + + !!!!!!!!!!!!!!! + + + + + + det_tmp(1,1) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,k)), not(active_sorb(1))) + det_tmp(1,2) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,i)), not(active_sorb(1))) + ok = (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) + + det_tmp(1,1) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,k)), not(active_sorb(2))) + det_tmp(1,2) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,i)), not(active_sorb(2))) + ok = ok .and. (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) + if(.not. ok) cycle + !if(ok) cycle + + !!!!!!!!!!!!!! + + + +! call set_det_bit(det_tmp, p1, s1) +! +! call set_det_bit(det_tmp, p1_, s1_) +! +! if(degree == 2) then +! call set_det_bit(det_tmp, p2_, s2_) +! +! end if +! if(degree2 == 2) then +! call set_det_bit(det_tmp, p2, s2) +! end if +! +! x(:) = 0 +! do ni=1,N_int +! x(1) += popcnt(iand(det_tmp(ni, 1), cas_bitmask(ni, 1, 1))) +! x(2) += popcnt(iand(det_tmp(ni, 2), cas_bitmask(ni, 2, 1))) +! end do +! +! +! !det_tmp(:,:) = 0_bit_kind +! +! call set_det_bit(det_tmp, h1, s1) +! call set_det_bit(det_tmp, h1_, s1_) +! if(degree == 2) then +! call set_det_bit(det_tmp, h2_, s2_) +! end if +! if(degree2 == 2) then +! call set_det_bit(det_tmp, h2, s2) +! end if +! +! y(1) = -x(1) +! y(2) = -x(2) +! do ni=1,N_int +! y(1) += popcnt(iand(det_tmp(ni, 1), cas_bitmask(ni, 1, 1))) +! y(2) += popcnt(iand(det_tmp(ni, 2), cas_bitmask(ni, 2, 1))) +! end do +! +! ! print *, x, y +! +! if(x(1) * y(1) /= 0) cycle +! if(x(2) * y(2) /= 0) cycle +! +! +! +! deg = 0 +! do ni = 1, N_int +! deg += popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) +! end do +! if(deg /= 2*degree2 + 2*degree) cycle + + + + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + + call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) + + + if(.not. ok) cycle + if(is_in_wavefunction(det_tmp, N_int)) cycle + + + call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp,ok,N_int) + if(.not. ok) cycle + + call get_excitation(psi_ref(1,1,J), det_tmp, exc_Ik, degree, phase_Jl, N_int) + + l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) + if(l == 0) cycle + l = idx_sorted_bit(get_index_in_psi_det_sorted_bit(det_tmp, N_int)) + + if(l ==-1) cycle + + + call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) + dkI(i_state) = HkI * lambda_mrcc(i_state,k) * phase_Jl * phase_Ik + + + !$OMP CRITICAL + contrib = dkI(i_state) * delta_JI + !erro += abs(dkI(i_state) - psi_non_ref_coef(k,i_state) / psi_ref_coef(1,i_state)) + delta_ij_old(i_I,l,i_state) += contrib + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(k,i_state) + endif + !$OMP END CRITICAL + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + deallocate(idx_sorted_bit) +END_PROVIDER + subroutine apply_excitation(det, exc, res, ok, Nint) diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 3f892887..87ae25f3 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -55,7 +55,7 @@ subroutine mrcepa0_iterations do i = 1, N_det_ref print*,'' print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) - print*,'delta_ii(i,1) = ',delta_ii(i,1) + print*,'delta_ii(i,1) = ',delta_cas(i,i,1) enddo print*,'------------' enddo From cda419d0f78e15955ea38b5f5768e85fc387f4c1 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 11 Mar 2016 20:26:50 +0100 Subject: [PATCH 03/42] added missing files --- plugins/mrcepa0/NEEDED_CHILDREN_MODULES | 1 + plugins/mrcepa0/README.rst | 12 ++++++++++++ 2 files changed, 13 insertions(+) create mode 100644 plugins/mrcepa0/NEEDED_CHILDREN_MODULES create mode 100644 plugins/mrcepa0/README.rst diff --git a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..a8404d62 --- /dev/null +++ b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils diff --git a/plugins/mrcepa0/README.rst b/plugins/mrcepa0/README.rst new file mode 100644 index 00000000..997d005e --- /dev/null +++ b/plugins/mrcepa0/README.rst @@ -0,0 +1,12 @@ +======= +mrcepa0 +======= + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. From 48cb3b3ddc9b6c44ed40da9792b2ded501175713 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Apr 2016 12:00:03 +0200 Subject: [PATCH 04/42] different binaries for mrcepa0/mrsc2/mrsc2sub + corrected reversed index in mrcc_utils --- plugins/MRCC_Utils/davidson.irp.f | 4 +- plugins/MRCC_Utils/mrcc_general.irp.f | 4 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 1 - plugins/mrcepa0/dressing.irp.f | 426 +++++++++++++++----------- plugins/mrcepa0/mrcepa0.irp.f | 2 + plugins/mrcepa0/mrcepa0_general.irp.f | 39 +-- 6 files changed, 275 insertions(+), 201 deletions(-) diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index d278ba13..c9dec40a 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -486,8 +486,8 @@ subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate) i = idx_ref(ii) do jj = 1, n_det_non_ref j = idx_non_ref(jj) - vt (i) = vt (i) + delta_ij(ii,jj,istate)*u_0(j) - vt (j) = vt (j) + delta_ij(ii,jj,istate)*u_0(i) + vt (i) = vt (i) + delta_ij(istate,jj,ii)*u_0(j) + vt (j) = vt (j) + delta_ij(istate,jj,ii)*u_0(i) enddo enddo !$OMP END DO diff --git a/plugins/MRCC_Utils/mrcc_general.irp.f b/plugins/MRCC_Utils/mrcc_general.irp.f index 50343fdb..647caa63 100644 --- a/plugins/MRCC_Utils/mrcc_general.irp.f +++ b/plugins/MRCC_Utils/mrcc_general.irp.f @@ -35,8 +35,8 @@ subroutine mrcc_iterations ! lambda = min(1.d0, lambda * 1.1d0) ! endif ! print *, 'energy lambda ', lambda - E_past(j) = E_new - j +=1 +! E_past(j) = E_new +! j +=1 call save_wavefunction if (iteration > 200) then exit diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 80fdd4c7..ec4b5bf8 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -191,4 +191,3 @@ subroutine diagonalize_CI_dressed(lambda) SOFT_TOUCH psi_coef end - diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 30b161d4..4014e789 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -2,19 +2,47 @@ use bitmasks - BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_ii, (N_det_ref,N_states) ] + + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii, (N_states, N_det_ref) ] use bitmasks implicit none + integer :: i, j, i_state -! delta_ij(:,:,:) = delta_ij_old(:,:,:) -! delta_ii(:,:) = delta_ii_old(:,:) - delta_ij(:,:,:) = delta_mrcepa0_ij(:,:,:)! - delta_sub_ij(:,:,:) - delta_ii(:,:)= delta_mrcepa0_ii(:,:)! - delta_sub_ii(:,:) + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + + do i_state = 1, N_states + + if(mrmode == 3) then + do i = 1, N_det_ref + delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) + do j = 1, N_det_non_ref + delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_sub_ij(i,j,i_state) + end do + end do + else if(mrmode == 2) then + do i = 1, N_det_ref + delta_ii(i_state,i)= delta_ii_old(i,i_state) + do j = 1, N_det_non_ref + delta_ij(i_state,j,i) = delta_ij_old(i,j,i_state) + end do + end do + else if(mrmode == 1) then + do i = 1, N_det_ref + delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) + do j = 1, N_det_non_ref + delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) + end do + end do + else + stop "invalid mrmode" + end if + end do END_PROVIDER + BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] &BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_det_non_ref) ] @@ -27,7 +55,6 @@ END_PROVIDER integer i, II, j, k logical, external :: detEq - print *, "provide cepa0" active_sorb(:) = 0_8 nonactive_sorb(:) = not(0_8) @@ -49,10 +76,6 @@ END_PROVIDER call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) -! do i=1, N_det_non_ref -! print "(B30,B30)", det_noactive(1,1,i), det_noactive(1,2,i) -! end do -! stop do i=1,N_det_ref det_ref_active(i) = iand(psi_ref(1,1,i), active_sorb(1)) det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 @@ -83,17 +106,25 @@ END_PROVIDER use bitmasks implicit none integer :: i,j,k - double precision :: Hjk, Hki, Hij, mat(2,2) - integer i_state + double precision :: Hjk, Hki, Hij + integer i_state, degree provide lambda_mrcc i_state = 1 do i=1,N_det_ref do j=1,i + call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) + if(degree /= 2 .and. degree /= 0) cycle delta_cas(i,j,i_state) = 0d0 do k=1,N_det_non_ref +! call get_excitation_degree(psi_ref(1,1,j), psi_non_ref(1,1,k), degree, N_int) +! if(degree /= 2) cycle +! call get_excitation_degree(psi_ref(1,1,i), psi_non_ref(1,1,k), degree, N_int) +! if(degree /= 2) cycle + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) + delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) end do delta_cas(j,i,i_state) = delta_cas(i,j,i_state) @@ -101,6 +132,9 @@ END_PROVIDER end do END_PROVIDER +!-199.0906497310625 +!-199.0913388716010 + logical function detEq(a,b,Nint) use bitmasks implicit none @@ -120,8 +154,8 @@ end function - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_old, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_old, (N_det_ref,N_states) ] use bitmasks implicit none @@ -135,11 +169,14 @@ end function integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction + double precision, allocatable :: hab(:,:) integer :: II, blok provide det_cepa0_active delta_cas lambda_mrcc + + if(N_int /= 1) then print *, "mrcepa0 experimental N_int==1" stop @@ -148,7 +185,8 @@ end function i_state = 1 delta_mrcepa0_ii(:,:) = 0d0 delta_mrcepa0_ij(:,:,:) = 0d0 - + !allocate(hab(N_det_non_ref, N_det_non_ref)) +!hab(:,:) = 0d0 ! do i=1,N_det_ref ! delta_ii(i,i_state) = delta_cas(i,i,i_state) ! end do @@ -168,7 +206,7 @@ end function made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) - if (degree > 2 .or. popcnt(made_hole) * popcnt(made_particle) /= degree*2) cycle + if (degree > 2 .or. popcnt(made_hole) + popcnt(made_particle) == 7650) cycle do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 if(iand(not(active_sorb(1)), xor(psi_non_ref(1,1,det_cepa0_idx(k)), psi_non_ref(1,1,det_cepa0_idx(i)))) /= 0) stop "STOOOP" @@ -185,19 +223,24 @@ end function !!!!! call get_excitation_degree(psi_ref(1,1,J),psi_non_ref(1,1,det_cepa0_idx(k)),degree,N_int) if(degree > 2) stop "BBBB" - !!!!!!!!! -! if(i/=k .and. popcnt(made_hole) /= popcnt(made_particle)) then -! print *, "=================", made_hole, made_particle -! call debug_det(psi_ref(1,1,II),N_int) -! call debug_det(psi_non_ref(1,1,det_cepa0_idx(i)),N_int) -! call debug_det(psi_ref(1,1,J),N_int) -! call debug_det(psi_non_ref(1,1,det_cepa0_idx(k)),N_int) -! print *, "=================" -! end if + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,II),N_int,Hki) + !call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,Hki) - contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state) + !contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state)! * psi_ref_coef(II, I_state)*psi_ref_coef(J, I_state)/(psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) + contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state)! * psi_ref_coef(II, I_state)*psi_ref_coef(J, I_state)/(psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) + + + ! (psi_ref_coef(II, I_state) * psi_ref_coef(J, I_state)) / (psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) +! if(hab(det_cepa0_idx(k), det_cepa0_idx(i)) /= 0) then +! print *, "HAB ", contrib, hab(det_cepa0_idx(k), det_cepa0_idx(i)) +! !contrib = 0d0 +! !stop +! else +! hab(det_cepa0_idx(k), det_cepa0_idx(i)) = contrib +! hab(det_cepa0_idx(i), det_cepa0_idx(k)) = contrib +! end if delta_mrcepa0_ij(II, det_cepa0_idx(i), i_state) += contrib ! if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then @@ -222,6 +265,152 @@ END_PROVIDER + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: contrib, HIIi, HJk + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + + integer :: II, blok + + provide det_cepa0_active delta_cas lambda_mrcc + + + + if(N_int /= 1) then + print *, "mrcepa0 experimental N_int==1" + stop + end if + + i_state = 1 + delta_mrcepa0_ii(:,:) = 0d0 + delta_mrcepa0_ij(:,:,:) = 0d0 + + + provide mo_bielec_integrals_in_map + allocate(idx_sorted_bit(N_det)) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) + do blok=1,cepa0_shortcut(0) + do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do II=1,N_det_ref + + + call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) + if (degree > 2 ) cycle + + made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + + + + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + !if(i==k) cycle + if(iand(not(active_sorb(1)), xor(psi_non_ref(1,1,det_cepa0_idx(k)), psi_non_ref(1,1,det_cepa0_idx(i)))) /= 0) stop "STOOOP" + if(iand(made_hole, det_cepa0_active(k)) /= 0) cycle + if(iand(made_particle, det_cepa0_active(k)) /= made_particle) cycle + myActive = xor(det_cepa0_active(k), made_hole) + myActive = xor(myActive, made_particle) + if(i==k .and. myActive /= det_ref_active(II)) stop "AAAA" + do J=1,N_det_ref + if(det_ref_active(J) /= myActive) cycle + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) + contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib + + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + end if + end do + end do + end do + end do + end do + + deallocate(idx_sorted_bit) +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_exp, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_exp, (N_det_ref,N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: contrib, HIIi, HJk + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + + integer :: II, blok + + provide det_cepa0_active delta_cas lambda_mrcc + + + print *, "mrcepa0 experimental" + if(N_int /= 1) then + print *, "mrcepa0 experimental N_int==1" + stop + end if + + i_state = 1 + delta_mrcepa0_ii_exp(:,:) = 0d0 + delta_mrcepa0_ij_exp(:,:,:) = 0d0 + + + provide mo_bielec_integrals_in_map + allocate(idx_sorted_bit(N_det)) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_mrcepa0_ii_exp, delta_mrcepa0_ij_exp) + do blok=1,cepa0_shortcut(0) + do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do II=1,N_det_ref + made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do J=1,N_det_ref + if(made_hole /= iand(det_ref_active(J), xor(det_cepa0_active(k), det_ref_active(J)))) cycle + if(made_particle /= iand(det_cepa0_active(k), xor(det_cepa0_active(k), det_ref_active(J)))) cycle + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) + contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + delta_mrcepa0_ij_exp(J, det_cepa0_idx(i), i_state) += contrib + + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + delta_mrcepa0_ii_exp(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + end if + end do + end do + end do + end do + end do + + deallocate(idx_sorted_bit) +END_PROVIDER + + BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_sub_ii, (N_det_ref, N_states) ] use bitmasks @@ -260,7 +449,7 @@ END_PROVIDER !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_sub_ij, delta_sub_ii) do i=1,N_det_non_ref - if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪" + if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪ (sub)" do J=1,N_det_ref call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_Ji,degree,phase_Ji,N_int) if(degree == -1) cycle @@ -279,6 +468,8 @@ END_PROVIDER call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) do k=1,N_det_non_ref +! if(lambda_mrcc(i_state, k) == 0d0) cycle + if(lambda_mrcc(i_state, k) == 0d0) cycle call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) det_tmp(:,:) = 0_bit_kind @@ -295,42 +486,16 @@ END_PROVIDER if(ok) cycle -! call decode_exc(exc_Ii,degree,h1_,p1_,h2_,p2_,s1_,s2_) -! call decode_exc(exc_Ik,degree2,h1,p1,h2,p2,s1,s2) -! -! -! det_tmp(:,:) = 0_bit_kind -! call set_det_bit(det_tmp, p1, s1) -! call set_det_bit(det_tmp, h1, s1) -! call set_det_bit(det_tmp, p1_, s1_) -! call set_det_bit(det_tmp, h1_, s1_) -! if(degree == 2) then -! call set_det_bit(det_tmp, p2_, s2_) -! call set_det_bit(det_tmp, h2_, s2_) -! end if -! if(degree2 == 2) then -! call set_det_bit(det_tmp, p2, s2) -! call set_det_bit(det_tmp, h2, s2) -! end if -! deg = 0 -! do ni = 1, N_int -! deg += popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) -! end do -! if(deg == 2*degree2 + 2*degree) cycle - - - - - -! if(degree == -1) cycle call i_h_j(psi_ref(1,1,J), psi_non_ref(1,1,k), N_int, HJk) call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,k), N_int, HIk) if(HJk == 0) cycle !assert HIk == 0 + !delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(ok) cycle - contrib = delta_IJk * HIl * lambda_mrcc(i_state, l) +! contrib = delta_IJk * HIl * lambda_mrcc(i_state, l) + contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) !$OMP CRITICAL delta_sub_ij(II, i, i_state) += contrib if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then @@ -376,6 +541,7 @@ implicit none delta_ii_old(:,:) = 0 delta_ij_old(:,:,:) = 0 + i_state = 1 provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) @@ -387,7 +553,8 @@ implicit none !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij_old, delta_ii_old) do i = 1 , N_det_non_ref - if(mod(i,1000) == 0) print *, i, N_det_non_ref + if(lambda_mrcc(i_state, i) == 0d0) cycle + if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪ (old)" do i_I = 1 , N_det_ref call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) if(degree2 == -1) cycle @@ -396,12 +563,14 @@ implicit none call decode_exc(exc_iI,degree2,h1,p1,h2,p2,s1,s2) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) - diI = hIi * lambda_mrcc(i_state,i) + diI = hIi * lambda_mrcc(i_state, i) do J = 1 , N_det_ref !!! call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) delta_JI = hJi * diI do k = 1 , N_det_non_ref + if(lambda_mrcc(i_state, k) == 0d0) cycle + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) if(degree == -1) cycle @@ -411,11 +580,6 @@ implicit none det_tmp(:,:) = 0_bit_kind det_tmp2(:,:) = 0_bit_kind - !!!!!!!!!!!!!!! - - - - det_tmp(1,1) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,k)), not(active_sorb(1))) det_tmp(1,2) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,i)), not(active_sorb(1))) @@ -427,60 +591,6 @@ implicit none if(.not. ok) cycle !if(ok) cycle - !!!!!!!!!!!!!! - - - -! call set_det_bit(det_tmp, p1, s1) -! -! call set_det_bit(det_tmp, p1_, s1_) -! -! if(degree == 2) then -! call set_det_bit(det_tmp, p2_, s2_) -! -! end if -! if(degree2 == 2) then -! call set_det_bit(det_tmp, p2, s2) -! end if -! -! x(:) = 0 -! do ni=1,N_int -! x(1) += popcnt(iand(det_tmp(ni, 1), cas_bitmask(ni, 1, 1))) -! x(2) += popcnt(iand(det_tmp(ni, 2), cas_bitmask(ni, 2, 1))) -! end do -! -! -! !det_tmp(:,:) = 0_bit_kind -! -! call set_det_bit(det_tmp, h1, s1) -! call set_det_bit(det_tmp, h1_, s1_) -! if(degree == 2) then -! call set_det_bit(det_tmp, h2_, s2_) -! end if -! if(degree2 == 2) then -! call set_det_bit(det_tmp, h2, s2) -! end if -! -! y(1) = -x(1) -! y(2) = -x(2) -! do ni=1,N_int -! y(1) += popcnt(iand(det_tmp(ni, 1), cas_bitmask(ni, 1, 1))) -! y(2) += popcnt(iand(det_tmp(ni, 2), cas_bitmask(ni, 2, 1))) -! end do -! -! ! print *, x, y -! -! if(x(1) * y(1) /= 0) cycle -! if(x(2) * y(2) /= 0) cycle -! -! -! -! deg = 0 -! do ni = 1, N_int -! deg += popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) -! end do -! if(deg /= 2*degree2 + 2*degree) cycle - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) @@ -500,17 +610,22 @@ implicit none l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) if(l == 0) cycle l = idx_sorted_bit(get_index_in_psi_det_sorted_bit(det_tmp, N_int)) - if(l ==-1) cycle + call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) - dkI(i_state) = HkI * lambda_mrcc(i_state,k) * phase_Jl * phase_Ik - + !dkI(i_state) = HkI * lambda_mrcc(i_state,k) * phase_Jl * phase_Ik * Xref(I_i) + dkI(i_state) = HkI * lambda_mrcc(i_state, k) * phase_Jl * phase_Ik + + !!!! + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) + if(degree /= 2 .and. degree /= 0) cycle + !!!!!! + !$OMP CRITICAL contrib = dkI(i_state) * delta_JI - !erro += abs(dkI(i_state) - psi_non_ref_coef(k,i_state) / psi_ref_coef(1,i_state)) delta_ij_old(i_I,l,i_state) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(k,i_state) @@ -521,61 +636,24 @@ implicit none enddo enddo !$OMP END PARALLEL DO + +! double precision :: error, acc +! integer :: II +! error = 0d0 +! do i=1, N_det_non_ref +! acc = 0d0 +! do II=1, N_det_ref +! call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), N_int, HIi) +! acc += HIi * lambda_mrcc(i_state, i) * Xref(II) * psi_ref_coef(II, i_state) +! end do +! error += (psi_non_ref_coef(i, i_state) - acc)**2 +! end do +! print *, "QUALITY ", error + + deallocate(idx_sorted_bit) END_PROVIDER - - -subroutine apply_excitation(det, exc, res, ok, Nint) - use bitmasks - implicit none - - integer, intent(in) :: Nint - integer, intent(in) :: exc(0:2,2,2) - integer(bit_kind),intent(in) :: det(Nint, 2) - integer(bit_kind),intent(out) :: res(Nint, 2) - logical, intent(out) :: ok - integer :: h1,p1,h2,p2,s1,s2,degree - integer :: ii, pos - - - ok = .false. - degree = exc(0,1,1) + exc(0,1,2) - if(.not. (degree > 0 .and. degree <= 2)) then - print *, "apply ex" - STOP - endif - - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - res = det - - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 - if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return - res(ii, s1) = ibclr(res(ii, s1), pos) - - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) - if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return - res(ii, s1) = ibset(res(ii, s1), pos) - - if(degree == 2) then - ii = (h2-1)/bit_kind_size + 1 - pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) - if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return - res(ii, s2) = ibclr(res(ii, s2), pos) - - ii = (p2-1)/bit_kind_size + 1 - pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) - if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return - res(ii, s2) = ibset(res(ii, s2), pos) - endif - - ok = .true. -end subroutine - - - diff --git a/plugins/mrcepa0/mrcepa0.irp.f b/plugins/mrcepa0/mrcepa0.irp.f index b9eb2fc5..7877cdda 100644 --- a/plugins/mrcepa0/mrcepa0.irp.f +++ b/plugins/mrcepa0/mrcepa0.irp.f @@ -1,5 +1,7 @@ program mrcepa0 implicit none + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + mrmode = 1 if (.not.read_wf) then print *, 'read_wf has to be true.' stop 1 diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 87ae25f3..b307ca85 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -4,6 +4,10 @@ subroutine run_mrcepa0 call mrcepa0_iterations end +BEGIN_PROVIDER [ integer, mrmode ] + +END_PROVIDER + subroutine mrcepa0_iterations implicit none @@ -11,12 +15,13 @@ subroutine mrcepa0_iterations double precision :: E_new, E_old, delta_e integer :: iteration,i_oscillations - double precision :: E_past(4) + double precision :: E_past(4), lambda E_new = 0.d0 delta_E = 1.d0 iteration = 0 j = 1 i_oscillations = 0 + lambda = 1.d0 do while (delta_E > 1.d-7) iteration += 1 print *, '===========================' @@ -25,29 +30,19 @@ subroutine mrcepa0_iterations print *, '' E_old = sum(ci_energy_dressed) call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") - call diagonalize_ci_dressed + call diagonalize_ci_dressed(lambda) E_new = sum(ci_energy_dressed) delta_E = dabs(E_new - E_old) - E_past(j) = E_new - j +=1 - if(j>4)then - j=1 - endif - if(iteration > 4) then - if(delta_E > 1.d-10)then - if(dabs(E_past(1) - E_past(3)) .le. delta_E .and. dabs(E_past(2) - E_past(4)).le. delta_E)then - print*,'OSCILLATIONS !!!' -! oscillations = .True. - i_oscillations +=1 - lambda_mrcc_tmp = lambda_mrcc - endif - endif - endif +! if (E_new > E_old) then +! lambda = lambda * 0.7d0 +! else +! lambda = min(1.d0, lambda * 1.1d0) +! endif +! print *, 'energy lambda ', lambda +! E_past(j) = E_new +! j +=1 call save_wavefunction -! if (i_oscillations > 5) then -! exit -! endif - if (iteration > 100) then + if (iteration > 200) then exit endif print*,'------------' @@ -55,7 +50,7 @@ subroutine mrcepa0_iterations do i = 1, N_det_ref print*,'' print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) - print*,'delta_ii(i,1) = ',delta_cas(i,i,1) + print*,'delta_ii(i,1) = ',delta_ii(i,1) enddo print*,'------------' enddo From 340b89b75467a5da3ea8c5f5a0922a85bfde3fb2 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Apr 2016 14:29:06 +0200 Subject: [PATCH 05/42] removed test leftover in mrsc2 --- plugins/mrcepa0/dressing.irp.f | 7 ------- 1 file changed, 7 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 4014e789..44c8ea0e 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -468,7 +468,6 @@ END_PROVIDER call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) do k=1,N_det_non_ref -! if(lambda_mrcc(i_state, k) == 0d0) cycle if(lambda_mrcc(i_state, k) == 0d0) cycle call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) @@ -589,7 +588,6 @@ implicit none det_tmp(1,2) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,i)), not(active_sorb(2))) ok = ok .and. (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) if(.not. ok) cycle - !if(ok) cycle @@ -619,11 +617,6 @@ implicit none dkI(i_state) = HkI * lambda_mrcc(i_state, k) * phase_Jl * phase_Ik - !!!! - call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) - if(degree /= 2 .and. degree /= 0) cycle - !!!!!! - !$OMP CRITICAL contrib = dkI(i_state) * delta_JI delta_ij_old(i_I,l,i_state) += contrib From cdb87937c868a685f490ca825c2f922a7527f7d7 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Apr 2016 23:31:48 +0200 Subject: [PATCH 06/42] added missing files --- plugins/mrcepa0/mrsc2.irp.f | 26 ++++++++++++++++++++++++++ plugins/mrcepa0/mrsc2sub.irp.f | 26 ++++++++++++++++++++++++++ 2 files changed, 52 insertions(+) create mode 100644 plugins/mrcepa0/mrsc2.irp.f create mode 100644 plugins/mrcepa0/mrsc2sub.irp.f diff --git a/plugins/mrcepa0/mrsc2.irp.f b/plugins/mrcepa0/mrsc2.irp.f new file mode 100644 index 00000000..eb34adee --- /dev/null +++ b/plugins/mrcepa0/mrsc2.irp.f @@ -0,0 +1,26 @@ +program mrcepa0 + implicit none + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + mrmode = 2 + if (.not.read_wf) then + print *, 'read_wf has to be true.' + stop 1 + endif + call print_cas_coefs + call run_mrcepa0 +end + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, psi_cas_coef(i,:) + call debug_det(psi_cas(1,1,i),N_int) + enddo + + call write_double(6,ci_energy(1),"Initial CI energy") +end + diff --git a/plugins/mrcepa0/mrsc2sub.irp.f b/plugins/mrcepa0/mrsc2sub.irp.f new file mode 100644 index 00000000..524bbbd7 --- /dev/null +++ b/plugins/mrcepa0/mrsc2sub.irp.f @@ -0,0 +1,26 @@ +program mrcepa0 + implicit none + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + mrmode = 3 + if (.not.read_wf) then + print *, 'read_wf has to be true.' + stop 1 + endif + call print_cas_coefs + call run_mrcepa0 +end + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, psi_cas_coef(i,:) + call debug_det(psi_cas(1,1,i),N_int) + enddo + + call write_double(6,ci_energy(1),"Initial CI energy") +end + From a843dae541251b35a06473b52a7ee2216da06fc5 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 4 Apr 2016 15:51:32 +0200 Subject: [PATCH 07/42] fixed openmp + support for N_int and N_states > 1 --- plugins/MRCC_Utils/davidson.irp.f | 2 +- plugins/MRCC_Utils/mrcc_general.irp.f | 3 +- plugins/mrcepa0/dressing.irp.f | 691 ++++++++++---------------- plugins/mrcepa0/mrcepa0_general.irp.f | 29 +- 4 files changed, 296 insertions(+), 429 deletions(-) diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index c9dec40a..61a38c37 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -47,7 +47,7 @@ subroutine davidson_diag_mrcc(dets_in,u_in,energies,dim_in,sze,N_st,Nint,iunit,i !$OMP END DO !$OMP DO SCHEDULE(guided) do i=1,N_det_ref - H_jj(idx_ref(i)) += delta_ii(i,istate) + H_jj(idx_ref(i)) += delta_ii(istate,i) enddo !$OMP END DO !$OMP END PARALLEL diff --git a/plugins/MRCC_Utils/mrcc_general.irp.f b/plugins/MRCC_Utils/mrcc_general.irp.f index 647caa63..a0a4c895 100644 --- a/plugins/MRCC_Utils/mrcc_general.irp.f +++ b/plugins/MRCC_Utils/mrcc_general.irp.f @@ -25,6 +25,7 @@ subroutine mrcc_iterations print *, '===========================' print *, '' E_old = sum(ci_energy_dressed) + print *, iteration, ci_energy_dressed(1) call write_double(6,ci_energy_dressed(1),"MRCC energy") call diagonalize_ci_dressed(lambda) E_new = sum(ci_energy_dressed) @@ -38,7 +39,7 @@ subroutine mrcc_iterations ! E_past(j) = E_new ! j +=1 call save_wavefunction - if (iteration > 200) then + if (iteration > 0) then exit endif print*,'------------' diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 44c8ea0e..2010750e 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -12,7 +12,6 @@ use bitmasks !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub do i_state = 1, N_states - if(mrmode == 3) then do i = 1, N_det_ref delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) @@ -45,59 +44,73 @@ END_PROVIDER BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] &BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] -&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_det_non_ref) ] -&BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_det_ref) ] -&BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (2) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_int,2,N_det_non_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_int,2,N_det_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (N_int,2) ] use bitmasks implicit none - integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(2) + integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2) integer i, II, j, k logical, external :: detEq - active_sorb(:) = 0_8 - nonactive_sorb(:) = not(0_8) + active_sorb(:,:) = 0_8 + nonactive_sorb(:,:) = not(0_8) if(N_det_ref > 1) then do i=1, N_det_ref - active_sorb(1) = ior(psi_ref(1,1,i), active_sorb(1)) - active_sorb(2) = ior(psi_ref(1,2,i), active_sorb(2)) - nonactive_sorb(1) = iand(psi_ref(1,1,i), nonactive_sorb(1)) - nonactive_sorb(2) = iand(psi_ref(1,2,i), nonactive_sorb(2)) + do k=1, N_int + active_sorb(k,1) = ior(psi_ref(k,1,i), active_sorb(k,1)) + active_sorb(k,2) = ior(psi_ref(k,2,i), active_sorb(k,2)) + nonactive_sorb(k,1) = iand(psi_ref(k,1,i), nonactive_sorb(k,1)) + nonactive_sorb(k,2) = iand(psi_ref(k,2,i), nonactive_sorb(k,2)) + end do + end do + do k=1, N_int + active_sorb(k,1) = iand(active_sorb(k,1), not(nonactive_sorb(k,1))) + active_sorb(k,2) = iand(active_sorb(k,2), not(nonactive_sorb(k,2))) end do - active_sorb(1) = iand(active_sorb(1), not(nonactive_sorb(1))) - active_sorb(2) = iand(active_sorb(2), not(nonactive_sorb(2))) end if do i=1, N_det_non_ref - det_noactive(1,1,i) = iand(psi_non_ref(1,1,i), not(active_sorb(1))) - det_noactive(1,2,i) = iand(psi_non_ref(1,2,i), not(active_sorb(2))) + do k=1, N_int + det_noactive(k,1,i) = iand(psi_non_ref(k,1,i), not(active_sorb(k,1))) + det_noactive(k,2,i) = iand(psi_non_ref(k,2,i), not(active_sorb(k,2))) + end do end do call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) do i=1,N_det_ref - det_ref_active(i) = iand(psi_ref(1,1,i), active_sorb(1)) - det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 + do k=1, N_int + det_ref_active(k,1,i) = iand(psi_ref(k,1,i), active_sorb(k,1)) + det_ref_active(k,2,i) = iand(psi_ref(k,2,i), active_sorb(k,2)) + !det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 + end do end do cepa0_shortcut(0) = 1 cepa0_shortcut(1) = 1 - det_cepa0_active(1) = iand(psi_non_ref(1,1,det_cepa0_idx(1)), active_sorb(1)) - det_cepa0_active(1) = det_cepa0_active(1) + iand(psi_non_ref(1,2,det_cepa0_idx(1)), active_sorb(2)) * 2_8**32_8 + do k=1, N_int + det_cepa0_active(k,1,1) = iand(psi_non_ref(k,1,det_cepa0_idx(1)), active_sorb(k,1)) + det_cepa0_active(k,2,1) = iand(psi_non_ref(k,2,det_cepa0_idx(1)), active_sorb(k,2)) + !det_cepa0_active(1) = det_cepa0_active(1) + iand(psi_non_ref(1,2,det_cepa0_idx(1)), active_sorb(2)) * 2_8**32_8 + end do do i=2,N_det_non_ref - det_cepa0_active(i) = iand(psi_non_ref(1,1,det_cepa0_idx(i)), active_sorb(1)) - det_cepa0_active(i) = det_cepa0_active(i) + iand(psi_non_ref(1,2,det_cepa0_idx(i)), active_sorb(2)) * 2_8**32_8 + do k=1, N_int + det_cepa0_active(k,1,i) = iand(psi_non_ref(k,1,det_cepa0_idx(i)), active_sorb(k,1)) + det_cepa0_active(k,2,i) = iand(psi_non_ref(k,2,det_cepa0_idx(i)), active_sorb(k,2)) + end do +! det_cepa0_active(i) = iand(psi_non_ref(1,1,det_cepa0_idx(i)), active_sorb(1)) +! det_cepa0_active(i) = det_cepa0_active(i) + iand(psi_non_ref(1,2,det_cepa0_idx(i)), active_sorb(2)) * 2_8**32_8 if(.not. detEq(det_noactive(1,1,i), det_noactive(1,1,i-1), N_int)) then cepa0_shortcut(0) += 1 cepa0_shortcut(cepa0_shortcut(0)) = i end if end do - !cepa0_shortcut(0) += 1 cepa0_shortcut(cepa0_shortcut(0)+1) = N_det_non_ref+1 - END_PROVIDER @@ -110,30 +123,27 @@ END_PROVIDER integer i_state, degree provide lambda_mrcc - i_state = 1 - do i=1,N_det_ref - do j=1,i - call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) - if(degree /= 2 .and. degree /= 0) cycle - delta_cas(i,j,i_state) = 0d0 - do k=1,N_det_non_ref -! call get_excitation_degree(psi_ref(1,1,j), psi_non_ref(1,1,k), degree, N_int) -! if(degree /= 2) cycle -! call get_excitation_degree(psi_ref(1,1,i), psi_non_ref(1,1,k), degree, N_int) -! if(degree /= 2) cycle - - call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) - call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) - - delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) + do i_state = 1, N_states + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas) + do i=1,N_det_ref + do j=1,i + call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) + if(degree /= 2 .and. degree /= 0) cycle + delta_cas(i,j,i_state) = 0d0 + do k=1,N_det_non_ref + + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) + call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) + + delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) + end do + delta_cas(j,i,i_state) = delta_cas(i,j,i_state) end do - delta_cas(j,i,i_state) = delta_cas(i,j,i_state) end do + !$OMP END PARALLEL DO end do END_PROVIDER -!-199.0906497310625 -!-199.0913388716010 logical function detEq(a,b,Nint) use bitmasks @@ -154,117 +164,6 @@ end function - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_old, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_old, (N_det_ref,N_states) ] - use bitmasks - implicit none - - integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ - logical :: ok - double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) - double precision :: contrib - integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive - integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction - double precision, allocatable :: hab(:,:) - - integer :: II, blok - - provide det_cepa0_active delta_cas lambda_mrcc - - - - if(N_int /= 1) then - print *, "mrcepa0 experimental N_int==1" - stop - end if - - i_state = 1 - delta_mrcepa0_ii(:,:) = 0d0 - delta_mrcepa0_ij(:,:,:) = 0d0 - !allocate(hab(N_det_non_ref, N_det_non_ref)) -!hab(:,:) = 0d0 -! do i=1,N_det_ref -! delta_ii(i,i_state) = delta_cas(i,i,i_state) -! end do - - provide mo_bielec_integrals_in_map - allocate(idx_sorted_bit(N_det)) - - idx_sorted_bit(:) = -1 - do i=1,N_det_non_ref - idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i - enddo - !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij, delta_ii) - do blok=1,cepa0_shortcut(0) - do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - do II=1,N_det_ref - - made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) - made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) - call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) - if (degree > 2 .or. popcnt(made_hole) + popcnt(made_particle) == 7650) cycle - - do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - if(iand(not(active_sorb(1)), xor(psi_non_ref(1,1,det_cepa0_idx(k)), psi_non_ref(1,1,det_cepa0_idx(i)))) /= 0) stop "STOOOP" - !do k=1,N_det_non_ref - if(iand(made_hole, det_cepa0_active(k)) /= 0) cycle - if(iand(made_particle, det_cepa0_active(k)) /= made_particle) cycle - myActive = xor(det_cepa0_active(k), made_hole) - myActive = xor(myActive, made_particle) - if(i==k .and. myActive /= det_ref_active(II)) stop "AAAA" - !if(i==k) print *, "i=k" - do J=1,N_det_ref - if(det_ref_active(J) /= myActive) cycle - - !!!!! - call get_excitation_degree(psi_ref(1,1,J),psi_non_ref(1,1,det_cepa0_idx(k)),degree,N_int) - if(degree > 2) stop "BBBB" - - - call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,II),N_int,Hki) - !call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,Hki) - - !contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state)! * psi_ref_coef(II, I_state)*psi_ref_coef(J, I_state)/(psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) - contrib = Hki * lambda_mrcc(i_state, det_cepa0_idx(k)) * delta_cas(II,J,i_state)! * psi_ref_coef(II, I_state)*psi_ref_coef(J, I_state)/(psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) - - - ! (psi_ref_coef(II, I_state) * psi_ref_coef(J, I_state)) / (psi_ref_coef(1, I_state)**2 + psi_ref_coef(2, I_state)**2) -! if(hab(det_cepa0_idx(k), det_cepa0_idx(i)) /= 0) then -! print *, "HAB ", contrib, hab(det_cepa0_idx(k), det_cepa0_idx(i)) -! !contrib = 0d0 -! !stop -! else -! hab(det_cepa0_idx(k), det_cepa0_idx(i)) = contrib -! hab(det_cepa0_idx(i), det_cepa0_idx(k)) = contrib -! end if - delta_mrcepa0_ij(II, det_cepa0_idx(i), i_state) += contrib -! - if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then - !-$OMP CRITICAL - delta_mrcepa0_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - !-$OMP END CRITICAL - endif - end do - end do - end do - end do - end do - !- qs $OMP END PARALLEL DO - !print *, "MMMMMMMMMM ", delta_cas(2,2,i_state) , delta_ii(2,i_state) -! do i=1,N_det_ref -! delta_cas(i,i,i_state) += delta_ii(i,i_state) -! end do - - deallocate(idx_sorted_bit) -END_PROVIDER - - - - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] use bitmasks @@ -276,7 +175,7 @@ END_PROVIDER double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) double precision :: contrib, HIIi, HJk integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive + integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2) integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction @@ -284,19 +183,6 @@ END_PROVIDER integer :: II, blok provide det_cepa0_active delta_cas lambda_mrcc - - - - if(N_int /= 1) then - print *, "mrcepa0 experimental N_int==1" - stop - end if - - i_state = 1 - delta_mrcepa0_ii(:,:) = 0d0 - delta_mrcepa0_ij(:,:,:) = 0d0 - - provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) @@ -304,109 +190,71 @@ END_PROVIDER do i=1,N_det_non_ref idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) - do blok=1,cepa0_shortcut(0) - do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - do II=1,N_det_ref - - - call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) - if (degree > 2 ) cycle - - made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) - made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) - - - - do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - !if(i==k) cycle - if(iand(not(active_sorb(1)), xor(psi_non_ref(1,1,det_cepa0_idx(k)), psi_non_ref(1,1,det_cepa0_idx(i)))) /= 0) stop "STOOOP" - if(iand(made_hole, det_cepa0_active(k)) /= 0) cycle - if(iand(made_particle, det_cepa0_active(k)) /= made_particle) cycle - myActive = xor(det_cepa0_active(k), made_hole) - myActive = xor(myActive, made_particle) - if(i==k .and. myActive /= det_ref_active(II)) stop "AAAA" - do J=1,N_det_ref - if(det_ref_active(J) /= myActive) cycle - call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) - contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) - delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib - - if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then - delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - end if + + + do i_state = 1, N_states + delta_mrcepa0_ii(:,:) = 0d0 + delta_mrcepa0_ij(:,:,:) = 0d0 + + !$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) & + !$OMP private(i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) & + !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & + !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) & + !$OMP shared(i_state) + do blok=1,cepa0_shortcut(0) + do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do II=1,N_det_ref + call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) + if (degree > 2 ) cycle + + do ni=1,N_int + made_hole(ni,1) = iand(det_ref_active(ni,1,II), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) + made_hole(ni,2) = iand(det_ref_active(ni,2,II), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) + !made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle(ni,1) = iand(det_cepa0_active(ni,1,i), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) + made_particle(ni,2) = iand(det_cepa0_active(ni,2,i), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) end do + + + kloop: do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle + + do ni=1,N_int + if(iand(made_hole(ni,1), det_cepa0_active(ni,1,k)) /= 0) cycle kloop + if(iand(made_particle(ni,1), det_cepa0_active(ni,1,k)) /= made_particle(ni,1)) cycle kloop + if(iand(made_hole(ni,2), det_cepa0_active(ni,2,k)) /= 0) cycle kloop + if(iand(made_particle(ni,2), det_cepa0_active(ni,2,k)) /= made_particle(ni,2)) cycle kloop + end do + do ni=1,N_int + myActive(ni,1) = xor(det_cepa0_active(ni,1,k), made_hole(ni,1)) + myActive(ni,1) = xor(myActive(ni,1), made_particle(ni,1)) + myActive(ni,2) = xor(det_cepa0_active(ni,2,k), made_hole(ni,2)) + myActive(ni,2) = xor(myActive(ni,2), made_particle(ni,2)) + end do + + jloop: do J=1,N_det_ref + do ni=1,N_int !!! replace with sort+search + if(det_ref_active(ni,1,J) /= myActive(ni,1)) cycle jloop + if(det_ref_active(ni,2,J) /= myActive(ni,2)) cycle jloop + end do + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) + contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + !$OMP ATOMIC + delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib + + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + !$OMP ATOMIC + delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + end if + + exit + end do jloop + end do kloop end do end do - end do - end do - - deallocate(idx_sorted_bit) -END_PROVIDER - - - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_exp, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_exp, (N_det_ref,N_states) ] - use bitmasks - implicit none - - integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ - logical :: ok - double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) - double precision :: contrib, HIIi, HJk - integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole, made_particle, myActive - integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction - - integer :: II, blok - - provide det_cepa0_active delta_cas lambda_mrcc - - - print *, "mrcepa0 experimental" - if(N_int /= 1) then - print *, "mrcepa0 experimental N_int==1" - stop - end if - - i_state = 1 - delta_mrcepa0_ii_exp(:,:) = 0d0 - delta_mrcepa0_ij_exp(:,:,:) = 0d0 - - - provide mo_bielec_integrals_in_map - allocate(idx_sorted_bit(N_det)) - - idx_sorted_bit(:) = -1 - do i=1,N_det_non_ref - idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i - enddo - !- qsd $OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_mrcepa0_ii_exp, delta_mrcepa0_ij_exp) - do blok=1,cepa0_shortcut(0) - do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - do II=1,N_det_ref - made_hole = iand(det_ref_active(II), xor(det_cepa0_active(i), det_ref_active(II))) - made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) - do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - do J=1,N_det_ref - if(made_hole /= iand(det_ref_active(J), xor(det_cepa0_active(k), det_ref_active(J)))) cycle - if(made_particle /= iand(det_cepa0_active(k), xor(det_cepa0_active(k), det_ref_active(J)))) cycle - call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) - contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) - delta_mrcepa0_ij_exp(J, det_cepa0_idx(i), i_state) += contrib - - if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then - delta_mrcepa0_ii_exp(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - end if - end do - end do end do + !$OMP END PARALLEL DO end do - end do - deallocate(idx_sorted_bit) END_PROVIDER @@ -416,7 +264,7 @@ END_PROVIDER use bitmasks implicit none - integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: i_state, i, i_I, J, k, degree, degree2, l, deg, ni integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ logical :: ok double precision :: phase_Ji, phase_Ik, phase_Ii @@ -428,84 +276,86 @@ END_PROVIDER integer :: II, blok - provide det_cepa0_active delta_cas lambda_mrcc - - if(N_int /= 1) then - print *, "mrsc2 experimental N_int==1" - stop - end if - - i_state = 1 - delta_sub_ij(:,:,:) = 0d0 - delta_sub_ii(:,:) = 0d0 - - provide mo_bielec_integrals_in_map + provide delta_cas lambda_mrcc allocate(idx_sorted_bit(N_det)) - idx_sorted_bit(:) = -1 do i=1,N_det_non_ref idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - - !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_sub_ij, delta_sub_ii) - do i=1,N_det_non_ref - if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪ (sub)" - do J=1,N_det_ref - call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_Ji,degree,phase_Ji,N_int) - if(degree == -1) cycle - - - do II=1,N_det_ref - call apply_excitation(psi_ref(1,1,II),exc_Ji,det_tmp,ok,N_int) - !call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,i),exc_Ii,degree,phase_Ii,N_int) + + do i_state = 1, N_states + delta_sub_ij(:,:,:) = 0d0 + delta_sub_ii(:,:) = 0d0 + + provide mo_bielec_integrals_in_map + + + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) & + !$OMP private(i, J, k, degree, degree2, l, deg, ni) & + !$OMP private(p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & + !$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) & + !$OMP private(det_tmp, det_tmp2, II, blok) & + !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & + !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb) + do i=1,N_det_non_ref + if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref + do J=1,N_det_ref + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_Ji,degree,phase_Ji,N_int) + if(degree == -1) cycle - if(.not. ok) cycle - l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) - if(l == 0) cycle - l = idx_sorted_bit(l) - if(psi_non_ref(1,1,l) /= det_tmp(1,1)) stop "sdf" - call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) - - do k=1,N_det_non_ref - if(lambda_mrcc(i_state, k) == 0d0) cycle - call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) + do II=1,N_det_ref + call apply_excitation(psi_ref(1,1,II),exc_Ji,det_tmp,ok,N_int) + !call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,i),exc_Ii,degree,phase_Ii,N_int) - det_tmp(:,:) = 0_bit_kind - det_tmp2(:,:) = 0_bit_kind + if(.not. ok) cycle + l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) + if(l == 0) cycle + l = idx_sorted_bit(l) - det_tmp(1,1) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,k)), not(active_sorb(1))) - det_tmp(1,2) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,i)), not(active_sorb(1))) - ok = (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) + call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) + + do k=1,N_det_non_ref + if(lambda_mrcc(i_state, k) == 0d0) cycle + call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) + + det_tmp(:,:) = 0_bit_kind + det_tmp2(:,:) = 0_bit_kind + + ok = .true. + do ni=1,N_int + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,k)), not(active_sorb(ni,1))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,i)), not(active_sorb(ni,1))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) - det_tmp(1,1) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,k)), not(active_sorb(2))) - det_tmp(1,2) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,i)), not(active_sorb(2))) - ok = ok .and. (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) - - if(ok) cycle - - - call i_h_j(psi_ref(1,1,J), psi_non_ref(1,1,k), N_int, HJk) - call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,k), N_int, HIk) - if(HJk == 0) cycle - !assert HIk == 0 - !delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) - delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) - if(ok) cycle -! contrib = delta_IJk * HIl * lambda_mrcc(i_state, l) - contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) - !$OMP CRITICAL - delta_sub_ij(II, i, i_state) += contrib - if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then - delta_sub_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) - endif - !$OMP END CRITICAL + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,k)), not(active_sorb(ni,2))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,i)), not(active_sorb(ni,2))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) + end do + + if(ok) cycle + + + call i_h_j(psi_ref(1,1,J), psi_non_ref(1,1,k), N_int, HJk) + call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,k), N_int, HIk) + if(HJk == 0) cycle + !assert HIk == 0 + delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(ok) cycle + contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) + !$OMP ATOMIC + delta_sub_ij(II, i, i_state) += contrib + if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then + !$OMP ATOMIC + delta_sub_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) + endif + end do end do end do end do + !$OMP END PARALLEL DO end do - !$OMP END PARALLEL DO deallocate(idx_sorted_bit) END_PROVIDER @@ -527,9 +377,9 @@ end subroutine implicit none integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, x(2), y(2) + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ logical :: ok - double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) double precision :: contrib integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) @@ -537,12 +387,7 @@ implicit none integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction - delta_ii_old(:,:) = 0 - delta_ij_old(:,:,:) = 0 - - - i_state = 1 - provide mo_bielec_integrals_in_map + provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) idx_sorted_bit(:) = -1 @@ -550,100 +395,102 @@ implicit none idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - !$OMP PARALLEL DO schedule(dynamic,10) default(firstprivate) shared(delta_ij_old, delta_ii_old) - do i = 1 , N_det_non_ref - if(lambda_mrcc(i_state, i) == 0d0) cycle - if(mod(i,1000) == 0) print "(A,I3,A)", "♫ sloubi", i/1000, " ♪ (old)" - do i_I = 1 , N_det_ref - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) - if(degree2 == -1) cycle + + + + do i_state = 1, N_states + + delta_ii_old(:,:) = 0 + delta_ij_old(:,:,:) = 0 + + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & + !$OMP private(i, J, k, degree, degree2, l, deg, ni) & + !$OMP private(ok,p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & + !$OMP private(phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & + !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & + !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & + !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb) + do i = 1 , N_det_non_ref + if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref + if(lambda_mrcc(i_state, i) == 0d0) cycle + do i_I = 1 , N_det_ref + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) + if(degree2 == -1) cycle ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) - call decode_exc(exc_iI,degree2,h1,p1,h2,p2,s1,s2) - - call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) - diI = hIi * lambda_mrcc(i_state, i) - do J = 1 , N_det_ref !!! - call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) - call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) - delta_JI = hJi * diI - do k = 1 , N_det_non_ref - if(lambda_mrcc(i_state, k) == 0d0) cycle - - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) - if(degree == -1) cycle + call decode_exc(exc_iI,degree2,h1,p1,h2,p2,s1,s2) + + call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) + diI = hIi * lambda_mrcc(i_state, i) + do J = 1 , N_det_ref !!! + call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) + call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) + delta_JI = hJi * diI + do k = 1 , N_det_non_ref + if(lambda_mrcc(i_state, k) == 0d0) cycle + + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) + if(degree == -1) cycle - call decode_exc(exc_Ik,degree,h1_,p1_,h2_,p2_,s1_,s2_) + call decode_exc(exc_Ik,degree,h1_,p1_,h2_,p2_,s1_,s2_) - - det_tmp(:,:) = 0_bit_kind - det_tmp2(:,:) = 0_bit_kind - - - det_tmp(1,1) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,k)), not(active_sorb(1))) - det_tmp(1,2) = iand(xor(HF_bitmask(1,1), psi_non_ref(1,1,i)), not(active_sorb(1))) - ok = (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) - - det_tmp(1,1) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,k)), not(active_sorb(2))) - det_tmp(1,2) = iand(xor(HF_bitmask(1,2), psi_non_ref(1,2,i)), not(active_sorb(2))) - ok = ok .and. (popcnt(det_tmp(1,1)) + popcnt(det_tmp(1,2)) == popcnt(xor(det_tmp(1,1), det_tmp(1,2)))) - if(.not. ok) cycle - - - - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) - - call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) + + det_tmp(:,:) = 0_bit_kind + det_tmp2(:,:) = 0_bit_kind + + ok = .true. + do ni=1,N_int + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,k)), not(active_sorb(ni,1))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,i)), not(active_sorb(ni,1))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) + + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,k)), not(active_sorb(ni,2))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,i)), not(active_sorb(ni,2))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) + end do + + if(.not. ok) cycle + + + + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + + call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) - - if(.not. ok) cycle - if(is_in_wavefunction(det_tmp, N_int)) cycle - + + if(.not. ok) cycle + if(is_in_wavefunction(det_tmp, N_int)) cycle + - call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp,ok,N_int) - if(.not. ok) cycle - - call get_excitation(psi_ref(1,1,J), det_tmp, exc_Ik, degree, phase_Jl, N_int) - - l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) - if(l == 0) cycle - l = idx_sorted_bit(get_index_in_psi_det_sorted_bit(det_tmp, N_int)) - if(l ==-1) cycle - - + call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp,ok,N_int) + if(.not. ok) cycle + + call get_excitation(psi_ref(1,1,J), det_tmp, exc_Ik, degree, phase_Jl, N_int) + + l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) + if(l == 0) cycle + l = idx_sorted_bit(get_index_in_psi_det_sorted_bit(det_tmp, N_int)) + if(l ==-1) cycle + + - call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) - !dkI(i_state) = HkI * lambda_mrcc(i_state,k) * phase_Jl * phase_Ik * Xref(I_i) - dkI(i_state) = HkI * lambda_mrcc(i_state, k) * phase_Jl * phase_Ik - - - !$OMP CRITICAL - contrib = dkI(i_state) * delta_JI - delta_ij_old(i_I,l,i_state) += contrib - if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then - delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(k,i_state) - endif - !$OMP END CRITICAL + call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) + dkI(i_state) = HkI * lambda_mrcc(i_state, k) * phase_Jl * phase_Ik + + contrib = dkI(i_state) * delta_JI + !$OMP ATOMIC + delta_ij_old(i_I,l,i_state) += contrib + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + !$OMP ATOMIC + delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(k,i_state) + endif + + enddo enddo enddo enddo - enddo - !$OMP END PARALLEL DO - -! double precision :: error, acc -! integer :: II -! error = 0d0 -! do i=1, N_det_non_ref -! acc = 0d0 -! do II=1, N_det_ref -! call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), N_int, HIi) -! acc += HIi * lambda_mrcc(i_state, i) * Xref(II) * psi_ref_coef(II, i_state) -! end do -! error += (psi_non_ref_coef(i, i_state) - acc)**2 -! end do -! print *, "QUALITY ", error - - + !$OMP END PARALLEL DO + end do deallocate(idx_sorted_bit) END_PROVIDER diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index b307ca85..69ccc563 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -42,7 +42,7 @@ subroutine mrcepa0_iterations ! E_past(j) = E_new ! j +=1 call save_wavefunction - if (iteration > 200) then + if (iteration > 0) then exit endif print*,'------------' @@ -55,9 +55,9 @@ subroutine mrcepa0_iterations print*,'------------' enddo call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") + call write_double(6,ci_energy_dressed(1)+rest,"Final MRCEPA0+rest energy") call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) call save_wavefunction - end subroutine set_generators_bitmasks_as_holes_and_particles @@ -85,7 +85,26 @@ subroutine set_generators_bitmasks_as_holes_and_particles enddo enddo touch generators_bitmask - - - end + + +BEGIN_PROVIDER [ double precision, rest ] + integer :: i, j + double precision :: hij, c0 + + c0 = 1d0 + do i=1,N_det_non_ref + c0 += psi_non_ref_coef(i,1)**2 + end do + c0 = dsqrt(c0) + print *, "C", c0 + rest = 0d0 + do i=1, N_det_non_ref + if(lambda_mrcc(1, i) == 0d0) then + do j=1, N_det_ref + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,i), N_int, hij) + rest += hij * psi_non_ref_coef(i,1) * psi_ref_coef(j,1) / c0 + end do + end if + end do +END_PROVIDER From 4298ab6ab03f216a7e51e25edb643edf09728d98 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 7 Apr 2016 11:13:14 +0200 Subject: [PATCH 08/42] bug in lambda_mrcc --- config/gfortran.cfg | 2 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 2 +- plugins/mrcepa0/dressing.irp.f | 2 +- plugins/mrcepa0/mrcepa0_general.irp.f | 23 +---------------------- 4 files changed, 4 insertions(+), 25 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 694ef0df..c0aa875f 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -35,7 +35,7 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Profiling flags ################# diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 295e27b0..c4f5c570 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -16,7 +16,7 @@ lambda_mrcc_pt2(0) = 0 do i=1,N_det_non_ref - call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef_normalized, N_int, N_det_ref,& + call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& size(psi_ref_coef,1), N_states,ihpsi_current) call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) do k=1,N_states diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 2010750e..64b4d511 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -124,7 +124,7 @@ END_PROVIDER provide lambda_mrcc do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas) + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do i=1,N_det_ref do j=1,i call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 69ccc563..525b70df 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -42,7 +42,7 @@ subroutine mrcepa0_iterations ! E_past(j) = E_new ! j +=1 call save_wavefunction - if (iteration > 0) then + if (iteration > 10) then exit endif print*,'------------' @@ -55,7 +55,6 @@ subroutine mrcepa0_iterations print*,'------------' enddo call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") - call write_double(6,ci_energy_dressed(1)+rest,"Final MRCEPA0+rest energy") call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) call save_wavefunction end @@ -88,23 +87,3 @@ subroutine set_generators_bitmasks_as_holes_and_particles end -BEGIN_PROVIDER [ double precision, rest ] - integer :: i, j - double precision :: hij, c0 - - c0 = 1d0 - do i=1,N_det_non_ref - c0 += psi_non_ref_coef(i,1)**2 - end do - c0 = dsqrt(c0) - print *, "C", c0 - rest = 0d0 - do i=1, N_det_non_ref - if(lambda_mrcc(1, i) == 0d0) then - do j=1, N_det_ref - call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,i), N_int, hij) - rest += hij * psi_non_ref_coef(i,1) * psi_ref_coef(j,1) / c0 - end do - end if - end do -END_PROVIDER From f2fef4a6dc37770d8c8842986c9b6f3d3488c159 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 7 Apr 2016 17:54:13 +0200 Subject: [PATCH 09/42] added pt2 to mrsc2/mrcepa0 --- plugins/MRCC_Utils/mrcc_general.irp.f | 61 -------- plugins/MRCC_Utils/mrcc_utils.irp.f | 49 +++++++ plugins/mrcepa0/mrcepa0.irp.f | 31 ++--- plugins/mrcepa0/mrcepa0_general.irp.f | 192 +++++++++++++++++++------- plugins/mrcepa0/mrsc2.irp.f | 32 ++--- plugins/mrcepa0/mrsc2sub.irp.f | 33 ++--- 6 files changed, 228 insertions(+), 170 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_general.irp.f b/plugins/MRCC_Utils/mrcc_general.irp.f index a0a4c895..d356e4b9 100644 --- a/plugins/MRCC_Utils/mrcc_general.irp.f +++ b/plugins/MRCC_Utils/mrcc_general.irp.f @@ -1,61 +1,3 @@ -subroutine run_mrcc - implicit none - call set_generators_bitmasks_as_holes_and_particles - call mrcc_iterations -end - -subroutine mrcc_iterations - implicit none - - integer :: i,j - - double precision :: E_new, E_old, delta_e - integer :: iteration,i_oscillations - double precision :: E_past(4), lambda - E_new = 0.d0 - delta_E = 1.d0 - iteration = 0 - j = 1 - i_oscillations = 0 - lambda = 1.d0 - do while (delta_E > 1.d-7) - iteration += 1 - print *, '===========================' - print *, 'MRCC Iteration', iteration - print *, '===========================' - print *, '' - E_old = sum(ci_energy_dressed) - print *, iteration, ci_energy_dressed(1) - call write_double(6,ci_energy_dressed(1),"MRCC energy") - call diagonalize_ci_dressed(lambda) - E_new = sum(ci_energy_dressed) - delta_E = dabs(E_new - E_old) -! if (E_new > E_old) then -! lambda = lambda * 0.7d0 -! else -! lambda = min(1.d0, lambda * 1.1d0) -! endif -! print *, 'energy lambda ', lambda -! E_past(j) = E_new -! j +=1 - call save_wavefunction - if (iteration > 0) then - exit - endif - print*,'------------' - print*,'VECTOR' - do i = 1, N_det_ref - print*,'' - print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) - print*,'delta_ii(i,1) = ',delta_ii(i,1) - enddo - print*,'------------' - enddo - call write_double(6,ci_energy_dressed(1),"Final MRCC energy") - call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) - call save_wavefunction - -end subroutine set_generators_bitmasks_as_holes_and_particles implicit none @@ -82,7 +24,4 @@ subroutine set_generators_bitmasks_as_holes_and_particles enddo enddo touch generators_bitmask - - - end diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index c4f5c570..8445a9c6 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -1,3 +1,52 @@ +! +! BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] +! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] +! implicit none +! BEGIN_DOC +! cm/ or perturbative 1/Delta_E(m) +! END_DOC +! integer :: i,k +! double precision :: ihpsi_current(N_states) +! integer :: i_pert_count +! double precision :: hii, lambda_pert +! lambda_mrcc_pt2(:) = 0d0 +! i_pert_count = 0 +! lambda_mrcc = 0.d0 +! +! do i=1,N_det_non_ref +! call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref, & +! size(psi_ref_coef,1), N_states,ihpsi_current) +! call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) +! do k=1,N_states +! if (ihpsi_current(k) == 0.d0) then +! ihpsi_current(k) = 1.d-32 +! endif +! lambda_mrcc(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) +! if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 ) then +! i_pert_count += 1 +! lambda_mrcc(k,i) = 0.d0 +! lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) +! if((ihpsi_current(k) * lambda_pert) < 0.5d0 * psi_non_ref_coef_restart(i,k) ) then +! lambda_mrcc(k,i) = 0.d0 +! endif +! endif +! double precision, parameter :: x = 2.d0 +! if (lambda_mrcc(k,i) > x) then +! lambda_mrcc(k,i) = x +! else if (lambda_mrcc(k,i) < -x) then +! lambda_mrcc(k,i) = -x +! endif +! enddo +! enddo +! +! print*,'N_det_non_ref = ',N_det_non_ref +! print*,'Number of ignored determinants = ',i_pert_count +! print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) +! print*,'lambda min/max = ',maxval(dabs(lambda_mrcc)), minval(dabs(lambda_mrcc)) +! +! END_PROVIDER + + BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] implicit none diff --git a/plugins/mrcepa0/mrcepa0.irp.f b/plugins/mrcepa0/mrcepa0.irp.f index 7877cdda..9473361b 100644 --- a/plugins/mrcepa0/mrcepa0.irp.f +++ b/plugins/mrcepa0/mrcepa0.irp.f @@ -1,26 +1,19 @@ program mrcepa0 implicit none + double precision, allocatable :: energy(:) + allocate (energy(N_states)) + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub mrmode = 1 - if (.not.read_wf) then - print *, 'read_wf has to be true.' - stop 1 - endif + + read_wf = .True. + SOFT_TOUCH read_wf call print_cas_coefs - call run_mrcepa0 -end - -subroutine print_cas_coefs - implicit none - - integer :: i,j - print *, 'CAS' - print *, '===' - do i=1,N_det_cas - print *, psi_cas_coef(i,:) - call debug_det(psi_cas(1,1,i),N_int) - enddo - - call write_double(6,ci_energy(1),"Initial CI energy") + call set_generators_bitmasks_as_holes_and_particles + call run(N_states,energy) + if(do_pt2_end)then + call run_pt2(N_states,energy) + endif + deallocate(energy) end diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 525b70df..b3390577 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -1,28 +1,33 @@ -subroutine run_mrcepa0 - implicit none - call set_generators_bitmasks_as_holes_and_particles - call mrcepa0_iterations -end + BEGIN_PROVIDER [ integer, mrmode ] END_PROVIDER -subroutine mrcepa0_iterations + +subroutine run(N_st,energy) implicit none - integer :: i,j + integer, intent(in) :: N_st + double precision, intent(out) :: energy(N_st) + + integer :: i double precision :: E_new, E_old, delta_e - integer :: iteration,i_oscillations + integer :: iteration double precision :: E_past(4), lambda + + integer :: n_it_mrcc_max + double precision :: thresh_mrcc + + thresh_mrcc = 1d-7 + n_it_mrcc_max = 10 + E_new = 0.d0 delta_E = 1.d0 iteration = 0 - j = 1 - i_oscillations = 0 lambda = 1.d0 - do while (delta_E > 1.d-7) + do while (delta_E > thresh_mrcc) iteration += 1 print *, '===========================' print *, 'MRCEPA0 Iteration', iteration @@ -33,57 +38,142 @@ subroutine mrcepa0_iterations call diagonalize_ci_dressed(lambda) E_new = sum(ci_energy_dressed) delta_E = dabs(E_new - E_old) -! if (E_new > E_old) then -! lambda = lambda * 0.7d0 -! else -! lambda = min(1.d0, lambda * 1.1d0) -! endif -! print *, 'energy lambda ', lambda -! E_past(j) = E_new -! j +=1 call save_wavefunction - if (iteration > 10) then + call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) + if (iteration > n_it_mrcc_max) then exit endif - print*,'------------' - print*,'VECTOR' - do i = 1, N_det_ref - print*,'' - print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) - print*,'delta_ii(i,1) = ',delta_ii(i,1) - enddo - print*,'------------' enddo call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") - call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) - call save_wavefunction + energy(:) = ci_energy_dressed(:) + end -subroutine set_generators_bitmasks_as_holes_and_particles - implicit none - integer :: i,k - do k = 1, N_generators_bitmask - do i = 1, N_int - ! Pure single part - generators_bitmask(i,1,1,k) = holes_operators(i,1) ! holes for pure single exc alpha - generators_bitmask(i,1,2,k) = particles_operators(i,1) ! particles for pure single exc alpha - generators_bitmask(i,2,1,k) = holes_operators(i,2) ! holes for pure single exc beta - generators_bitmask(i,2,2,k) = particles_operators(i,2) ! particles for pure single exc beta - ! Double excitation - generators_bitmask(i,1,3,k) = holes_operators(i,1) ! holes for first single exc alpha - generators_bitmask(i,1,4,k) = particles_operators(i,1) ! particles for first single exc alpha - generators_bitmask(i,2,3,k) = holes_operators(i,2) ! holes for first single exc beta - generators_bitmask(i,2,4,k) = particles_operators(i,2) ! particles for first single exc beta +subroutine run_pt2(N_st,energy) + implicit none + integer :: i,j,k + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + integer, intent(in) :: N_st + double precision, intent(in) :: energy(N_st) + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st)) + pt2 = 0.d0 + !if(lambda_mrcc_pt2(0) == 0) return + + print*,'Last iteration only to compute the PT2' + threshold_selectors = 1.d0 + threshold_generators = 0.999d0 + + N_det_generators = lambda_mrcc_pt2(0) + do i=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) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + + + call H_apply_mrcc_PT2(pt2, norm_pert, H_pert_diag, N_st) + print *, 'Final step' + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', energy + print *, 'E+PT2 = ', energy+pt2 + print *, '-----' + - generators_bitmask(i,1,5,k) = holes_operators(i,1) ! holes for second single exc alpha - generators_bitmask(i,1,6,k) = particles_operators(i,1) ! particles for second single exc alpha - generators_bitmask(i,2,5,k) = holes_operators(i,2) ! holes for second single exc beta - generators_bitmask(i,2,6,k) = particles_operators(i,2) ! particles for second single exc beta + call ezfio_set_full_ci_energy_pt2(energy+pt2) + deallocate(pt2,norm_pert) +end + + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, psi_cas_coef(i,:) + call debug_det(psi_cas(1,1,i),N_int) enddo - enddo - touch generators_bitmask + call write_double(6,ci_energy(1),"Initial CI energy") + end + + + + + + + + + +! subroutine run_mrcepa0 +! implicit none +! call set_generators_bitmasks_as_holes_and_particles +! call mrcepa0_iterations +! end +! + +! +! subroutine mrcepa0_iterations +! implicit none +! +! integer :: i,j +! +! double precision :: E_new, E_old, delta_e +! integer :: iteration,i_oscillations +! double precision :: E_past(4), lambda +! E_new = 0.d0 +! delta_E = 1.d0 +! iteration = 0 +! j = 1 +! i_oscillations = 0 +! lambda = 1.d0 +! do while (delta_E > 1.d-7) +! iteration += 1 +! print *, '===========================' +! print *, 'MRCEPA0 Iteration', iteration +! print *, '===========================' +! print *, '' +! E_old = sum(ci_energy_dressed) +! call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") +! call diagonalize_ci_dressed(lambda) +! E_new = sum(ci_energy_dressed) +! delta_E = dabs(E_new - E_old) +! ! if (E_new > E_old) then +! ! lambda = lambda * 0.7d0 +! ! else +! ! lambda = min(1.d0, lambda * 1.1d0) +! ! endif +! ! print *, 'energy lambda ', lambda +! ! E_past(j) = E_new +! ! j +=1 +! call save_wavefunction +! if (iteration > 10) then +! exit +! endif +! print*,'------------' +! print*,'VECTOR' +! do i = 1, N_det_ref +! print*,'' +! print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) +! print*,'delta_ii(i,1) = ',delta_ii(i,1) +! enddo +! print*,'------------' +! enddo +! call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") +! call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) +! call save_wavefunction +! end + diff --git a/plugins/mrcepa0/mrsc2.irp.f b/plugins/mrcepa0/mrsc2.irp.f index eb34adee..d4e1b1d4 100644 --- a/plugins/mrcepa0/mrsc2.irp.f +++ b/plugins/mrcepa0/mrsc2.irp.f @@ -1,26 +1,20 @@ -program mrcepa0 +program mrsc2 implicit none + double precision, allocatable :: energy(:) + allocate (energy(N_states)) + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub mrmode = 2 - if (.not.read_wf) then - print *, 'read_wf has to be true.' - stop 1 - endif + + read_wf = .True. + SOFT_TOUCH read_wf call print_cas_coefs - call run_mrcepa0 + call set_generators_bitmasks_as_holes_and_particles + call run(N_states,energy) + if(do_pt2_end)then + call run_pt2(N_states,energy) + endif + deallocate(energy) end -subroutine print_cas_coefs - implicit none - - integer :: i,j - print *, 'CAS' - print *, '===' - do i=1,N_det_cas - print *, psi_cas_coef(i,:) - call debug_det(psi_cas(1,1,i),N_int) - enddo - - call write_double(6,ci_energy(1),"Initial CI energy") -end diff --git a/plugins/mrcepa0/mrsc2sub.irp.f b/plugins/mrcepa0/mrsc2sub.irp.f index 524bbbd7..07a07c83 100644 --- a/plugins/mrcepa0/mrsc2sub.irp.f +++ b/plugins/mrcepa0/mrsc2sub.irp.f @@ -1,26 +1,19 @@ -program mrcepa0 +program mrsc2sub implicit none + double precision, allocatable :: energy(:) + allocate (energy(N_states)) + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub mrmode = 3 - if (.not.read_wf) then - print *, 'read_wf has to be true.' - stop 1 - endif + + read_wf = .True. + SOFT_TOUCH read_wf call print_cas_coefs - call run_mrcepa0 -end - -subroutine print_cas_coefs - implicit none - - integer :: i,j - print *, 'CAS' - print *, '===' - do i=1,N_det_cas - print *, psi_cas_coef(i,:) - call debug_det(psi_cas(1,1,i),N_int) - enddo - - call write_double(6,ci_energy(1),"Initial CI energy") + call set_generators_bitmasks_as_holes_and_particles + call run(N_states,energy) + if(do_pt2_end)then + call run_pt2(N_states,energy) + endif + deallocate(energy) end From 2774af5bbd00db04b2dd434e1e2da1533424e56a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 8 Apr 2016 13:25:55 +0200 Subject: [PATCH 10/42] experimental - OLD_LAMBDA and NO_MONO_DRESSING --- plugins/MRCC_Utils/mrcc_utils.irp.f | 133 ++++++++++++++++---------- plugins/mrcepa0/dressing.irp.f | 4 +- plugins/mrcepa0/mrcepa0_general.irp.f | 73 -------------- 3 files changed, 83 insertions(+), 127 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 8445a9c6..97d7e0d8 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -1,50 +1,74 @@ -! -! BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] -! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] -! implicit none -! BEGIN_DOC -! cm/ or perturbative 1/Delta_E(m) -! END_DOC -! integer :: i,k -! double precision :: ihpsi_current(N_states) -! integer :: i_pert_count -! double precision :: hii, lambda_pert -! lambda_mrcc_pt2(:) = 0d0 -! i_pert_count = 0 -! lambda_mrcc = 0.d0 -! -! do i=1,N_det_non_ref -! call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref, & -! size(psi_ref_coef,1), N_states,ihpsi_current) -! call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) -! do k=1,N_states -! if (ihpsi_current(k) == 0.d0) then -! ihpsi_current(k) = 1.d-32 -! endif -! lambda_mrcc(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) -! if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 ) then -! i_pert_count += 1 -! lambda_mrcc(k,i) = 0.d0 -! lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) -! if((ihpsi_current(k) * lambda_pert) < 0.5d0 * psi_non_ref_coef_restart(i,k) ) then -! lambda_mrcc(k,i) = 0.d0 -! endif -! endif -! double precision, parameter :: x = 2.d0 -! if (lambda_mrcc(k,i) > x) then -! lambda_mrcc(k,i) = x -! else if (lambda_mrcc(k,i) < -x) then -! lambda_mrcc(k,i) = -x + + BEGIN_PROVIDER [ integer, mrmode ] +&BEGIN_PROVIDER [ logical, old_lambda ] +&BEGIN_PROVIDER [ logical, no_mono_dressing ] + implicit none + CHARACTER(len=255) :: test + CALL get_environment_variable("OLD_LAMBDA", test) + old_lambda = trim(test) /= "" .and. trim(test) /= "0" + CALL get_environment_variable("NO_MONO_DRESSING", test) + no_mono_dressing = trim(test) /= "" .and. trim(test) /= "0" + print *, "old", old_lambda, "mono", no_mono_dressing + mrmode = 0 +END_PROVIDER + + + +BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] +&BEGIN_PROVIDER [ integer, lambda_mrcc_pt2_old, (0:psi_det_size) ] + implicit none + BEGIN_DOC + cm/ or perturbative 1/Delta_E(m) + END_DOC + integer :: i,k + double precision :: ihpsi_current(N_states) + integer :: i_pert_count + double precision :: hii, lambda_pert + integer :: N_lambda_mrcc_pt2 + double precision, parameter :: x = 2.d0 + + i_pert_count = 0 + lambda_mrcc_old = 0.d0 + N_lambda_mrcc_pt2 = 0 + lambda_mrcc_pt2_old(0) = 0 + + do i=1,N_det_non_ref + call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref, & + size(psi_ref_coef,1), N_states,ihpsi_current) + call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) + do k=1,N_states + if (ihpsi_current(k) == 0.d0) then + ihpsi_current(k) = 1.d-32 + endif + lambda_mrcc_old(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) + if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 ) then + i_pert_count += 1 + lambda_mrcc_old(k,i) = 0.d0 + if (lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) /= i) then + N_lambda_mrcc_pt2 += 1 + lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) = i + endif +! lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) +! if((ihpsi_current(k) * lambda_pert) < 0.5d0 * psi_non_ref_coef_restart(i,k) ) then +! lambda_mrcc_old(k,i) = 0.d0 ! endif -! enddo -! enddo -! -! print*,'N_det_non_ref = ',N_det_non_ref -! print*,'Number of ignored determinants = ',i_pert_count -! print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) -! print*,'lambda min/max = ',maxval(dabs(lambda_mrcc)), minval(dabs(lambda_mrcc)) -! -! END_PROVIDER + endif + + if (lambda_mrcc_old(k,i) > x) then + lambda_mrcc_old(k,i) = x + else if (lambda_mrcc_old(k,i) < -x) then + lambda_mrcc_old(k,i) = -x + endif + enddo + enddo + lambda_mrcc_pt2_old(0) = N_lambda_mrcc_pt2 + + print*,'N_det_non_ref = ',N_det_non_ref + print*,'Number of ignored determinants = ',i_pert_count + print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) + print*,'lambda min/max = ',maxval(dabs(lambda_mrcc_old)), minval(dabs(lambda_mrcc_old)) + +END_PROVIDER BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] @@ -58,11 +82,15 @@ integer :: i_pert_count double precision :: hii, lambda_pert integer :: N_lambda_mrcc_pt2 - - i_pert_count = 0 - lambda_mrcc = 0.d0 - N_lambda_mrcc_pt2 = 0 - lambda_mrcc_pt2(0) = 0 + + if(old_lambda) then + lambda_mrcc = lambda_mrcc_old + lambda_mrcc_pt2 = lambda_mrcc_pt2_old + else + i_pert_count = 0 + lambda_mrcc = 0.d0 + N_lambda_mrcc_pt2 = 0 + lambda_mrcc_pt2(0) = 0 do i=1,N_det_non_ref call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& @@ -85,9 +113,10 @@ enddo enddo lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 + end if print*,'N_det_non_ref = ',N_det_non_ref - print*,'Number of ignored determinants = ',i_pert_count + !print*,'Number of ignored determinants = ',i_pert_count print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) print*,'lambda max = ',maxval(dabs(lambda_mrcc)) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 64b4d511..ca9f00d2 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -124,11 +124,11 @@ END_PROVIDER provide lambda_mrcc do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do i=1,N_det_ref do j=1,i call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) - if(degree /= 2 .and. degree /= 0) cycle + if(no_mono_dressing .and. degree == 1) cycle delta_cas(i,j,i_state) = 0d0 do k=1,N_det_non_ref diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index b3390577..053f0262 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -1,10 +1,5 @@ -BEGIN_PROVIDER [ integer, mrmode ] - -END_PROVIDER - - subroutine run(N_st,energy) implicit none @@ -109,71 +104,3 @@ subroutine print_cas_coefs end - - - - - - - - - -! subroutine run_mrcepa0 -! implicit none -! call set_generators_bitmasks_as_holes_and_particles -! call mrcepa0_iterations -! end -! - -! -! subroutine mrcepa0_iterations -! implicit none -! -! integer :: i,j -! -! double precision :: E_new, E_old, delta_e -! integer :: iteration,i_oscillations -! double precision :: E_past(4), lambda -! E_new = 0.d0 -! delta_E = 1.d0 -! iteration = 0 -! j = 1 -! i_oscillations = 0 -! lambda = 1.d0 -! do while (delta_E > 1.d-7) -! iteration += 1 -! print *, '===========================' -! print *, 'MRCEPA0 Iteration', iteration -! print *, '===========================' -! print *, '' -! E_old = sum(ci_energy_dressed) -! call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") -! call diagonalize_ci_dressed(lambda) -! E_new = sum(ci_energy_dressed) -! delta_E = dabs(E_new - E_old) -! ! if (E_new > E_old) then -! ! lambda = lambda * 0.7d0 -! ! else -! ! lambda = min(1.d0, lambda * 1.1d0) -! ! endif -! ! print *, 'energy lambda ', lambda -! ! E_past(j) = E_new -! ! j +=1 -! call save_wavefunction -! if (iteration > 10) then -! exit -! endif -! print*,'------------' -! print*,'VECTOR' -! do i = 1, N_det_ref -! print*,'' -! print*,'psi_ref_coef(i,1) = ',psi_ref_coef(i,1) -! print*,'delta_ii(i,1) = ',delta_ii(i,1) -! enddo -! print*,'------------' -! enddo -! call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") -! call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) -! call save_wavefunction -! end - From 35d75d36a345eea97f87f41e982ef784f2834149 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sun, 10 Apr 2016 12:30:22 +0200 Subject: [PATCH 11/42] bug in delta_cas --- plugins/mrcepa0/dressing.irp.f | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index ca9f00d2..f76dca37 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -128,8 +128,8 @@ END_PROVIDER do i=1,N_det_ref do j=1,i call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) - if(no_mono_dressing .and. degree == 1) cycle delta_cas(i,j,i_state) = 0d0 + if(no_mono_dressing .and. degree == 1) cycle do k=1,N_det_non_ref call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) @@ -137,10 +137,14 @@ END_PROVIDER delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) end do - delta_cas(j,i,i_state) = delta_cas(i,j,i_state) end do end do !$OMP END PARALLEL DO + do i=1,N_det_ref + do j=1,i + delta_cas(j,i,i_state) = delta_cas(i,j,i_state) + end do + end do end do END_PROVIDER From 65cdad8f189beed8ec53719412f12b777a0a5b2c Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 11 Apr 2016 17:42:15 +0200 Subject: [PATCH 12/42] dirty - noiter version --- plugins/mrcepa0/dressing.irp.f | 6 +-- plugins/mrcepa0/mrcepa0_general.irp.f | 62 ++++++++++++++++----------- 2 files changed, 40 insertions(+), 28 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index f76dca37..7ebd712b 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -129,7 +129,7 @@ END_PROVIDER do j=1,i call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) delta_cas(i,j,i_state) = 0d0 - if(no_mono_dressing .and. degree == 1) cycle + !if(no_mono_dressing .and. degree == 1) cycle do k=1,N_det_non_ref call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) @@ -220,7 +220,7 @@ end function end do - kloop: do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + kloop: do k=cepa0_shortcut(blok), i ! cepa0_shortcut(blok+1)-1 if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle do ni=1,N_int @@ -426,7 +426,7 @@ implicit none call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) diI = hIi * lambda_mrcc(i_state, i) - do J = 1 , N_det_ref !!! + do J = 1 , i_I ! N_det_ref !!! call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) delta_JI = hJi * diI diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 053f0262..6694e80a 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -6,7 +6,7 @@ subroutine run(N_st,energy) integer, intent(in) :: N_st double precision, intent(out) :: energy(N_st) - integer :: i + integer :: i,j double precision :: E_new, E_old, delta_e integer :: iteration @@ -17,31 +17,43 @@ subroutine run(N_st,energy) thresh_mrcc = 1d-7 n_it_mrcc_max = 10 - - E_new = 0.d0 - delta_E = 1.d0 - iteration = 0 - lambda = 1.d0 - do while (delta_E > thresh_mrcc) - iteration += 1 - print *, '===========================' - print *, 'MRCEPA0 Iteration', iteration - print *, '===========================' - print *, '' - E_old = sum(ci_energy_dressed) - call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") - call diagonalize_ci_dressed(lambda) - E_new = sum(ci_energy_dressed) - delta_E = dabs(E_new - E_old) - call save_wavefunction - call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) - if (iteration > n_it_mrcc_max) then - exit - endif - enddo - call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") - energy(:) = ci_energy_dressed(:) + if(no_mono_dressing) then + do j=1,N_states_diag + do i=1,N_det + psi_coef(i,j) = CI_eigenvectors_dressed(i,j) + enddo + enddo + SOFT_TOUCH psi_coef ci_energy_dressed + call write_double(6,ci_energy_dressed(1),"Final MRCC energy") + call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) + call save_wavefunction + energy(:) = ci_energy_dressed(:) + else + E_new = 0.d0 + delta_E = 1.d0 + iteration = 0 + lambda = 1.d0 + do while (delta_E > thresh_mrcc) + iteration += 1 + print *, '===========================' + print *, 'MRCEPA0 Iteration', iteration + print *, '===========================' + print *, '' + E_old = sum(ci_energy_dressed) + call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") + call diagonalize_ci_dressed(lambda) + E_new = sum(ci_energy_dressed) + delta_E = dabs(E_new - E_old) + call save_wavefunction + call ezfio_set_mrcc_cassd_energy(ci_energy_dressed(1)) + if (iteration > n_it_mrcc_max) then + exit + endif + enddo + call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") + energy(:) = ci_energy_dressed(:) + endif end From 7538187cf5a20162343c8fdf6b4b9402030c26be Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 15 Apr 2016 09:16:31 +0200 Subject: [PATCH 13/42] faster mrcepa0 --- plugins/mrcepa0/dressing.irp.f | 245 +++++++++++++++++++++++++-------- 1 file changed, 191 insertions(+), 54 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 7ebd712b..10b77b27 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -50,8 +50,8 @@ END_PROVIDER use bitmasks implicit none - integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2) - integer i, II, j, k + integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2), det(N_int, 2) + integer i, II, j, k, ni logical, external :: detEq active_sorb(:,:) = 0_8 @@ -115,7 +115,7 @@ END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] + BEGIN_PROVIDER [ double precision, delta_cas_old, (N_det_ref, N_det_ref, N_states) ] use bitmasks implicit none integer :: i,j,k @@ -127,7 +127,7 @@ END_PROVIDER !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do i=1,N_det_ref do j=1,i - call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) + !call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) delta_cas(i,j,i_state) = 0d0 !if(no_mono_dressing .and. degree == 1) cycle do k=1,N_det_non_ref @@ -149,6 +149,53 @@ END_PROVIDER END_PROVIDER + BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] + use bitmasks + implicit none + integer :: i,j,k + double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall + integer :: i_state, degree, npre, ipre(N_det_ref) + + provide lambda_mrcc + + delta_cas = 0d0 + call wall_time(wall) + print *, wall + do i_state = 1, N_states + !$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + do k=1,N_det_non_ref + if(lambda_mrcc(i_state, k) == 0d0) cycle + npre = 0 + do i=1,N_det_ref + call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) + if(Hki /= 0d0) then + npre += 1 + ipre(npre) = i + pre(npre) = Hki + end if + end do + do i=1,npre + do j=1,i + !$OMP ATOMIC + delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) + end do + end do + end do + !$OMP END PARALLEL DO + + do i=1,N_det_ref + do j=1,i + delta_cas(j,i,i_state) = delta_cas(i,j,i_state) + end do + end do + end do + + call wall_time(wall) + print *, wall +! stop + END_PROVIDER + + logical function detEq(a,b,Nint) use bitmasks implicit none @@ -165,6 +212,93 @@ logical function detEq(a,b,Nint) detEq = .true. end function +integer function detCmp(a,b,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) + integer :: ni, i + + detCmp = 0 + do i=1,2 + do ni=Nint,1,-1 + + if(a(ni,i) < b(ni,i)) then + detCmp = -1 + return + else if(a(ni,i) > b(ni,i)) then + detCmp = 1 + return + end if + + end do + end do +end function + + +integer function searchDet(dets, det, n, Nint) + implicit none + use bitmasks + + integer(bit_kind),intent(in) :: dets(Nint,2,n), det(Nint,2) + integer, intent(in) :: nint, n + integer :: l, h, c + integer, external :: detCmp + + l = 1 + h = n + do while(.true.) + searchDet = (l+h)/2 + c = detCmp(dets(1,1,searchDet), det(:,:), Nint) + if(c == 0) return + if(c == 1) then + h = searchDet-1 + else + l = searchDet+1 + end if + if(l > h) then + searchDet = -1 + return + end if + + end do +end function + + +subroutine sort_det(key, idx, N_key, Nint) + implicit none + + + integer, intent(in) :: Nint, N_key + integer(8),intent(inout) :: key(Nint,2,N_key) + integer,intent(out) :: idx(N_key) + integer(8) :: tmp(Nint, 2) + integer :: tmpidx,i,ni + + do i=1,N_key + idx(i) = i + end do + + do i=N_key/2,1,-1 + call tamiser(key, idx, i, N_key, Nint, N_key) + end do + + do i=N_key,2,-1 + do ni=1,Nint + tmp(ni,1) = key(ni,1,i) + tmp(ni,2) = key(ni,2,i) + key(ni,1,i) = key(ni,1,1) + key(ni,2,i) = key(ni,2,1) + key(ni,1,1) = tmp(ni,1) + key(ni,2,1) = tmp(ni,2) + enddo + + tmpidx = idx(i) + idx(i) = idx(1) + idx(1) = tmpidx + call tamiser(key, idx, 1, i-1, Nint, N_key) + end do +end subroutine @@ -174,15 +308,15 @@ end function implicit none integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) double precision :: contrib, HIIi, HJk integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2) + integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2), sortRef(N_int,2,N_det_ref) integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction + integer, external :: get_index_in_psi_det_sorted_bit, searchDet + logical, external :: is_in_wavefunction, detEq integer :: II, blok @@ -190,6 +324,9 @@ end function provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) + sortRef = det_ref_active(:,:,:N_det_ref) + call sort_det(sortRef, sortRefIdx, N_det_ref, N_int) + idx_sorted_bit(:) = -1 do i=1,N_det_non_ref idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i @@ -201,10 +338,10 @@ end function delta_mrcepa0_ij(:,:,:) = 0d0 !$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) & - !$OMP private(i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) & + !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) & !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) & - !$OMP shared(i_state) + !$OMP shared(i_state, sortRef, sortRefIdx) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref @@ -214,13 +351,13 @@ end function do ni=1,N_int made_hole(ni,1) = iand(det_ref_active(ni,1,II), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) made_hole(ni,2) = iand(det_ref_active(ni,2,II), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) - !made_particle = iand(det_cepa0_active(i), xor(det_cepa0_active(i), det_ref_active(II))) + made_particle(ni,1) = iand(det_cepa0_active(ni,1,i), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) made_particle(ni,2) = iand(det_cepa0_active(ni,2,i), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) end do - kloop: do k=cepa0_shortcut(blok), i ! cepa0_shortcut(blok+1)-1 + kloop: do k=cepa0_shortcut(blok), i if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle do ni=1,N_int @@ -236,23 +373,20 @@ end function myActive(ni,2) = xor(myActive(ni,2), made_particle(ni,2)) end do - jloop: do J=1,N_det_ref - do ni=1,N_int !!! replace with sort+search - if(det_ref_active(ni,1,J) /= myActive(ni,1)) cycle jloop - if(det_ref_active(ni,2,J) /= myActive(ni,2)) cycle jloop - end do - call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) - contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + j = searchDet(sortRef, myActive, N_det_ref, N_int) + if(j == -1) cycle + j = sortRefIdx(j) + + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) + contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + !$OMP ATOMIC + delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib + + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then !$OMP ATOMIC - delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib - - if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then - !$OMP ATOMIC - delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - end if - - exit - end do jloop + delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + end if + end do kloop end do end do @@ -310,8 +444,7 @@ END_PROVIDER do II=1,N_det_ref call apply_excitation(psi_ref(1,1,II),exc_Ji,det_tmp,ok,N_int) - !call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,i),exc_Ii,degree,phase_Ii,N_int) - + if(.not. ok) cycle l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) if(l == 0) cycle @@ -386,7 +519,7 @@ implicit none double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) double precision :: contrib integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction @@ -408,7 +541,7 @@ implicit none delta_ij_old(:,:,:) = 0 !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & - !$OMP private(i, J, k, degree, degree2, l, deg, ni) & + !$OMP private(i, J, k, degree, degree2, l, deg, ni, inac, virt) & !$OMP private(ok,p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & !$OMP private(phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & @@ -429,6 +562,7 @@ implicit none do J = 1 , i_I ! N_det_ref !!! call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) + if(hJi == 0) cycle delta_JI = hJi * diI do k = 1 , N_det_non_ref if(lambda_mrcc(i_state, k) == 0d0) cycle @@ -442,28 +576,33 @@ implicit none det_tmp(:,:) = 0_bit_kind det_tmp2(:,:) = 0_bit_kind - ok = .true. - do ni=1,N_int - det_tmp(ni,1) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,k)), not(active_sorb(ni,1))) - det_tmp(ni,2) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,i)), not(active_sorb(ni,1))) - ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) - - det_tmp(ni,1) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,k)), not(active_sorb(ni,2))) - det_tmp(ni,2) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,i)), not(active_sorb(ni,2))) - ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) - end do - - if(.not. ok) cycle - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) - - call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) + + + if(.not. ok) cycle + !if(is_in_wavefunction(det_tmp, N_int)) cycle + inac = iand(HF_bitmask(1,1), not(active_sorb(1,1))) + virt = iand(not(HF_bitmask(1,1)), not(active_sorb(1,1))) + + deg = 0 + deg += popcnt(xor(iand(inac,det_tmp(1,1)), inac)) + deg += popcnt(xor(iand(inac,det_tmp(1,2)), inac)) + if(deg <= 2) then + deg = 0 + deg += popcnt(iand(virt, det_tmp(1,1))) + deg += popcnt(iand(virt, det_tmp(1,2))) + if(deg <= 2) then + cycle + end if + end if + + + !call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) - if(.not. ok) cycle - if(is_in_wavefunction(det_tmp, N_int)) cycle + !if(is_in_wavefunction(det_tmp, N_int)) cycle call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp,ok,N_int) @@ -473,14 +612,14 @@ implicit none l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) if(l == 0) cycle - l = idx_sorted_bit(get_index_in_psi_det_sorted_bit(det_tmp, N_int)) + l = idx_sorted_bit(l) if(l ==-1) cycle call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) - dkI(i_state) = HkI * lambda_mrcc(i_state, k) * phase_Jl * phase_Ik - + dkI(i_state) = HkI * lambda_mrcc(i_state, k)! * phase_Jl * phase_Ik + !if( phase_Jl * phase_Ik < 0d0 ) stop "STOOOOOOP" contrib = dkI(i_state) * delta_JI !$OMP ATOMIC delta_ij_old(i_I,l,i_state) += contrib @@ -501,5 +640,3 @@ END_PROVIDER - - From 07077cf8835e90dc5fe2b55171f3587523638cb9 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 15 Apr 2016 15:16:46 +0200 Subject: [PATCH 14/42] faster mrsc2 --- plugins/mrcepa0/dressing.irp.f | 198 ++++++++++++++++++++++----------- 1 file changed, 132 insertions(+), 66 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 10b77b27..cb0747e8 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -47,6 +47,7 @@ END_PROVIDER &BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_int,2,N_det_non_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_int,2,N_det_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (N_int,2) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0, (N_int,2,N_det_non_ref) ] use bitmasks implicit none @@ -111,6 +112,12 @@ END_PROVIDER end if end do cepa0_shortcut(cepa0_shortcut(0)+1) = N_det_non_ref+1 + + do i=1,N_det_non_ref + det_cepa0(:,:,i) = psi_non_ref(:,:,det_cepa0_idx(i)) + end do + + print *, "pre done" END_PROVIDER @@ -154,26 +161,30 @@ END_PROVIDER implicit none integer :: i,j,k double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall - integer :: i_state, degree, npre, ipre(N_det_ref) + integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) provide lambda_mrcc - + npres = 0 delta_cas = 0d0 call wall_time(wall) - print *, wall + print *, "dcas ", wall do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + !$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do k=1,N_det_non_ref if(lambda_mrcc(i_state, k) == 0d0) cycle npre = 0 do i=1,N_det_ref call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) if(Hki /= 0d0) then + !$OMP ATOMIC + npres(i) += 1 npre += 1 ipre(npre) = i pre(npre) = Hki end if end do + + do i=1,npre do j=1,i !$OMP ATOMIC @@ -182,7 +193,13 @@ END_PROVIDER end do end do !$OMP END PARALLEL DO - + print *, npres + npre=0 + do i=1,N_det_ref + npre += npres(i) + end do + print *, npre + stop do i=1,N_det_ref do j=1,i delta_cas(j,i,i_state) = delta_cas(i,j,i_state) @@ -191,7 +208,7 @@ END_PROVIDER end do call wall_time(wall) - print *, wall + print *, "dcas", wall ! stop END_PROVIDER @@ -212,6 +229,39 @@ logical function detEq(a,b,Nint) detEq = .true. end function +logical function isInCassd(a,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2) + integer(bit_kind) :: inac, virt + integer :: ni, i, deg + + + isInCassd = .false. + + + deg = 0 + do i=1,2 + do ni=1,Nint + virt = iand(not(HF_bitmask(ni,i)), not(active_sorb(ni,i))) + deg += popcnt(iand(virt, a(ni,i))) + if(deg > 2) return + end do + end do + + deg = 0 + do i=1,2 + do ni=1,Nint + inac = iand(HF_bitmask(ni,i), not(active_sorb(ni,i))) + deg += popcnt(xor(iand(inac,a(ni,i)), inac)) + if(deg > 2) return + end do + end do + + isInCassd = .true. +end function + integer function detCmp(a,b,Nint) use bitmasks implicit none @@ -311,7 +361,7 @@ end subroutine integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) - double precision :: contrib, HIIi, HJk + double precision :: contrib, HIIi, HJk, wall integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2), sortRef(N_int,2,N_det_ref) integer, allocatable :: idx_sorted_bit(:) @@ -320,6 +370,8 @@ end subroutine integer :: II, blok + call wall_time(wall) + print *, "cepa0", wall provide det_cepa0_active delta_cas lambda_mrcc provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) @@ -394,6 +446,9 @@ end subroutine !$OMP END PARALLEL DO end do deallocate(idx_sorted_bit) + call wall_time(wall) + print *, "cepa0", wall + stop END_PROVIDER @@ -511,21 +566,24 @@ end subroutine BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] -implicit none + implicit none - integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, blok + integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) - double precision :: contrib + double precision :: contrib, wall, iwall integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction + integer, external :: get_index_in_psi_det_sorted_bit, searchDet + logical, external :: is_in_wavefunction, isInCassd - provide mo_bielec_integrals_in_map + + call wall_time(iwall) allocate(idx_sorted_bit(N_det)) + allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) idx_sorted_bit(:) = -1 do i=1,N_det_non_ref @@ -533,99 +591,105 @@ implicit none enddo - - do i_state = 1, N_states delta_ii_old(:,:) = 0 delta_ij_old(:,:,:) = 0 + !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_int) + do J = 1, N_det_ref + nlink(J) = 0 + do blok=1,cepa0_shortcut(0) + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) + if(degree <= 2) then + nlink(J) += 1 + linked(nlink(J),J) = k + blokMwen(nlink(J),J) = blok + end if + end do + end do + end do + !$OMP END PARALLEL DO + + + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & - !$OMP private(i, J, k, degree, degree2, l, deg, ni, inac, virt) & - !$OMP private(ok,p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & - !$OMP private(phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & + !$OMP private(kk, i, J, k, degree, degree2, l, deg, ni, inac, virt) & + !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall) & + !$OMP private(phase_iI, phase_Ik, phase_Jl, phase_IJ, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & - !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb) + !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0) & + !$OMP shared(det_cepa0_idx, linked, blokMwen, nlink, iwall) do i = 1 , N_det_non_ref - if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref + if(mod(i,100) == 0) then + call wall_time(wall) + wall = wall-iwall + print *, i, "/", N_det_non_ref, wall * (dfloat(N_det_non_ref) / dfloat(i)), wall, wall * (dfloat(N_det_non_ref) / dfloat(i))-wall + end if + if(lambda_mrcc(i_state, i) == 0d0) cycle - do i_I = 1 , N_det_ref + + + do i_I = 1, N_det_ref + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) if(degree2 == -1) cycle + + ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) - call decode_exc(exc_iI,degree2,h1,p1,h2,p2,s1,s2) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) diI = hIi * lambda_mrcc(i_state, i) do J = 1 , i_I ! N_det_ref !!! - call get_excitation(psi_ref(1,1,i_I),psi_ref(1,1,J),exc_IJ,degree,phase_IJ,N_int) call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) if(hJi == 0) cycle delta_JI = hJi * diI - do k = 1 , N_det_non_ref - if(lambda_mrcc(i_state, k) == 0d0) cycle + + do kk = 1 , nlink(i_I) + k = linked(kk,i_I) + blok = blokMwen(kk,i_I) - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) - if(degree == -1) cycle - - call decode_exc(exc_Ik,degree,h1_,p1_,h2_,p2_,s1_,s2_) - - - det_tmp(:,:) = 0_bit_kind - det_tmp2(:,:) = 0_bit_kind + if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle - - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + + call get_excitation(psi_ref(1,1,i_I),det_cepa0(1,1,k),exc_Ik,degree,phase_Ik,N_int) + !if(degree == -1) cycle + if(degree == -1) stop "STOP; ( linked )" + call apply_excitation(det_cepa0(1,1,i),exc_Ik,det_tmp,ok,N_int) if(.not. ok) cycle - !if(is_in_wavefunction(det_tmp, N_int)) cycle - inac = iand(HF_bitmask(1,1), not(active_sorb(1,1))) - virt = iand(not(HF_bitmask(1,1)), not(active_sorb(1,1))) - - deg = 0 - deg += popcnt(xor(iand(inac,det_tmp(1,1)), inac)) - deg += popcnt(xor(iand(inac,det_tmp(1,2)), inac)) - if(deg <= 2) then - deg = 0 - deg += popcnt(iand(virt, det_tmp(1,1))) - deg += popcnt(iand(virt, det_tmp(1,2))) - if(deg <= 2) then - cycle - end if - end if - - !call get_excitation(psi_non_ref(1,1,i), det_tmp, exc_Ik, degree, phase_al, N_int) - - !if(is_in_wavefunction(det_tmp, N_int)) cycle - - call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp,ok,N_int) + call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) if(.not. ok) cycle - - call get_excitation(psi_ref(1,1,J), det_tmp, exc_Ik, degree, phase_Jl, N_int) - - l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) - if(l == 0) cycle + + if(isInCassd(det_tmp, N_int)) cycle + + l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1) - cepa0_shortcut(blok), N_int) + !print *, "LL", l + if(l == -1) cycle !! -1 pour + l += cepa0_shortcut(blok) - 1 + l = det_cepa0_idx(l) + l = idx_sorted_bit(l) if(l ==-1) cycle - call i_h_j(psi_non_ref(1,1,k), psi_ref(1,1,i_I),N_int,HkI) - dkI(i_state) = HkI * lambda_mrcc(i_state, k)! * phase_Jl * phase_Ik - !if( phase_Jl * phase_Ik < 0d0 ) stop "STOOOOOOP" + call i_h_j(det_cepa0(1,1,k), psi_ref(1,1,i_I),N_int,HkI) + dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) contrib = dkI(i_state) * delta_JI !$OMP ATOMIC delta_ij_old(i_I,l,i_state) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then !$OMP ATOMIC - delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(k,i_state) + delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) endif enddo @@ -635,6 +699,8 @@ implicit none !$OMP END PARALLEL DO end do deallocate(idx_sorted_bit) +! call wall_time(wall) +! print *, "old ", wall END_PROVIDER From 39f7631abcafe1ccb8d4ce20c321eca7ebd9f8f5 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 26 Apr 2016 17:27:21 +0200 Subject: [PATCH 15/42] working mrsc2 --- plugins/MRCC_Utils/mrcc_dress.irp.f | 6 + plugins/MRCC_Utils/mrcc_utils.irp.f | 10 ++ plugins/mrcepa0/dressing.irp.f | 257 +++++++++++++++++++--------- 3 files changed, 189 insertions(+), 84 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index b2304818..1eb4435c 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -299,6 +299,12 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge call omp_unset_lock( psi_ref_lock(i_I) ) enddo enddo + +! 5.7717252361566333E-005 +! -1.4525812360153183E-005 +! -3.3282906594800186E-005 +! -1.3864228814283882E-004 + !deallocate (dIa_hla,hij_cache) !deallocate(miniList, idx_miniList) end diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 97d7e0d8..71757987 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -82,6 +82,8 @@ END_PROVIDER integer :: i_pert_count double precision :: hii, lambda_pert integer :: N_lambda_mrcc_pt2 + integer :: histo(200), j + histo = 0 if(old_lambda) then lambda_mrcc = lambda_mrcc_old @@ -110,11 +112,18 @@ END_PROVIDER lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i endif endif + j = int(lambda_mrcc(k,i) * 100) + if(j < -200) j = -200 + if(j > 200) j = 200 + histo(j) += 1 enddo enddo lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 end if +! do i=-200,200 +! print *, i, histo(i) +! end do print*,'N_det_non_ref = ',N_det_non_ref !print*,'Number of ignored determinants = ',i_pert_count print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) @@ -152,6 +161,7 @@ END_PROVIDER delta_ij = 0.d0 delta_ii = 0.d0 call H_apply_mrcc(delta_ij,delta_ii,N_states,N_det_non_ref,N_det_ref) + END_PROVIDER BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index cb0747e8..a02635ad 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -37,6 +37,19 @@ use bitmasks stop "invalid mrmode" end if end do + do i=1,N_det_ref + print *, delta_ii(1,i) + end do + do i=1,N_det_non_ref + print *, delta_ij(1,i,:) + end do +! stop + +! 5.7717252361566333E-005 +! -1.4525812360153183E-005 +! -3.3282906594800186E-005 +! -1.3864228814283882E-004 + END_PROVIDER @@ -52,7 +65,7 @@ END_PROVIDER implicit none integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2), det(N_int, 2) - integer i, II, j, k, ni + integer i, II, j, k, n, ni, idx(N_det_non_ref), shortcut(0:N_det_non_ref+1) logical, external :: detEq active_sorb(:,:) = 0_8 @@ -82,30 +95,13 @@ END_PROVIDER call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) - do i=1,N_det_ref - do k=1, N_int - det_ref_active(k,1,i) = iand(psi_ref(k,1,i), active_sorb(k,1)) - det_ref_active(k,2,i) = iand(psi_ref(k,2,i), active_sorb(k,2)) - !det_ref_active(i) = det_ref_active(i) + iand(psi_ref(1,2,i), active_sorb(2)) * 2_8**32_8 - end do - end do - - cepa0_shortcut(0) = 1 - cepa0_shortcut(1) = 1 - do k=1, N_int - det_cepa0_active(k,1,1) = iand(psi_non_ref(k,1,det_cepa0_idx(1)), active_sorb(k,1)) - det_cepa0_active(k,2,1) = iand(psi_non_ref(k,2,det_cepa0_idx(1)), active_sorb(k,2)) - !det_cepa0_active(1) = det_cepa0_active(1) + iand(psi_non_ref(1,2,det_cepa0_idx(1)), active_sorb(2)) * 2_8**32_8 + do i=1,N_det_non_ref + det_cepa0(:,:,i) = psi_non_ref(:,:,det_cepa0_idx(i)) end do + cepa0_shortcut(0) = 1 + cepa0_shortcut(1) = 1 do i=2,N_det_non_ref - do k=1, N_int - det_cepa0_active(k,1,i) = iand(psi_non_ref(k,1,det_cepa0_idx(i)), active_sorb(k,1)) - det_cepa0_active(k,2,i) = iand(psi_non_ref(k,2,det_cepa0_idx(i)), active_sorb(k,2)) - end do -! det_cepa0_active(i) = iand(psi_non_ref(1,1,det_cepa0_idx(i)), active_sorb(1)) -! det_cepa0_active(i) = det_cepa0_active(i) + iand(psi_non_ref(1,2,det_cepa0_idx(i)), active_sorb(2)) * 2_8**32_8 - if(.not. detEq(det_noactive(1,1,i), det_noactive(1,1,i-1), N_int)) then cepa0_shortcut(0) += 1 cepa0_shortcut(cepa0_shortcut(0)) = i @@ -113,10 +109,35 @@ END_PROVIDER end do cepa0_shortcut(cepa0_shortcut(0)+1) = N_det_non_ref+1 - do i=1,N_det_non_ref - det_cepa0(:,:,i) = psi_non_ref(:,:,det_cepa0_idx(i)) + if(.true.) then + do i=1,cepa0_shortcut(0) + n = cepa0_shortcut(i+1) - cepa0_shortcut(i) + call sort_dets_ab(det_cepa0(1,1,cepa0_shortcut(i)), idx, shortcut, n, N_int) + do k=1,n + idx(k) = det_cepa0_idx(cepa0_shortcut(i)-1+idx(k)) + end do + det_cepa0_idx(cepa0_shortcut(i):cepa0_shortcut(i)+n-1) = idx(:n) + end do + end if + + + do i=1,N_det_ref + do k=1, N_int + det_ref_active(k,1,i) = iand(psi_ref(k,1,i), active_sorb(k,1)) + det_ref_active(k,2,i) = iand(psi_ref(k,2,i), active_sorb(k,2)) + end do end do + do i=1,N_det_non_ref + do k=1, N_int + det_cepa0_active(k,1,i) = iand(psi_non_ref(k,1,det_cepa0_idx(i)), active_sorb(k,1)) + det_cepa0_active(k,2,i) = iand(psi_non_ref(k,2,det_cepa0_idx(i)), active_sorb(k,2)) + end do + end do + + do i=1,N_det_non_ref + if(.not. detEq(psi_non_ref(1,1,det_cepa0_idx(i)), det_cepa0(1,1,i),N_int)) stop "STOOOP" + end do print *, "pre done" END_PROVIDER @@ -199,7 +220,7 @@ END_PROVIDER npre += npres(i) end do print *, npre - stop + !stop do i=1,N_det_ref do j=1,i delta_cas(j,i,i_state) = delta_cas(i,j,i_state) @@ -294,7 +315,18 @@ integer function searchDet(dets, det, n, Nint) integer, intent(in) :: nint, n integer :: l, h, c integer, external :: detCmp - + logical, external :: detEq + + !do l=1,n + ! if(detEq(det(1,1), dets(1,1,l),Nint)) then + ! searchDet = l + ! return + ! end if + !end do + !searchDet = -1 + !return + + l = 1 h = n do while(.true.) @@ -369,14 +401,15 @@ end subroutine logical, external :: is_in_wavefunction, detEq integer :: II, blok - + integer*8, save :: notf = 0 + call wall_time(wall) print *, "cepa0", wall provide det_cepa0_active delta_cas lambda_mrcc provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) - sortRef = det_ref_active(:,:,:N_det_ref) + sortRef(:,:,:) = det_ref_active(:,:,:) call sort_det(sortRef, sortRefIdx, N_det_ref, N_int) idx_sorted_bit(:) = -1 @@ -393,7 +426,7 @@ end subroutine !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) & !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) & - !$OMP shared(i_state, sortRef, sortRefIdx) + !$OMP shared(notf,i_state, sortRef, sortRefIdx) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref @@ -409,7 +442,7 @@ end subroutine end do - kloop: do k=cepa0_shortcut(blok), i + kloop: do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 !i if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle do ni=1,N_int @@ -426,9 +459,17 @@ end subroutine end do j = searchDet(sortRef, myActive, N_det_ref, N_int) - if(j == -1) cycle + if(j == -1) then + cycle + end if j = sortRefIdx(j) - + !$OMP ATOMIC + notf = notf+1 + !if(i/=k .and. dabs(psi_non_ref_coef(det_cepa0_idx(i),i_state)) < dabs(psi_non_ref_coef(det_cepa0_idx(k),i_state))) cycle +! if(dabs(lambda_mrcc(i_state,det_cepa0_idx(i))) > dabs(lambda_mrcc(i_state,det_cepa0_idx(k)))) cycle +! if(dabs(lambda_mrcc(i_state,det_cepa0_idx(i))) == dabs(lambda_mrcc(i_state,det_cepa0_idx(k))) .and. i < k) cycle + !if(.not. j==II .and. dabs(psi_ref_coef(II,i_state)) < dabs(psi_ref_coef(j,i_state))) cycle + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) !$OMP ATOMIC @@ -436,7 +477,7 @@ end subroutine if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then !$OMP ATOMIC - delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) end if end do kloop @@ -447,8 +488,8 @@ end subroutine end do deallocate(idx_sorted_bit) call wall_time(wall) - print *, "cepa0", wall - stop + print *, "cepa0", wall, notf + !stop END_PROVIDER @@ -564,21 +605,31 @@ subroutine set_det_bit(det, p, s) end subroutine +BEGIN_PROVIDER [ double precision, h_, (N_det_ref,N_det_non_ref) ] + integer :: i,j + do i=1,N_det_ref + do j=1,N_det_non_ref + call i_h_j(psi_ref(1,1,i), psi_non_ref(1,1,j), N_int, h_(i,j)) + end do + end do +END_PROVIDER + + BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] implicit none integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, blok + integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) logical :: ok - double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) + double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) double precision :: contrib, wall, iwall integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt - integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit, searchDet - logical, external :: is_in_wavefunction, isInCassd + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp + logical, external :: is_in_wavefunction, isInCassd, detEq call wall_time(iwall) @@ -593,10 +644,10 @@ end subroutine do i_state = 1, N_states - delta_ii_old(:,:) = 0 - delta_ij_old(:,:,:) = 0 + delta_ii_old(:,:) = 0d0 + delta_ij_old(:,:,:) = 0d0 - !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_int) + !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(nlink,linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_det_ref, N_int) do J = 1, N_det_ref nlink(J) = 0 do blok=1,cepa0_shortcut(0) @@ -615,13 +666,13 @@ end subroutine !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & - !$OMP private(kk, i, J, k, degree, degree2, l, deg, ni, inac, virt) & - !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall) & - !$OMP private(phase_iI, phase_Ik, phase_Jl, phase_IJ, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & + !$OMP private(m,kk, i_I, i, J, k, degree, degree2, l, deg, ni, inac, virt) & + !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall, I_s, J_s) & + !$OMP private(phase_iI, phase_Ik, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0) & - !$OMP shared(det_cepa0_idx, linked, blokMwen, nlink, iwall) + !$OMP shared(h_,det_cepa0_idx, linked, blokMwen, nlink, iwall) do i = 1 , N_det_non_ref if(mod(i,100) == 0) then call wall_time(wall) @@ -632,28 +683,38 @@ end subroutine if(lambda_mrcc(i_state, i) == 0d0) cycle - do i_I = 1, N_det_ref + do I_s = 1, N_det_ref + do J_s = 1, N_det_ref - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) - if(degree2 == -1) cycle - - - ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) - - - call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) - diI = hIi * lambda_mrcc(i_state, i) - do J = 1 , i_I ! N_det_ref !!! - call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) + if(.true. .or. nlink(I_s) < nlink(J_s)) then + i_I = I_s + J = J_s + else + i_I = J_s + J = I_s + end if + + !call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) + !!!! + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) + !!!!!! + hJi = h_(J,i) if(hJi == 0) cycle + hIi = h_(i_I,i) + if(hIi == 0) cycle + + diI = hIi * lambda_mrcc(i_state, i) delta_JI = hJi * diI + + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) + if(degree2 == -1) cycle + !call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) do kk = 1 , nlink(i_I) k = linked(kk,i_I) blok = blokMwen(kk,i_I) - if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle - + !if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle call get_excitation(psi_ref(1,1,i_I),det_cepa0(1,1,k),exc_Ik,degree,phase_Ik,N_int) @@ -661,44 +722,72 @@ end subroutine if(degree == -1) stop "STOP; ( linked )" - call apply_excitation(det_cepa0(1,1,i),exc_Ik,det_tmp,ok,N_int) + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(.not. ok) cycle - - call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) if(.not. ok) cycle if(isInCassd(det_tmp, N_int)) cycle + + + l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) + if(l == -1) cycle + l = det_cepa0_idx(cepa0_shortcut(blok)-1+l) + !call i_h_j(det_cepa0(1,1,k), det_tmp, N_int, HiI) + !call i_h_j(psi_non_ref(1,1,l), det_tmp, N_int, HJi) + call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) + + diI = hIi * lambda_mrcc(i_state, i) + delta_JI = hJi * diI * phase_al * phase_Ji + + - l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1) - cepa0_shortcut(blok), N_int) - !print *, "LL", l - if(l == -1) cycle !! -1 pour - l += cepa0_shortcut(blok) - 1 - l = det_cepa0_idx(l) - - l = idx_sorted_bit(l) - if(l ==-1) cycle - - + + !if(psi_ref_coef(I_i,i_state) < psi_ref_coef(J,i_state)) then + ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) + HkI = h_(i_I,det_cepa0_idx(k)) + dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) + contrib = dkI(i_state) * delta_JI + !!$OMP ATOMIC + delta_ij_old(i_I,l,i_state) += contrib + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + !!$OMP ATOMIC + delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) + else + delta_ii_old(i_I,i_state) = 0.d0 + endif +! - call i_h_j(det_cepa0(1,1,k), psi_ref(1,1,i_I),N_int,HkI) - dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) - contrib = dkI(i_state) * delta_JI - !$OMP ATOMIC - delta_ij_old(i_I,l,i_state) += contrib - if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then - !$OMP ATOMIC - delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - endif + + +! ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) +! HkI = h_(J,l) +! dkI(i_state) = HkI * lambda_mrcc(i_state, l) +! contrib = dkI(i_state) * delta_JI +! !!$OMP ATOMIC +! delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib +! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then +! !!$OMP ATOMIC +! delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) +! + +! end if enddo enddo enddo enddo - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO + +! do i=1,N_det_non_ref +! print *, delta_ij_old(:,i,i_state) +! end do +! stop end do deallocate(idx_sorted_bit) + + ! call wall_time(wall) ! print *, "old ", wall END_PROVIDER From eddc87531e538edd478acac812a4650c80f30053 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 28 Apr 2016 09:55:07 +0200 Subject: [PATCH 16/42] zmq mrsc2 - bad granularity --- config/gfortran.cfg | 2 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 8 +- plugins/mrcepa0/NEEDED_CHILDREN_MODULES | 2 +- plugins/mrcepa0/dressing.irp.f | 229 +++++++++++++++++++----- 4 files changed, 195 insertions(+), 46 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index c0aa875f..a1940bdb 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 # 0 : Deactivate # [OPTION] -MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below CACHE : 1 ; Enable cache_compile.py OPENMP : 1 ; Append OpenMP flags diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 71757987..cfaf7a67 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -112,10 +112,10 @@ END_PROVIDER lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i endif endif - j = int(lambda_mrcc(k,i) * 100) - if(j < -200) j = -200 - if(j > 200) j = 200 - histo(j) += 1 +! j = int(lambda_mrcc(k,i) * 100) +! if(j < -200) j = -200 +! if(j > 200) j = 200 +! histo(j) += 1 enddo enddo lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 diff --git a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES index a8404d62..8b6c5a18 100644 --- a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES +++ b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils +Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index a02635ad..6e901962 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -40,15 +40,11 @@ use bitmasks do i=1,N_det_ref print *, delta_ii(1,i) end do - do i=1,N_det_non_ref + do i=1,min(N_det_non_ref,100) print *, delta_ij(1,i,:) end do ! stop -! 5.7717252361566333E-005 -! -1.4525812360153183E-005 -! -3.3282906594800186E-005 -! -1.3864228814283882E-004 END_PROVIDER @@ -615,8 +611,9 @@ BEGIN_PROVIDER [ double precision, h_, (N_det_ref,N_det_non_ref) ] END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] + + BEGIN_PROVIDER [ double precision, delta_ij_older, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_ii_older, (N_det_ref,N_states) ] implicit none integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni @@ -624,14 +621,17 @@ END_PROVIDER integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) - double precision :: contrib, wall, iwall + double precision :: contrib, wall, iwall, searchance(N_det_ref) + double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp logical, external :: is_in_wavefunction, isInCassd, detEq - + ! -459.6346665282306 + ! -459.6346665282306 + call wall_time(iwall) allocate(idx_sorted_bit(N_det)) allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) @@ -646,8 +646,8 @@ END_PROVIDER delta_ii_old(:,:) = 0d0 delta_ij_old(:,:,:) = 0d0 - - !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(nlink,linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_det_ref, N_int) + searchance = 0d0 + !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(searchance,nlink,linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_det_ref, N_int) do J = 1, N_det_ref nlink(J) = 0 do blok=1,cepa0_shortcut(0) @@ -657,6 +657,7 @@ END_PROVIDER nlink(J) += 1 linked(nlink(J),J) = k blokMwen(nlink(J),J) = blok + searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) end if end do end do @@ -664,6 +665,10 @@ END_PROVIDER !$OMP END PARALLEL DO +! do i=1,cepa0_shortcut(0) +! print *, cepa0_shortcut(i+1) - cepa0_shortcut(i) +! end do + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & !$OMP private(m,kk, i_I, i, J, k, degree, degree2, l, deg, ni, inac, virt) & @@ -672,7 +677,7 @@ END_PROVIDER !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0) & - !$OMP shared(h_,det_cepa0_idx, linked, blokMwen, nlink, iwall) + !$OMP shared(h_,det_cepa0_idx, linked, blokMwen, nlink, iwall, searchance) do i = 1 , N_det_non_ref if(mod(i,100) == 0) then call wall_time(wall) @@ -684,9 +689,10 @@ END_PROVIDER do I_s = 1, N_det_ref - do J_s = 1, N_det_ref + do J_s = 1, I_s - if(.true. .or. nlink(I_s) < nlink(J_s)) then + if(nlink(I_s) < nlink(J_s)) then + !if(searchance(I_s) < searchance(J_s)) then i_I = I_s J = J_s else @@ -696,7 +702,7 @@ END_PROVIDER !call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) !!!! - call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) + !!!!!! hJi = h_(J,i) if(hJi == 0) cycle @@ -736,43 +742,38 @@ END_PROVIDER l = det_cepa0_idx(cepa0_shortcut(blok)-1+l) !call i_h_j(det_cepa0(1,1,k), det_tmp, N_int, HiI) !call i_h_j(psi_non_ref(1,1,l), det_tmp, N_int, HJi) - call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) - diI = hIi * lambda_mrcc(i_state, i) - delta_JI = hJi * diI * phase_al * phase_Ji - - - !if(psi_ref_coef(I_i,i_state) < psi_ref_coef(J,i_state)) then + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) + call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) + delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) HkI = h_(i_I,det_cepa0_idx(k)) dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) contrib = dkI(i_state) * delta_JI - !!$OMP ATOMIC + !$OMP ATOMIC delta_ij_old(i_I,l,i_state) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then - !!$OMP ATOMIC + !$OMP ATOMIC delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) - else - delta_ii_old(i_I,i_state) = 0.d0 endif ! - - - -! ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) -! HkI = h_(J,l) -! dkI(i_state) = HkI * lambda_mrcc(i_state, l) -! contrib = dkI(i_state) * delta_JI -! !!$OMP ATOMIC -! delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib -! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then -! !!$OMP ATOMIC -! delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) -! - -! end if + if(l == det_cepa0_idx(k)) cycle + call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) + call get_excitation(det_tmp,det_cepa0(1,1,k),exc_IJ,degree2,phase_al,N_int) + delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji + + ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) + HkI = h_(J,l) + dkI(i_state) = HkI * lambda_mrcc(i_state, l) + contrib = dkI(i_state) * delta_JI + !$OMP ATOMIC + delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + !$OMP ATOMIC + delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) + end if enddo enddo @@ -792,6 +793,154 @@ END_PROVIDER ! print *, "old ", wall END_PROVIDER +! +! BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] +! &BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] +! implicit none +! +! integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 +! integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s +! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) +! logical :: ok +! double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) +! double precision :: contrib, wall, iwall, searchance(N_det_ref) +! double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) +! integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ +! integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt +! integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp +! logical, external :: is_in_wavefunction, isInCassd, detEq +! +! ! -459.6346665282306 +! ! -459.6346665282306 +! +! call wall_time(iwall) +! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) +! +! +! delta_ii_old(:,:) = 0d0 +! delta_ij_old(:,:,:) = 0d0 +! +! searchance = 0d0 +! do J = 1, N_det_ref +! nlink(J) = 0 +! do blok=1,cepa0_shortcut(0) +! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 +! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) +! if(degree <= 2) then +! nlink(J) += 1 +! linked(nlink(J),J) = k +! blokMwen(nlink(J),J) = blok +! searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) +! end if +! end do +! end do +! end do +! +! +! +! do I_s = 1, N_det_ref +! if(mod(I_s,1) == 0) then +! call wall_time(wall) +! wall = wall-iwall +! print *, I_s, "/", N_det_ref, wall * (dfloat(N_det_ref) / dfloat(I_s)), wall, wall * (dfloat(N_det_ref) / dfloat(I_s))-wall +! end if +! +! +! do J_s = 1, I_s +! +! +! if(searchance(I_s) < searchance(J_s)) then +! i_I = I_s +! J = J_s +! else +! i_I = J_s +! J = I_s +! end if +! +! do kk = 1 , nlink(i_I) +! k = linked(kk,i_I) +! blok = blokMwen(kk,i_I) +! +! +! call get_excitation(psi_ref(1,1,i_I),det_cepa0(1,1,k),exc_Ik,degree,phase_Ik,N_int) +! +! call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) +! if(.not. ok) cycle +! +! +! +! +! l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) +! if(l == -1) cycle +! l = det_cepa0_idx(cepa0_shortcut(blok)-1+l) +! +! +! +! m = 1 +! m2 = 1 +! do while(m <= nlink(i_I) .and. m2 <= nlink(J)) +! if(linked(m, i_I) < linked(m2, J)) then +! m += 1 +! cycle +! else if(linked(m, i_I) > linked(m2, J)) then +! m2 += 1 +! cycle +! end if +! +! +! i = det_cepa0_idx(linked(m,i_I)) +! m += 1 +! m2 += 1 +! +! do i_state = 1, N_states +! if(lambda_mrcc(i_state, i) == 0d0) cycle +! +! +! hJi = h_(J,i) +! if(hJi == 0) cycle +! hIi = h_(i_I,i) +! if(hIi == 0) cycle +! +! call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) +! if(.not. ok) cycle +! +! +! if(isInCassd(det_tmp, N_int)) cycle +! +! +! call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) +! call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) +! delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji +! ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) +! HkI = h_(i_I,det_cepa0_idx(k)) +! dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) +! contrib = dkI(i_state) * delta_JI +! delta_ij_old(i_I,l,i_state) += contrib +! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then +! delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) +! endif +! ! +! if(l == det_cepa0_idx(k)) cycle +! call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) +! call get_excitation(det_tmp,det_cepa0(1,1,k),exc_IJ,degree2,phase_al,N_int) +! delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji +! +! ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) +! HkI = h_(J,l) +! dkI(i_state) = HkI * lambda_mrcc(i_state, l) +! contrib = dkI(i_state) * delta_JI +! delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib +! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then +! delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) +! end if +! enddo !i_state +! end do ! while +! enddo !kk +! enddo !J +! +! enddo !I +! +! END_PROVIDER From 174b5d006e4ef4c1cd0f40c0f1b0a0043b72210c Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 29 Apr 2016 16:23:20 +0200 Subject: [PATCH 17/42] optimized --- plugins/mrcepa0/dressing.irp.f | 121 ++++++++++++++++++++++----------- 1 file changed, 83 insertions(+), 38 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 6e901962..9b80ae09 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -20,10 +20,16 @@ use bitmasks end do end do else if(mrmode == 2) then +! do i = 1, N_det_ref +! delta_ii(i_state,i)= delta_ii_old(i,i_state) +! do j = 1, N_det_non_ref +! delta_ij(i_state,j,i) = delta_ij_old(i,j,i_state) +! end do +! end do do i = 1, N_det_ref - delta_ii(i_state,i)= delta_ii_old(i,i_state) + delta_ii(i_state,i)= delta_ii_old(i_state,i) do j = 1, N_det_non_ref - delta_ij(i_state,j,i) = delta_ij_old(i,j,i_state) + delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) end do end do else if(mrmode == 1) then @@ -37,12 +43,12 @@ use bitmasks stop "invalid mrmode" end if end do - do i=1,N_det_ref - print *, delta_ii(1,i) - end do - do i=1,min(N_det_non_ref,100) - print *, delta_ij(1,i,:) - end do +! do i=1,N_det_ref +! print *, delta_ii(1,i) +! end do +! do i=1,min(N_det_non_ref,100) +! print *, delta_ij(1,i,:) +! end do ! stop @@ -57,11 +63,17 @@ END_PROVIDER &BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_int,2,N_det_ref) ] &BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (N_int,2) ] &BEGIN_PROVIDER [ integer(bit_kind), det_cepa0, (N_int,2,N_det_non_ref) ] +&BEGIN_PROVIDER [ integer, nlink, (N_det_ref) ] +&BEGIN_PROVIDER [ integer, linked, (N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ integer, blokMwen, (N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, searchance, (N_det_ref) ] +&BEGIN_PROVIDER [ integer, child_num, (N_det_non_ref,N_det_ref) ] + use bitmasks implicit none integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2), det(N_int, 2) - integer i, II, j, k, n, ni, idx(N_det_non_ref), shortcut(0:N_det_non_ref+1) + integer i, II, j, k, n, ni, idx(N_det_non_ref), shortcut(0:N_det_non_ref+1), blok, degree logical, external :: detEq active_sorb(:,:) = 0_8 @@ -134,6 +146,25 @@ END_PROVIDER do i=1,N_det_non_ref if(.not. detEq(psi_non_ref(1,1,det_cepa0_idx(i)), det_cepa0(1,1,i),N_int)) stop "STOOOP" end do + + searchance = 0d0 + child_num = 0 + do J = 1, N_det_ref + nlink(J) = 0 + do blok=1,cepa0_shortcut(0) + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) + if(degree <= 2) then + nlink(J) += 1 + linked(nlink(J),J) = k + child_num(k, J) = nlink(J) + blokMwen(nlink(J),J) = blok + searchance(J) += 1d0 + log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) + end if + end do + end do + end do + print *, "pre done" END_PROVIDER @@ -186,14 +217,14 @@ END_PROVIDER call wall_time(wall) print *, "dcas ", wall do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + !!$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do k=1,N_det_non_ref if(lambda_mrcc(i_state, k) == 0d0) cycle npre = 0 do i=1,N_det_ref call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) if(Hki /= 0d0) then - !$OMP ATOMIC + !!$OMP ATOMIC npres(i) += 1 npre += 1 ipre(npre) = i @@ -204,12 +235,12 @@ END_PROVIDER do i=1,npre do j=1,i - !$OMP ATOMIC + !!$OMP ATOMIC delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) end do end do end do - !$OMP END PARALLEL DO + !!$OMP END PARALLEL DO print *, npres npre=0 do i=1,N_det_ref @@ -618,10 +649,10 @@ END_PROVIDER integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s - integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) +! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) - double precision :: contrib, wall, iwall, searchance(N_det_ref) + double precision :: contrib, wall, iwall ! , searchance(N_det_ref) double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt @@ -634,7 +665,7 @@ END_PROVIDER call wall_time(iwall) allocate(idx_sorted_bit(N_det)) - allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) +! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) idx_sorted_bit(:) = -1 do i=1,N_det_non_ref @@ -800,10 +831,10 @@ END_PROVIDER ! ! integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 ! integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s -! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) +! ! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) ! logical :: ok ! double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) -! double precision :: contrib, wall, iwall, searchance(N_det_ref) +! double precision :: contrib, wall, iwall !, searchance(N_det_ref) ! double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) ! integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ ! integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt @@ -814,27 +845,27 @@ END_PROVIDER ! ! -459.6346665282306 ! ! call wall_time(iwall) -! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) +! !allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) ! ! ! delta_ii_old(:,:) = 0d0 ! delta_ij_old(:,:,:) = 0d0 ! -! searchance = 0d0 -! do J = 1, N_det_ref -! nlink(J) = 0 -! do blok=1,cepa0_shortcut(0) -! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 -! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) -! if(degree <= 2) then -! nlink(J) += 1 -! linked(nlink(J),J) = k -! blokMwen(nlink(J),J) = blok -! searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) -! end if -! end do -! end do -! end do +! ! searchance = 0d0 +! ! do J = 1, N_det_ref +! ! nlink(J) = 0 +! ! do blok=1,cepa0_shortcut(0) +! ! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 +! ! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) +! ! if(degree <= 2) then +! ! nlink(J) += 1 +! ! linked(nlink(J),J) = k +! ! blokMwen(nlink(J),J) = blok +! ! searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) +! ! end if +! ! end do +! ! end do +! ! end do ! ! ! @@ -848,7 +879,9 @@ END_PROVIDER ! ! do J_s = 1, I_s ! -! +! call get_excitation_degree(psi_ref(1,1,J_s), psi_ref(1,1,I_s), degree, N_int) +! if(degree > 3) cycle +! ! if(searchance(I_s) < searchance(J_s)) then ! i_I = I_s ! J = J_s @@ -856,7 +889,15 @@ END_PROVIDER ! i_I = J_s ! J = I_s ! end if -! +! +! !$OMP PARALLEL DO default(none) schedule(dynamic,1) shared(delta_ij_old, delta_ii_old) & +! !$OMP private(m,m2,kk, i, k, degree, degree2, l, deg, ni, inac, virt) & +! !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall, I_s, J_s) & +! !$OMP private(phase_iI, phase_Ik, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & +! !$OMP private(i_state, contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & +! !$OMP shared(N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & +! !$OMP shared(lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0,N_states) & +! !$OMP shared(i_I, J, h_,det_cepa0_idx, linked, blokMwen, nlink, iwall, searchance) ! do kk = 1 , nlink(i_I) ! k = linked(kk,i_I) ! blok = blokMwen(kk,i_I) @@ -915,8 +956,10 @@ END_PROVIDER ! HkI = h_(i_I,det_cepa0_idx(k)) ! dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) ! contrib = dkI(i_state) * delta_JI +! !$OMP ATOMIC ! delta_ij_old(i_I,l,i_state) += contrib ! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then +! !$OMP ATOMIC ! delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) ! endif ! ! @@ -929,8 +972,10 @@ END_PROVIDER ! HkI = h_(J,l) ! dkI(i_state) = HkI * lambda_mrcc(i_state, l) ! contrib = dkI(i_state) * delta_JI +! !$OMP ATOMIC ! delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib ! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then +! !$OMP ATOMIC ! delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) ! end if ! enddo !i_state @@ -941,6 +986,6 @@ END_PROVIDER ! enddo !I ! ! END_PROVIDER - - +! ! +! From 23780fb7a9375d0d0ee7085695e838d13efedfa0 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 29 Apr 2016 16:28:12 +0200 Subject: [PATCH 18/42] forgot file --- plugins/mrcepa0/dressing_slave.irp.f | 597 +++++++++++++++++++++++++++ 1 file changed, 597 insertions(+) create mode 100644 plugins/mrcepa0/dressing_slave.irp.f diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f new file mode 100644 index 00000000..acaf4e34 --- /dev/null +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -0,0 +1,597 @@ +subroutine mrsc2_dressing_slave_tcp(i) + implicit none + integer, intent(in) :: i + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + call mrsc2_dressing_slave(0,i) +end + + +subroutine mrsc2_dressing_slave_inproc(i) + implicit none + integer, intent(in) :: i + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + call mrsc2_dressing_slave(1,i) +end + +subroutine mrsc2_dressing_slave(thread,iproc) + use f77_zmq + + implicit none + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + integer, intent(in) :: thread, iproc +! integer :: j,l + integer :: rc + + integer :: worker_id, task_id + character*(512) :: task + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_push_socket + integer(ZMQ_PTR) :: zmq_socket_push + + double precision, allocatable :: delta(:,:,:) + + + + integer :: i_state, i, i_I, J, k, k2, k1, kk, ll, degree, degree2, m, l, deg, ni, m2 + integer :: idx(N_det_non_ref, 2), n(2) + integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, kn + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al + double precision :: diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv(N_states), cj_inv(N_states) + double precision :: contrib, wall, iwall, dleat(N_states,N_det_non_ref,2) + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt + integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp + logical, external :: is_in_wavefunction, isInCassd, detEq + integer :: komon(0:N_det_non_ref) + logical :: komoned + + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + zmq_socket_push = new_zmq_push_socket(thread) + + call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) + + allocate (delta(N_states,0:N_det_non_ref, 2)) + + + do + call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) + if (task_id == 0) exit + read (task,*) i_I, J, k1, k2 + do i_state=1, N_states + ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) + cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) + end do + !delta = 0.d0 + n = 0 + delta(:,0,:) = 0d0 + delta(:,:nlink(J),1) = 0d0 + delta(:,:nlink(i_I),2) = 0d0 + komon(0) = 0 + komoned = .false. + + + + + do kk = k1, k2 + k = det_cepa0_idx(linked(kk, i_I)) + blok = blokMwen(kk, i_I) + + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) + + if(J /= i_I) then + call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) + if(.not. ok) cycle + + l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) + if(l == -1) cycle + ll = cepa0_shortcut(blok)-1+l + l = det_cepa0_idx(ll) + ll = child_num(ll, J) + else + l = k + ll = kk + end if + + + if(.not. komoned) then + m = 0 + m2 = 0 + + do while(m < nlink(i_I) .and. m2 < nlink(J)) + m += 1 + m2 += 1 + if(linked(m, i_I) < linked(m2, J)) then + m2 -= 1 + cycle + else if(linked(m, i_I) > linked(m2, J)) then + m -= 1 + cycle + end if + i = det_cepa0_idx(linked(m, i_I)) + + if(h_(J,i) == 0.d0) cycle + if(h_(i_I,i) == 0.d0) cycle + + ok = .false. + do i_state=1, N_states + if(lambda_mrcc(i_state, i) /= 0d0) then + ok = .true. + exit + end if + end do + if(.not. ok) cycle +! + + komon(0) += 1 + kn = komon(0) + komon(kn) = i + + + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) + if(I_i /= J) call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ii,N_int) + if(I_i == J) phase_Ii = phase_Ji + + do i_state = 1,N_states + dkI = h_(J,i) * h_(i_I,i) * lambda_mrcc(i_state, i) + dleat(i_state, kn, 1) = dkI * phase_Ii + dleat(i_state, kn, 2) = dkI * phase_Ji + end do + + end do + + komoned = .true. + end if + + + do m = 1, komon(0) + + i = komon(m) + + hJi = h_(J,i) + hIi = h_(i_I,i) + + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(.not. ok) cycle + if(isInCassd(det_tmp, N_int)) cycle + + do i_state = 1, N_states + if(lambda_mrcc(i_state, i) == 0d0) cycle + + + call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) + contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2) * phase_al +! if(l /= det_cepa0_idx(linked(ll, J))) stop "SPTPqsdT" + delta(i_state,ll,1) += contrib + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + delta(i_state,0,1) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) + endif + + if(I_i == J) cycle + call get_excitation(det_tmp,psi_non_ref(1,1,k),exc_IJ,degree2,phase_al,N_int) +! cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) + contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1) * phase_al +! if(k /= linked(kk, I_i)) stop "SPTPT" + delta(i_state,kk,2) += contrib + !delta(i_state,det_cepa0_idx(k),2) += contrib + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + delta(i_state,0,2) -= contrib * cj_inv(i_state) * psi_non_ref_coef(k,i_state) + end if + enddo !i_state + end do ! while + end do ! kk + + + call push_mrsc2_results(zmq_socket_push, I_i, J, delta, task_id) + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) + +! end if + + enddo + + deallocate(delta) + + 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_push_socket(zmq_socket_push,thread) + +end + + +subroutine push_mrsc2_results(zmq_socket_push, I_i, J, delta, task_id) + use f77_zmq + implicit none + BEGIN_DOC +! Push integrals in the push socket + END_DOC + + integer, intent(in) :: i_I, J + integer(ZMQ_PTR), intent(in) :: zmq_socket_push + double precision :: delta(N_states, 0:N_det_non_ref, 2) + integer, intent(in) :: task_id + integer :: rc , i_state, i, kk, li + integer :: idx(N_det_non_ref,2), n(2) + logical :: ok + + rc = f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_send( zmq_socket_push, J, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, J, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + + do kk=1,2 + n(kk)=0 + if(kk == 1) li = nlink(j) + if(kk == 2) li = nlink(i_I) + do i=1, li + ok = .false. + do i_state=1,N_states + if(delta(i_state, i, kk) /= 0d0) then + ok = .true. + exit + end if + end do + + if(ok) then + n(kk) += 1 +! idx(n,kk) = i + if(kk == 1) then + idx(n(1),1) = det_cepa0_idx(linked(i, J)) + else + idx(n(2),2) = det_cepa0_idx(linked(i, i_I)) + end if + + do i_state=1, N_states + delta(i_state, n(kk), kk) = delta(i_state, i, kk) + end do + end if + end do + + rc = f77_zmq_send( zmq_socket_push, n(kk), 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, n, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + if(n(kk) /= 0) then + rc = f77_zmq_send( zmq_socket_push, delta(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) ! delta(1,0,1) = delta_I delta(1,0,2) = delta_J + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, delta, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_send( zmq_socket_push, idx(1,kk), n(kk)*4, ZMQ_SNDMORE) + if (rc /= n(kk)*4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, delta, 8*n(kk), ZMQ_SNDMORE)' + stop 'error' + endif + end if + end do + + + 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)' + stop 'error' + 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 +end + + + +subroutine pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, task_id) + use f77_zmq + implicit none + BEGIN_DOC +! Push integrals in the push socket + END_DOC + + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + integer, intent(out) :: i_I, J, n(2) + double precision, intent(inout) :: delta(N_states, 0:N_det_non_ref, 2) + integer, intent(out) :: task_id + integer :: rc , i, kk + integer,intent(out) :: idx(N_det_non_ref, 2) + logical :: ok + + rc = f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_recv( zmq_socket_pull, J, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, J, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + do kk = 1, 2 + rc = f77_zmq_recv( zmq_socket_pull, n(kk), 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, n, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + if(n(kk) /= 0) then + rc = f77_zmq_recv( zmq_socket_pull, delta(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, delta, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_recv( zmq_socket_pull, idx(1,kk), n(kk)*4, ZMQ_SNDMORE) + if (rc /= n(kk)*4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, delta, n(kk)*4, ZMQ_SNDMORE)' + stop 'error' + endif + end if + end do + + 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)' + stop 'error' + endif + + +! ! Activate is zmq_socket_pull is a REP +! integer :: idummy +! rc = f77_zmq_send( zmq_socket_pull, idummy, 4, 0) +! if (rc /= 4) then +! print *, irp_here, 'f77_zmq_send( zmq_socket_pull, idummy, 4, 0)' +! stop 'error' +! endif +end + + + +subroutine mrsc2_dressing_collector(delta_ii_,delta_ij_) + use f77_zmq + implicit none + BEGIN_DOC +! Collects results from the AO integral calculation + END_DOC + + double precision,intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) + double precision,intent(inout) :: delta_ii_(N_states,N_det_ref) + +! integer :: j,l + integer :: rc + + double precision, allocatable :: delta(:,:,:) + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_pull_socket + integer(ZMQ_PTR) :: zmq_socket_pull + + integer*8 :: control, accu + integer :: task_id, more + + integer :: I_i, J, l, i_state, n(2), kk + integer :: idx(N_det_non_ref,2) + + delta_ii_(:,:) = 0d0 + delta_ij_(:,:,:) = 0d0 + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + zmq_socket_pull = new_zmq_pull_socket() + + allocate ( delta(N_states,0:N_det_non_ref,2) ) + + more = 1 + do while (more == 1) + + call pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, task_id) + + + do l=1, n(1) + do i_state=1,N_states + delta_ij_(i_state,idx(l,1),i_I) += delta(i_state,l,1) + end do + end do + + do l=1, n(2) + do i_state=1,N_states + delta_ij_(i_state,idx(l,2),J) += delta(i_state,l,2) + end do + end do + + +! +! do l=1,nlink(J) +! do i_state=1,N_states +! delta_ij_(i_state,det_cepa0_idx(linked(l,J)),i_I) += delta(i_state,l,1) +! delta_ij_(i_state,det_cepa0_idx(linked(l,i_I)),j) += delta(i_state,l,2) +! end do +! end do +! + if(n(1) /= 0) then + do i_state=1,N_states + delta_ii_(i_state,i_I) += delta(i_state,0,1) + end do + end if + + if(n(2) /= 0) then + do i_state=1,N_states + delta_ii_(i_state,J) += delta(i_state,0,2) + end do + end if + + + if (task_id /= 0) then + call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) + endif + + + enddo + print *, "-------------" , delta_ii_(1,:) + print *, "dfdf", delta_ij_(1,10,:) + deallocate( delta ) + + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_pull_socket(zmq_socket_pull) + +end + + + + + BEGIN_PROVIDER [ double precision, delta_ij_old, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_old, (N_states,N_det_ref) ] + implicit none + + integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 + integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, nex, nzer, ntot +! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) + double precision :: contrib, wall, iwall ! , searchance(N_det_ref) + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt + integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp + logical, external :: is_in_wavefunction, isInCassd, detEq + character*(512) :: task + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer :: KKsize = 1000000 + + ! -459.6346665282306 + ! -459.6346665282306 + + + call new_parallel_job(zmq_to_qp_run_socket,'mrsc2') + + + call wall_time(iwall) +! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) + + +! searchance = 0d0 +! do J = 1, N_det_ref +! nlink(J) = 0 +! do blok=1,cepa0_shortcut(0) +! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 +! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) +! if(degree <= 2) then +! nlink(J) += 1 +! linked(nlink(J),J) = k +! blokMwen(nlink(J),J) = blok +! searchance(J) += 1d0 + log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) +! end if +! end do +! end do +! end do + + + +! stop +nzer = 0 +ntot = 0 + do nex = 3, 0, -1 + print *, "los ",nex + do I_s = N_det_ref, 1, -1 +! if(mod(I_s,1) == 0) then +! call wall_time(wall) +! wall = wall-iwall +! print *, I_s, "/", N_det_ref, wall * (dfloat(N_det_ref) / dfloat(I_s)), wall, wall * (dfloat(N_det_ref) / dfloat(I_s))-wall +! end if + + + do J_s = 1, I_s + + call get_excitation_degree(psi_ref(1,1,J_s), psi_ref(1,1,I_s), degree, N_int) + if(degree /= nex) cycle + if(nex == 3) nzer = nzer + 1 + ntot += 1 +! if(degree > 3) then +! deg += 1 +! cycle +! else if(degree == -10) then +! KKsize = 100000 +! else +! KKsize = 1000000 +! end if + + + + if(searchance(I_s) < searchance(J_s)) then + i_I = I_s + J = J_s + else + i_I = J_s + J = I_s + end if + + KKsize = nlink(1) + if(nex == 0) KKsize = int(float(nlink(1)) / float(nlink(i_I)) * (float(nlink(1)) / 64d0)) + + !if(KKsize == 0) stop "ZZEO" + + do kk = 1 , nlink(i_I), KKsize + write(task,*) I_i, J, kk, int(min(kk+KKsize-1, nlink(i_I))) + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + end do + + ! do kk = 1 , nlink(i_I) + ! k = linked(kk,i_I) + ! blok = blokMwen(kk,i_I) + ! write(task,*) I_i, J, k, blok + ! call add_task_to_taskserver(zmq_to_qp_run_socket,task) + ! + ! enddo !kk + enddo !J + + enddo !I + end do ! nex + print *, "tasked" +! integer(ZMQ_PTR) ∷ collector_thread +! external ∷ ao_bielec_integrals_in_map_collector +! rc = pthread_create(collector_thread, mrsc2_dressing_collector) + print *, nzer, ntot, float(nzer) / float(ntot) + !$OMP PARALLEL DEFAULT(none) SHARED(delta_ii_old,delta_ij_old) PRIVATE(i) + !$OMP TASK + i = omp_get_thread_num() + if (i==0) then + call mrsc2_dressing_collector(delta_ii_old,delta_ij_old) + else + call mrsc2_dressing_slave_inproc(i) + endif + !$OMP END TASK + !$OMP TASKWAIT + !$OMP END PARALLEL + +! rc = pthread_join(collector_thread) + call end_parallel_job(zmq_to_qp_run_socket, 'mrsc2') + + +END_PROVIDER + + + From f7b4a19adf23ebc32605b80026e437ec207ffa25 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 3 May 2016 11:34:03 +0200 Subject: [PATCH 19/42] better isInCassd --- plugins/mrcepa0/dressing.irp.f | 54 ++++++++++++++++++++++++---- plugins/mrcepa0/dressing_slave.irp.f | 5 ++- 2 files changed, 52 insertions(+), 7 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 9b80ae09..d774cdd8 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -55,7 +55,12 @@ use bitmasks END_PROVIDER - +BEGIN_PROVIDER [ integer, HP, (2,N_det_non_ref) ] + integer :: i + do i=1,N_det_non_ref + call getHP(psi_non_ref(1,1,i), HP(1,i), HP(2,i), N_int) + end do +END_PROVIDER BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] &BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] @@ -93,7 +98,8 @@ END_PROVIDER active_sorb(k,2) = iand(active_sorb(k,2), not(nonactive_sorb(k,2))) end do end if - + + do i=1, N_det_non_ref do k=1, N_int det_noactive(k,1,i) = iand(psi_non_ref(k,1,i), not(active_sorb(k,1))) @@ -277,6 +283,7 @@ logical function detEq(a,b,Nint) detEq = .true. end function + logical function isInCassd(a,Nint) use bitmasks implicit none @@ -287,10 +294,9 @@ logical function isInCassd(a,Nint) isInCassd = .false. - - + deg = 0 - do i=1,2 + do i=1,2 do ni=1,Nint virt = iand(not(HF_bitmask(ni,i)), not(active_sorb(ni,i))) deg += popcnt(iand(virt, a(ni,i))) @@ -306,10 +312,46 @@ logical function isInCassd(a,Nint) if(deg > 2) return end do end do - isInCassd = .true. end function + +subroutine getHP(a,h,p,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2) + integer, intent(out) :: h, p + integer(bit_kind) :: inac, virt + integer :: ni, i, deg + + + !isInCassd = .false. + h = 0 + p = 0 + + deg = 0 + lp : do i=1,2 + do ni=1,Nint + virt = iand(not(HF_bitmask(ni,i)), not(active_sorb(ni,i))) + deg += popcnt(iand(virt, a(ni,i))) + if(deg > 2) exit lp + end do + end do lp + p = deg + + deg = 0 + lh : do i=1,2 + do ni=1,Nint + inac = iand(HF_bitmask(ni,i), not(active_sorb(ni,i))) + deg += popcnt(xor(iand(inac,a(ni,i)), inac)) + if(deg > 2) exit lh + end do + end do lh + h = deg + !isInCassd = .true. +end function + integer function detCmp(a,b,Nint) use bitmasks implicit none diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index acaf4e34..aaf9a9a6 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -157,13 +157,16 @@ subroutine mrsc2_dressing_slave(thread,iproc) do m = 1, komon(0) i = komon(m) + + if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) cycle hJi = h_(J,i) hIi = h_(i_I,i) + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(.not. ok) cycle - if(isInCassd(det_tmp, N_int)) cycle + !if(isInCassd(det_tmp, N_int)) cycle do i_state = 1, N_states if(lambda_mrcc(i_state, i) == 0d0) cycle From 682d2b8f1e706653fb938ac7f35b8ea69d6bfa10 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 3 May 2016 17:55:41 +0200 Subject: [PATCH 20/42] fixed phases - no more isInCassd --- plugins/mrcepa0/dressing_slave.irp.f | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index aaf9a9a6..480a0f56 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -138,14 +138,14 @@ subroutine mrsc2_dressing_slave(thread,iproc) komon(kn) = i - call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) - if(I_i /= J) call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ii,N_int) - if(I_i == J) phase_Ii = phase_Ji +! call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) +! if(I_i /= J) call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ii,N_int) +! if(I_i == J) phase_Ii = phase_Ji do i_state = 1,N_states dkI = h_(J,i) * h_(i_I,i) * lambda_mrcc(i_state, i) - dleat(i_state, kn, 1) = dkI * phase_Ii - dleat(i_state, kn, 2) = dkI * phase_Ji + dleat(i_state, kn, 1) = dkI + dleat(i_state, kn, 2) = dkI end do end do @@ -158,7 +158,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) i = komon(m) - if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) cycle + !if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) cycle hJi = h_(J,i) hIi = h_(i_I,i) @@ -166,14 +166,18 @@ subroutine mrsc2_dressing_slave(thread,iproc) call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(.not. ok) cycle + if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) then + if(is_in_wavefunction(det_tmp, N_int)) cycle + end if + !if(isInCassd(det_tmp, N_int)) cycle do i_state = 1, N_states if(lambda_mrcc(i_state, i) == 0d0) cycle - call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) - contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2) * phase_al +! call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) + contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al ! if(l /= det_cepa0_idx(linked(ll, J))) stop "SPTPqsdT" delta(i_state,ll,1) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then @@ -181,9 +185,9 @@ subroutine mrsc2_dressing_slave(thread,iproc) endif if(I_i == J) cycle - call get_excitation(det_tmp,psi_non_ref(1,1,k),exc_IJ,degree2,phase_al,N_int) +! call get_excitation(det_tmp,psi_non_ref(1,1,k),exc_IJ,degree2,phase_al,N_int) ! cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) - contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1) * phase_al + contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al ! if(k /= linked(kk, I_i)) stop "SPTPT" delta(i_state,kk,2) += contrib !delta(i_state,det_cepa0_idx(k),2) += contrib From d019657001bfe840b64a0b69f767db07862e66e5 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 4 May 2016 17:30:55 +0200 Subject: [PATCH 21/42] extra thread for collector --- plugins/mrcepa0/dressing_slave.irp.f | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 480a0f56..3076e2a8 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -582,16 +582,14 @@ ntot = 0 ! external ∷ ao_bielec_integrals_in_map_collector ! rc = pthread_create(collector_thread, mrsc2_dressing_collector) print *, nzer, ntot, float(nzer) / float(ntot) - !$OMP PARALLEL DEFAULT(none) SHARED(delta_ii_old,delta_ij_old) PRIVATE(i) - !$OMP TASK + provide nproc + !$OMP PARALLEL DEFAULT(none) SHARED(delta_ii_old,delta_ij_old) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() if (i==0) then call mrsc2_dressing_collector(delta_ii_old,delta_ij_old) else call mrsc2_dressing_slave_inproc(i) endif - !$OMP END TASK - !$OMP TASKWAIT !$OMP END PARALLEL ! rc = pthread_join(collector_thread) From a19543f6c743fcba74ac861c1be92eeb96b80fd9 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 4 May 2016 18:23:05 +0200 Subject: [PATCH 22/42] alpha = triple-quadruple --- plugins/mrcepa0/dressing_slave.irp.f | 9 ++---- plugins/mrcepa0/mrcepa0_general.irp.f | 45 ++++++++++++++++++++------- 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 3076e2a8..3491ba7f 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -158,16 +158,11 @@ subroutine mrsc2_dressing_slave(thread,iproc) i = komon(m) - !if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) cycle - - hJi = h_(J,i) - hIi = h_(i_I,i) - - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(.not. ok) cycle if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) then - if(is_in_wavefunction(det_tmp, N_int)) cycle +! if(is_in_wavefunction(det_tmp, N_int)) cycle + cycle end if !if(isInCassd(det_tmp, N_int)) cycle diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 6694e80a..df10de34 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -71,19 +71,40 @@ 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 - j = lambda_mrcc_pt2(i) - do k=1,N_int - psi_det_generators(k,1,i) = psi_non_ref(k,1,j) - psi_det_generators(k,2,i) = psi_non_ref(k,2,j) - enddo - do k=1,N_st - psi_coef_generators(i,k) = psi_non_ref_coef(j,k) - enddo - enddo - SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed +! N_det_generators = lambda_mrcc_pt2(0) +! do i=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) +! psi_det_generators(k,2,i) = psi_non_ref(k,2,j) +! enddo +! do k=1,N_st +! psi_coef_generators(i,k) = psi_non_ref_coef(j,k) +! enddo +! enddo +! SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + 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 - N_det_cas) + do k=1,N_int + psi_det_generators(k,1,i) = psi_non_ref(k,1,j) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed call H_apply_mrcc_PT2(pt2, norm_pert, H_pert_diag, N_st) print *, 'Final step' From 55138005a0e97e9ef6cd1f5e75834d8caaa877b5 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 13 May 2016 19:28:50 +0200 Subject: [PATCH 23/42] mrcc 2nd version - not working --- plugins/MRCC_Utils/mrcc_dress.irp.f | 6 - plugins/mrcepa0/dressing.irp.f | 892 +++++++++++++++------------- src/Determinants/slater_rules.irp.f | 1 - 3 files changed, 493 insertions(+), 406 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index 291a6bbc..1c2e8b74 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -303,12 +303,6 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge call omp_unset_lock( psi_ref_lock(i_I) ) enddo enddo - -! 5.7717252361566333E-005 -! -1.4525812360153183E-005 -! -3.3282906594800186E-005 -! -1.3864228814283882E-004 - !deallocate (dIa_hla,hij_cache) !deallocate(miniList, idx_miniList) end diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index d774cdd8..e0689642 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -1,6 +1,491 @@ use bitmasks +subroutine dec_exc(exc, h1, h2, p1, p2) + implicit none + integer :: exc(0:2,2,2), s1, s2, degree + integer, intent(out) :: h1, h2, p1, p2 + + degree = exc(0,1,1) + exc(0,1,2) + + h1 = 0 + h2 = 0 + p1 = 0 + p2 = 0 + + if(degree == 0) return + + call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2) + + h1 += mo_tot_num * (s1-1) + p1 += mo_tot_num * (s1-1) + + if(degree == 2) then + h2 += mo_tot_num * (s2-1) + p2 += mo_tot_num * (s2-1) + if(h1 > h2) then + s1 = h1 + h1 = h2 + h2 = s1 + end if + if(p1 > p2) then + s1 = p1 + p1 = p2 + p2 = s1 + end if + else + h2 = h1 + p2 = p1 + p1 = 0 + h1 = 0 + end if +end subroutine + + + + BEGIN_PROVIDER [ integer, hh_exists, (4, N_det_ref * N_det_non_ref) ] +&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_det_ref * N_det_non_ref + 1) ] +&BEGIN_PROVIDER [ integer, pp_exists, (4, N_det_ref * N_det_non_ref) ] + implicit none + integer :: num(0:mo_tot_num*2, 0:mo_tot_num*2) + integer :: exc(0:2, 2, 2), degree, n, on, s, h1, h2, p1, p2, l, i + double precision :: phase + + hh_shortcut = 0 + hh_exists = 0 + pp_exists = 0 + num = 0 + + do i=1, N_det_ref + do l=1, N_det_non_ref + call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) + if(degree == -1) cycle + call dec_exc(exc, h1, h2, p1, p2) + num(h1, h2) += 1 + end do + end do + + n = 1 + do l=0,mo_tot_num*2 + do i=0,l + on = num(i,l) + if(on /= 0) then + hh_shortcut(0) += 1 + hh_shortcut(hh_shortcut(0)) = n + hh_exists(:, hh_shortcut(0)) = (/1, i, 1, l/) + end if + + num(i,l) = n + n += on + end do + end do + + hh_shortcut(hh_shortcut(0)+1) = n + + do i=1, N_det_ref + do l=1, N_det_non_ref + call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) + if(degree == -1) cycle + call dec_exc(exc, h1, h2, p1, p2) + pp_exists(:, num(h1, h2)) = (/1,p1,1,p2/) + num(h1, h2) += 1 + end do + end do + + do s=2,4,2 + do i=1,hh_shortcut(0) + if(hh_exists(s, i) == 0) then + hh_exists(s-1, i) = 0 + else if(hh_exists(s, i) > mo_tot_num) then + hh_exists(s, i) -= mo_tot_num + hh_exists(s-1, i) = 2 + end if + end do + + do i=1,hh_shortcut(hh_shortcut(0)+1)-1 + if(pp_exists(s, i) == 0) then + pp_exists(s-1, i) = 0 + else if(pp_exists(s, i) > mo_tot_num) then + pp_exists(s, i) -= mo_tot_num + pp_exists(s-1, i) = 2 + end if + end do + end do + +END_PROVIDER + + + + +subroutine apply_hole(det, exc, res, ok, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer, intent(in) :: exc(4) + integer :: s1, s2, h1, h2 + integer(bit_kind),intent(in) :: det(Nint, 2) + integer(bit_kind),intent(out) :: res(Nint, 2) + logical, intent(out) :: ok + integer :: ii, pos + + ok = .false. + s1 = exc(1) + h1 = exc(2) + s2 = exc(3) + h2 = exc(4) + res = det + + if(h1 /= 0) then + ii = (h1-1)/bit_kind_size + 1 + pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s1) = ibclr(res(ii, s1), pos) + end if + + ii = (h2-1)/bit_kind_size + 1 + pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s2) = ibclr(res(ii, s2), pos) + + + ok = .true. +end subroutine + + +subroutine apply_particle(det, exc, res, ok, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer, intent(in) :: exc(4) + integer :: s1, s2, p1, p2 + integer(bit_kind),intent(in) :: det(Nint, 2) + integer(bit_kind),intent(out) :: res(Nint, 2) + logical, intent(out) :: ok + integer :: ii, pos + + ok = .false. + s1 = exc(1) + p1 = exc(2) + s2 = exc(3) + p2 = exc(4) + res = det + + if(p1 /= 0) then + ii = (p1-1)/bit_kind_size + 1 + pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s1) = ibset(res(ii, s1), pos) + end if + + ii = (p2-1)/bit_kind_size + 1 + pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s2) = ibset(res(ii, s2), pos) + + + ok = .true. +end subroutine + + + BEGIN_PROVIDER [ double precision, delta_ij_mrcc, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] + use bitmasks + implicit none + integer :: gen, h, p, i_state, n, t + integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2), buf(N_int, 2, N_det_non_ref) + logical :: ok + + delta_ij_mrcc = 0d0 + delta_ii_mrcc = 0d0 + i_state = 1 + + do gen=1, N_det_generators + !print *, gen, "/", N_det_generators + do h=1, hh_shortcut(0) + call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) + if(.not. ok) cycle + omask = 0 + if(hh_exists(1, h) /= 0) omask = mask + !-459.6378590456251 + !-199.0659502581943 + n = 1 + ploop : do p=hh_shortcut(h), hh_shortcut(h+1)-1 + + do t=hh_shortcut(h), p-1 + if(pp_exists(1, p) == pp_exists(1,t) .and. & + pp_exists(2, p) == pp_exists(2,t) .and. & + pp_exists(3, p) == pp_exists(3,t) .and. & + pp_exists(4, p) == pp_exists(4,t)) cycle ploop + end do + call apply_particle(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) + !-459.6379081607463 + !-199.0659982685706 + if(ok) n = n + 1 + end do ploop + n = n - 1 + if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) + end do + end do +END_PROVIDER + + + +subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffer,Nint,key_mask) + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) + double precision, intent(inout) :: delta_ii_(N_states,N_det_ref) + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,l,m + integer :: degree_alpha(psi_det_size) + integer :: idx_alpha(0:psi_det_size) + logical :: good, fullMatch + + integer(bit_kind) :: tq(Nint,2,n_selected) + integer :: N_tq, c_ref ,degree + + double precision :: hIk, hla, hIl, dIk(N_states), dka(N_states), dIa(N_states) + double precision, allocatable :: dIa_hla(:,:) + double precision :: haj, phase, phase2 + double precision :: f(N_states), ci_inv(N_states) + integer :: exc(0:2,2,2) + integer :: h1,h2,p1,p2,s1,s2 + integer(bit_kind) :: tmp_det(Nint,2) + integer :: iint, ipos + integer :: i_state, k_sd, l_sd, i_I, i_alpha + + integer(bit_kind),allocatable :: miniList(:,:,:) + integer(bit_kind),intent(in) :: key_mask(Nint, 2) + integer,allocatable :: idx_miniList(:) + integer :: N_miniList, ni, leng + double precision, allocatable :: hij_cache(:) + + integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) + integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) + integer :: mobiles(2), smallerlist + + + + leng = max(N_det_generators, N_det_non_ref) + allocate(miniList(Nint, 2, leng), idx_minilist(leng), hij_cache(N_det_non_ref)) + + !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint) + call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint) + + if(fullMatch) then + return + end if + + allocate(ptr_microlist(0:mo_tot_num*2+1), & + N_microlist(0:mo_tot_num*2) ) + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4)) + + if(key_mask(1,1) /= 0) then + call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + call find_triples_and_quadruples_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) + else + call find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist) + end if + + + + deallocate(microlist, idx_microlist) + + allocate (dIa_hla(N_states,N_det_non_ref)) + + ! |I> + + ! |alpha> + + if(N_tq > 0) then + call create_minilist(key_mask, psi_non_ref, miniList, idx_minilist, N_det_non_ref, N_minilist, Nint) + if(N_minilist == 0) return + + + if(key_mask(1,1) /= 0) then !!!!!!!!!!! PAS GENERAL !!!!!!!!! + allocate(microlist_zero(Nint,2,N_minilist), idx_microlist_zero(N_minilist)) + + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4)) + call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + + + do i=0,mo_tot_num*2 + do k=ptr_microlist(i),ptr_microlist(i+1)-1 + idx_microlist(k) = idx_minilist(idx_microlist(k)) + end do + end do + + do l=1,N_microlist(0) + do k=1,Nint + microlist_zero(k,1,l) = microlist(k,1,l) + microlist_zero(k,2,l) = microlist(k,2,l) + enddo + idx_microlist_zero(l) = idx_microlist(l) + enddo + end if + end if + + + do i_alpha=1,N_tq + if(key_mask(1,1) /= 0) then + call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) + + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + + + do l=0,N_microlist(smallerlist)-1 + microlist_zero(:,:,ptr_microlist(1) + l) = microlist(:,:,ptr_microlist(smallerlist) + l) + idx_microlist_zero(ptr_microlist(1) + l) = idx_microlist(ptr_microlist(smallerlist) + l) + end do + + call get_excitation_degree_vector(microlist_zero,tq(1,1,i_alpha),degree_alpha,Nint,N_microlist(smallerlist)+N_microlist(0),idx_alpha) + do j=1,idx_alpha(0) + idx_alpha(j) = idx_microlist_zero(idx_alpha(j)) + end do + + + else + call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) + do j=1,idx_alpha(0) + idx_alpha(j) = idx_miniList(idx_alpha(j)) + end do + end if + + + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) + enddo + + ! |I> + do i_I=1,N_det_ref + ! Find triples and quadruple grand parents + call get_excitation_degree(tq(1,1,i_alpha),psi_ref(1,1,i_I),degree,Nint) + if (degree > 4) then + cycle + endif + + do i_state=1,N_states + dIa(i_state) = 0.d0 + enddo + + ! |alpha> + do k_sd=1,idx_alpha(0) + + ! Loop if lambda == 0 + logical :: loop + loop = .True. + do i_state=1,N_states + if (lambda_mrcc(i_state,idx_alpha(k_sd)) /= 0.d0) then + loop = .False. + exit + endif + enddo + if (loop) then + cycle + endif + + call get_excitation_degree(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),degree,Nint) + if (degree > 2) then + cycle + endif + + ! + ! + hIk = hij_mrcc(idx_alpha(k_sd),i_I) + ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),Nint,hIk) + do i_state=1,N_states + dIk(i_state) = hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) + enddo + ! |l> = Exc(k -> alpha) |I> + call get_excitation(psi_non_ref(1,1,idx_alpha(k_sd)),tq(1,1,i_alpha),exc,degree,phase,Nint) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + do k=1,N_int + tmp_det(k,1) = psi_ref(k,1,i_I) + tmp_det(k,2) = psi_ref(k,2,i_I) + enddo + + logical :: ok + call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint) + if(.not. ok) cycle + + ! + do i_state=1,N_states + dka(i_state) = 0.d0 + enddo + do l_sd=k_sd+1,idx_alpha(0) + + call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) + if (degree == 0) then + + loop = .True. + do i_state=1,N_states + if (lambda_mrcc(i_state,idx_alpha(l_sd)) /= 0.d0) then + loop = .False. + exit + endif + enddo + if (.not.loop) then + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),exc,degree,phase2,Nint) + hIl = hij_mrcc(idx_alpha(l_sd),i_I) +! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hIl) + do i_state=1,N_states + dka(i_state) = hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 + enddo + endif + + exit + endif + enddo + do i_state=1,N_states + dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) + enddo + enddo + + do i_state=1,N_states + 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) + hla = hij_cache(k_sd) +! call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hla) + do i_state=1,N_states + dIa_hla(i_state,k_sd) = dIa(i_state) * hla + enddo + enddo + call omp_set_lock( psi_ref_lock(i_I) ) + do i_state=1,N_states + 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 + enddo + !deallocate (dIa_hla,hij_cache) + !deallocate(miniList, idx_miniList) +end + + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ] @@ -20,18 +505,18 @@ use bitmasks end do end do else if(mrmode == 2) then -! do i = 1, N_det_ref -! delta_ii(i_state,i)= delta_ii_old(i,i_state) -! do j = 1, N_det_non_ref -! delta_ij(i_state,j,i) = delta_ij_old(i,j,i_state) -! end do -! end do do i = 1, N_det_ref - delta_ii(i_state,i)= delta_ii_old(i_state,i) + delta_ii(i_state,i)= delta_ii_mrcc(i_state,i) do j = 1, N_det_non_ref - delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) + delta_ij(i_state,j,i) = delta_ij_mrcc(i_state,j,i) end do end do +! do i = 1, N_det_ref +! delta_ii(i_state,i)= delta_ii_old(i_state,i) +! do j = 1, N_det_non_ref +! delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) +! end do +! end do else if(mrmode == 1) then do i = 1, N_det_ref delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) @@ -43,15 +528,6 @@ use bitmasks stop "invalid mrmode" end if end do -! do i=1,N_det_ref -! print *, delta_ii(1,i) -! end do -! do i=1,min(N_det_non_ref,100) -! print *, delta_ij(1,i,:) -! end do -! stop - - END_PROVIDER @@ -174,41 +650,6 @@ END_PROVIDER print *, "pre done" END_PROVIDER - - - BEGIN_PROVIDER [ double precision, delta_cas_old, (N_det_ref, N_det_ref, N_states) ] - use bitmasks - implicit none - integer :: i,j,k - double precision :: Hjk, Hki, Hij - integer i_state, degree - - provide lambda_mrcc - do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) - do i=1,N_det_ref - do j=1,i - !call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) - delta_cas(i,j,i_state) = 0d0 - !if(no_mono_dressing .and. degree == 1) cycle - do k=1,N_det_non_ref - - call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) - call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) - - delta_cas(i,j,i_state) += Hjk * Hki * lambda_mrcc(i_state, k) - end do - end do - end do - !$OMP END PARALLEL DO - do i=1,N_det_ref - do j=1,i - delta_cas(j,i,i_state) = delta_cas(i,j,i_state) - end do - end do - end do - END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] use bitmasks @@ -684,350 +1125,3 @@ BEGIN_PROVIDER [ double precision, h_, (N_det_ref,N_det_non_ref) ] END_PROVIDER - - BEGIN_PROVIDER [ double precision, delta_ij_older, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_ii_older, (N_det_ref,N_states) ] - implicit none - - integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni - integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s -! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) - logical :: ok - double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) - double precision :: contrib, wall, iwall ! , searchance(N_det_ref) - double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) - integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt - integer, allocatable :: idx_sorted_bit(:) - integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp - logical, external :: is_in_wavefunction, isInCassd, detEq - - ! -459.6346665282306 - ! -459.6346665282306 - - call wall_time(iwall) - allocate(idx_sorted_bit(N_det)) -! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) - - idx_sorted_bit(:) = -1 - do i=1,N_det_non_ref - idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i - enddo - - - do i_state = 1, N_states - - delta_ii_old(:,:) = 0d0 - delta_ij_old(:,:,:) = 0d0 - searchance = 0d0 - !$OMP PARALLEL DO default(none) schedule(dynamic) private(blok,k,degree) shared(searchance,nlink,linked,blokMwen,psi_ref, det_cepa0,cepa0_shortcut, N_det_ref, N_int) - do J = 1, N_det_ref - nlink(J) = 0 - do blok=1,cepa0_shortcut(0) - do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 - call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) - if(degree <= 2) then - nlink(J) += 1 - linked(nlink(J),J) = k - blokMwen(nlink(J),J) = blok - searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) - end if - end do - end do - end do - !$OMP END PARALLEL DO - - -! do i=1,cepa0_shortcut(0) -! print *, cepa0_shortcut(i+1) - cepa0_shortcut(i) -! end do - - - !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_ij_old, delta_ii_old) & - !$OMP private(m,kk, i_I, i, J, k, degree, degree2, l, deg, ni, inac, virt) & - !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall, I_s, J_s) & - !$OMP private(phase_iI, phase_Ik, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & - !$OMP private(contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & - !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & - !$OMP shared(i_state, lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0) & - !$OMP shared(h_,det_cepa0_idx, linked, blokMwen, nlink, iwall, searchance) - do i = 1 , N_det_non_ref - if(mod(i,100) == 0) then - call wall_time(wall) - wall = wall-iwall - print *, i, "/", N_det_non_ref, wall * (dfloat(N_det_non_ref) / dfloat(i)), wall, wall * (dfloat(N_det_non_ref) / dfloat(i))-wall - end if - - if(lambda_mrcc(i_state, i) == 0d0) cycle - - - do I_s = 1, N_det_ref - do J_s = 1, I_s - - if(nlink(I_s) < nlink(J_s)) then - !if(searchance(I_s) < searchance(J_s)) then - i_I = I_s - J = J_s - else - i_I = J_s - J = I_s - end if - - !call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,J),N_int,hJi) - !!!! - - !!!!!! - hJi = h_(J,i) - if(hJi == 0) cycle - hIi = h_(i_I,i) - if(hIi == 0) cycle - - diI = hIi * lambda_mrcc(i_state, i) - delta_JI = hJi * diI - - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,i),exc_iI,degree2,phase_iI,N_int) - if(degree2 == -1) cycle - !call i_h_j(psi_non_ref(1,1,i), psi_ref(1,1,i_I),N_int,hIi) - - do kk = 1 , nlink(i_I) - k = linked(kk,i_I) - blok = blokMwen(kk,i_I) - - !if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle - - - call get_excitation(psi_ref(1,1,i_I),det_cepa0(1,1,k),exc_Ik,degree,phase_Ik,N_int) - !if(degree == -1) cycle - if(degree == -1) stop "STOP; ( linked )" - - - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) - if(.not. ok) cycle - - call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) - if(.not. ok) cycle - - if(isInCassd(det_tmp, N_int)) cycle - - - l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) - if(l == -1) cycle - l = det_cepa0_idx(cepa0_shortcut(blok)-1+l) - !call i_h_j(det_cepa0(1,1,k), det_tmp, N_int, HiI) - !call i_h_j(psi_non_ref(1,1,l), det_tmp, N_int, HJi) - - - - call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) - call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) - delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji - ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) - HkI = h_(i_I,det_cepa0_idx(k)) - dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) - contrib = dkI(i_state) * delta_JI - !$OMP ATOMIC - delta_ij_old(i_I,l,i_state) += contrib - if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then - !$OMP ATOMIC - delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) - endif -! - if(l == det_cepa0_idx(k)) cycle - call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) - call get_excitation(det_tmp,det_cepa0(1,1,k),exc_IJ,degree2,phase_al,N_int) - delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji - - ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) - HkI = h_(J,l) - dkI(i_state) = HkI * lambda_mrcc(i_state, l) - contrib = dkI(i_state) * delta_JI - !$OMP ATOMIC - delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib - if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then - !$OMP ATOMIC - delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) - end if - - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - -! do i=1,N_det_non_ref -! print *, delta_ij_old(:,i,i_state) -! end do -! stop - end do - deallocate(idx_sorted_bit) - - -! call wall_time(wall) -! print *, "old ", wall -END_PROVIDER - -! -! BEGIN_PROVIDER [ double precision, delta_ij_old, (N_det_ref,N_det_non_ref,N_states) ] -! &BEGIN_PROVIDER [ double precision, delta_ii_old, (N_det_ref,N_states) ] -! implicit none -! -! integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 -! integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s -! ! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) -! logical :: ok -! double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) -! double precision :: contrib, wall, iwall !, searchance(N_det_ref) -! double precision, allocatable :: deltaMwen(:,:,:), deltaIImwen(:,:) -! integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ -! integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt -! integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp -! logical, external :: is_in_wavefunction, isInCassd, detEq -! -! ! -459.6346665282306 -! ! -459.6346665282306 -! -! call wall_time(iwall) -! !allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) -! -! -! delta_ii_old(:,:) = 0d0 -! delta_ij_old(:,:,:) = 0d0 -! -! ! searchance = 0d0 -! ! do J = 1, N_det_ref -! ! nlink(J) = 0 -! ! do blok=1,cepa0_shortcut(0) -! ! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 -! ! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) -! ! if(degree <= 2) then -! ! nlink(J) += 1 -! ! linked(nlink(J),J) = k -! ! blokMwen(nlink(J),J) = blok -! ! searchance(J) += log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) -! ! end if -! ! end do -! ! end do -! ! end do -! -! -! -! do I_s = 1, N_det_ref -! if(mod(I_s,1) == 0) then -! call wall_time(wall) -! wall = wall-iwall -! print *, I_s, "/", N_det_ref, wall * (dfloat(N_det_ref) / dfloat(I_s)), wall, wall * (dfloat(N_det_ref) / dfloat(I_s))-wall -! end if -! -! -! do J_s = 1, I_s -! -! call get_excitation_degree(psi_ref(1,1,J_s), psi_ref(1,1,I_s), degree, N_int) -! if(degree > 3) cycle -! -! if(searchance(I_s) < searchance(J_s)) then -! i_I = I_s -! J = J_s -! else -! i_I = J_s -! J = I_s -! end if -! -! !$OMP PARALLEL DO default(none) schedule(dynamic,1) shared(delta_ij_old, delta_ii_old) & -! !$OMP private(m,m2,kk, i, k, degree, degree2, l, deg, ni, inac, virt) & -! !$OMP private(ok,p1,p2,h1,h2,s1,s2, blok, wall, I_s, J_s) & -! !$OMP private(phase_iI, phase_Ik, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv, dia_hla) & -! !$OMP private(i_state, contrib, exc_iI, exc_Ik, exc_IJ, det_tmp, det_tmp2) & -! !$OMP shared(N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & -! !$OMP shared(lambda_mrcc, hf_bitmask, active_sorb,cepa0_shortcut,det_cepa0,N_states) & -! !$OMP shared(i_I, J, h_,det_cepa0_idx, linked, blokMwen, nlink, iwall, searchance) -! do kk = 1 , nlink(i_I) -! k = linked(kk,i_I) -! blok = blokMwen(kk,i_I) -! -! -! call get_excitation(psi_ref(1,1,i_I),det_cepa0(1,1,k),exc_Ik,degree,phase_Ik,N_int) -! -! call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) -! if(.not. ok) cycle -! -! -! -! -! l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) -! if(l == -1) cycle -! l = det_cepa0_idx(cepa0_shortcut(blok)-1+l) -! -! -! -! m = 1 -! m2 = 1 -! do while(m <= nlink(i_I) .and. m2 <= nlink(J)) -! if(linked(m, i_I) < linked(m2, J)) then -! m += 1 -! cycle -! else if(linked(m, i_I) > linked(m2, J)) then -! m2 += 1 -! cycle -! end if -! -! -! i = det_cepa0_idx(linked(m,i_I)) -! m += 1 -! m2 += 1 -! -! do i_state = 1, N_states -! if(lambda_mrcc(i_state, i) == 0d0) cycle -! -! -! hJi = h_(J,i) -! if(hJi == 0) cycle -! hIi = h_(i_I,i) -! if(hIi == 0) cycle -! -! call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) -! if(.not. ok) cycle -! -! -! if(isInCassd(det_tmp, N_int)) cycle -! -! -! call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) -! call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) -! delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji -! ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) -! HkI = h_(i_I,det_cepa0_idx(k)) -! dkI(i_state) = HkI * lambda_mrcc(i_state, det_cepa0_idx(k)) -! contrib = dkI(i_state) * delta_JI -! !$OMP ATOMIC -! delta_ij_old(i_I,l,i_state) += contrib -! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then -! !$OMP ATOMIC -! delta_ii_old(i_I,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) -! endif -! ! -! if(l == det_cepa0_idx(k)) cycle -! call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) -! call get_excitation(det_tmp,det_cepa0(1,1,k),exc_IJ,degree2,phase_al,N_int) -! delta_JI = hJi * hIi * lambda_mrcc(i_state, i) * phase_al * phase_Ji -! -! ci_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) -! HkI = h_(J,l) -! dkI(i_state) = HkI * lambda_mrcc(i_state, l) -! contrib = dkI(i_state) * delta_JI -! !$OMP ATOMIC -! delta_ij_old(J,det_cepa0_idx(k),i_state) += contrib -! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then -! !$OMP ATOMIC -! delta_ii_old(J,i_state) -= contrib * ci_inv(i_state) * psi_non_ref_coef(det_cepa0_idx(k),i_state) -! end if -! enddo !i_state -! end do ! while -! enddo !kk -! enddo !J -! -! enddo !I -! -! END_PROVIDER -! ! -! - diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 9bcc95f9..0b456751 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -1757,4 +1757,3 @@ subroutine apply_excitation(det, exc, res, ok, Nint) ok = .true. end subroutine - From 33bd506328796e9008bf25cbf0202570bfe61291 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 20 May 2016 09:44:22 +0200 Subject: [PATCH 24/42] working mrcc --- config/gfortran_debug.cfg | 2 +- plugins/MRCC_Utils/davidson.irp.f | 2 +- plugins/MRCC_Utils/mrcc_dress.irp.f | 78 +-- plugins/MRCC_Utils/mrcc_utils.irp.f | 455 ++++++++++++++- plugins/mrcepa0/dressing.irp.f | 521 ++++++------------ .../mrcepa0/{mrsc2sub.irp.f => mrcc.irp.f} | 2 +- plugins/mrcepa0/mrcepa0.irp.f | 2 +- plugins/mrcepa0/mrcepa0_general.irp.f | 1 + plugins/mrcepa0/mrsc2.irp.f | 3 +- src/Determinants/H_apply.template.f | 4 +- src/Determinants/connected_to_ref.irp.f | 25 +- src/Determinants/determinants.irp.f | 41 ++ src/Determinants/slater_rules.irp.f | 10 +- src/Determinants/spindeterminants.irp.f | 20 +- 14 files changed, 733 insertions(+), 433 deletions(-) rename plugins/mrcepa0/{mrsc2sub.irp.f => mrcc.irp.f} (88%) diff --git a/config/gfortran_debug.cfg b/config/gfortran_debug.cfg index 72084241..03663eea 100644 --- a/config/gfortran_debug.cfg +++ b/config/gfortran_debug.cfg @@ -51,7 +51,7 @@ FCFLAGS : -Ofast # -g : Extra debugging information # [DEBUG] -FCFLAGS : -g -pedantic -msse4.2 +FCFLAGS : -g -msse4.2 # OpenMP flags ################# diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index 15077481..66f4975a 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -269,7 +269,7 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin to_print(2,k) = residual_norm(k) enddo - write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))'), iter, to_print(:,1:N_st) + write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st) call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) if (converged) then exit diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index 1c2e8b74..412c52e2 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -51,9 +51,9 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist + logical, external :: is_generable - - + print *, i_generator leng = max(N_det_generators, N_det_non_ref) allocate(miniList(Nint, 2, leng), idx_minilist(leng), hij_cache(N_det_non_ref)) @@ -69,7 +69,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge allocate( microlist(Nint,2,N_minilist*4), & idx_microlist(N_minilist*4)) - if(key_mask(1,1) /= 0) then + if(key_mask(1,1) /= 0_8) then call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) call find_triples_and_quadruples_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) else @@ -87,6 +87,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge ! |alpha> if(N_tq > 0) then + call create_minilist(key_mask, psi_non_ref, miniList, idx_minilist, N_det_non_ref, N_minilist, Nint) if(N_minilist == 0) return @@ -117,8 +118,18 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge - do i_alpha=1,N_tq +! ok = .false. +! do i=N_det_generators, 1, -1 +! if(is_generable(psi_det_generators(1,1,i), tq(1,1,i_alpha), Nint)) then +! ok = .true. +! exit +! end if +! end do +! if(.not. ok) then +! cycle +! end if + if(key_mask(1,1) /= 0) then call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) @@ -138,37 +149,6 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge do j=1,idx_alpha(0) idx_alpha(j) = idx_microlist_zero(idx_alpha(j)) end do - - -! i = 1 -! j = 2 -! do j = 2, idx_alpha_tmp(0) -! if(idx_alpha_tmp(j) < idx_alpha_tmp(j-1)) exit -! end do -! -! m = j -! -! idx_alpha(0) = idx_alpha_tmp(0) -! -! do l = 1, idx_alpha(0) -! if(j > idx_alpha_tmp(0)) then -! k = i -! i += 1 -! else if(i >= m) then -! k = j -! j += 1 -! else if(idx_alpha_tmp(i) < idx_alpha_tmp(j)) then -! k = i -! i += 1 -! else -! k = j -! j += 1 -! end if -! ! k=l -! idx_alpha(l) = idx_alpha_tmp(k) -! degree_alpha(l) = degree_alpha_tmp(k) -! end do -! else call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) do j=1,idx_alpha(0) @@ -177,12 +157,6 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge end if -! call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) -! do j=1,idx_alpha(0) -! idx_alpha(j) = idx_miniList(idx_alpha(j)) -! end do - !print *, idx_alpha(:idx_alpha(0)) - do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) @@ -285,33 +259,31 @@ 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 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) + 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 + !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) + 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 enddo - !deallocate (dIa_hla,hij_cache) - !deallocate(miniList, idx_miniList) + deallocate (dIa_hla,hij_cache) + deallocate(miniList, idx_miniList) end - - - - subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_miniList) use bitmasks @@ -360,7 +332,7 @@ subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq endif enddo if (good) then - if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint,N_det)) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then N_tq += 1 do k=1,N_int tq(k,1,N_tq) = det_buffer(k,1,i) @@ -437,7 +409,7 @@ subroutine find_triples_and_quadruples_micro(i_generator,n_selected,det_buffer,N endif enddo if (good) then - if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint,N_det)) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then N_tq += 1 do k=1,N_int tq(k,1,N_tq) = det_buffer(k,1,i) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index cfaf7a67..8873a940 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -112,20 +112,12 @@ END_PROVIDER lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i endif endif -! j = int(lambda_mrcc(k,i) * 100) -! if(j < -200) j = -200 -! if(j > 200) j = 200 -! histo(j) += 1 enddo enddo lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 end if - -! do i=-200,200 -! print *, i, histo(i) -! end do print*,'N_det_non_ref = ',N_det_non_ref - !print*,'Number of ignored determinants = ',i_pert_count + print*,'Number of ignored determinants = ',i_pert_count print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) print*,'lambda max = ',maxval(dabs(lambda_mrcc)) @@ -163,6 +155,7 @@ END_PROVIDER call H_apply_mrcc(delta_ij,delta_ii,N_states,N_det_non_ref,N_det_ref) END_PROVIDER + BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] implicit none @@ -288,3 +281,447 @@ subroutine diagonalize_CI_dressed(lambda) SOFT_TOUCH psi_coef end + + +logical function is_generable(det1, det2, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) + integer :: degree, f, exc(0:2, 2, 2), h1, h2, p1, p2, s1, s2, t + integer, external :: searchExc + logical, external :: excEq + double precision :: phase + + is_generable = .false. + call get_excitation(det1, det2, exc, degree, phase, Nint) + if(degree == -1) return + if(degree == 0) then + is_generable = .true. + return + end if + if(degree > 2) stop "?22??" + !!!!! +! call dec_exc(exc, h1, h2, p1, p2) +! f = searchExc(toutmoun(1,1), (/h1, h2, p1, p2/), hh_shortcut(hh_shortcut(0)+1)-1) +! !print *, toutmoun(:,1), hh_shortcut(hh_shortcut(0)+1)-1, (/h1, h2, p1, p2/) +! if(f /= -1) then +! is_generable = .true. +! if(.not. excEq(toutmoun(1,f), (/h1, h2, p1, p2/))) stop "????" +! end if +! ! print *, f +! return + + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + + if(degree == 1) then + h2 = h1 + p2 = p1 + s2 = s1 + h1 = 0 + p1 = 0 + s1 = 0 + end if + + if(h1 + s1*mo_tot_num < h2 + s2*mo_tot_num) then + f = searchExc(hh_exists(1,1), (/s1, h1, s2, h2/), hh_shortcut(0)) + else + f = searchExc(hh_exists(1,1), (/s2, h2, s1, h1/), hh_shortcut(0)) + end if + if(f == -1) return + + if(p1 + s1*mo_tot_num < p2 + s2*mo_tot_num) then + f = searchExc(pp_exists(1,hh_shortcut(f)), (/s1, p1, s2, p2/), hh_shortcut(f+1)-hh_shortcut(f)) + else + f = searchExc(pp_exists(1,hh_shortcut(f)), (/s2, p2, s1, p1/), hh_shortcut(f+1)-hh_shortcut(f)) + end if + + if(f /= -1) is_generable = .true. +end function + + + +integer function searchDet(dets, det, n, Nint) + implicit none + use bitmasks + + integer(bit_kind),intent(in) :: dets(Nint,2,n), det(Nint,2) + integer, intent(in) :: nint, n + integer :: l, h, c + integer, external :: detCmp + logical, external :: detEq + + l = 1 + h = n + do while(.true.) + searchDet = (l+h)/2 + c = detCmp(dets(1,1,searchDet), det(:,:), Nint) + if(c == 0) return + if(c == 1) then + h = searchDet-1 + else + l = searchDet+1 + end if + if(l > h) then + searchDet = -1 + return + end if + + end do +end function + + +integer function searchExc(excs, exc, n) + implicit none + use bitmasks + + integer, intent(in) :: n + integer,intent(in) :: excs(4,n), exc(4) + integer :: l, h, c + integer, external :: excCmp + logical, external :: excEq + + l = 1 + h = n + do + searchExc = (l+h)/2 + c = excCmp(excs(1,searchExc), exc(:)) + if(c == 0) return + if(c == 1) then + h = searchExc-1 + else + l = searchExc+1 + end if + if(l > h) then + searchExc = -1 + return + end if + end do +end function + + +subroutine sort_det(key, idx, N_key, Nint) + implicit none + + + integer, intent(in) :: Nint, N_key + integer(8),intent(inout) :: key(Nint,2,N_key) + integer,intent(out) :: idx(N_key) + integer(8) :: tmp(Nint, 2) + integer :: tmpidx,i,ni + + do i=1,N_key + idx(i) = i + end do + + do i=N_key/2,1,-1 + call tamiser(key, idx, i, N_key, Nint, N_key) + end do + + do i=N_key,2,-1 + do ni=1,Nint + tmp(ni,1) = key(ni,1,i) + tmp(ni,2) = key(ni,2,i) + key(ni,1,i) = key(ni,1,1) + key(ni,2,i) = key(ni,2,1) + key(ni,1,1) = tmp(ni,1) + key(ni,2,1) = tmp(ni,2) + enddo + + tmpidx = idx(i) + idx(i) = idx(1) + idx(1) = tmpidx + call tamiser(key, idx, 1, i-1, Nint, N_key) + end do +end subroutine + + +subroutine sort_exc(key, N_key) + implicit none + + + integer, intent(in) :: N_key + integer,intent(inout) :: key(4,N_key) + integer :: tmp(4) + integer :: i,ni + + + do i=N_key/2,1,-1 + call tamise_exc(key, i, N_key, N_key) + end do + + do i=N_key,2,-1 + do ni=1,4 + tmp(ni) = key(ni,i) + key(ni,i) = key(ni,1) + key(ni,1) = tmp(ni) + enddo + + call tamise_exc(key, 1, i-1, N_key) + end do +end subroutine + + +logical function exc_inf(exc1, exc2) + implicit none + integer,intent(in) :: exc1(4), exc2(4) + integer :: i + exc_inf = .false. + do i=1,4 + if(exc1(i) < exc2(i)) then + exc_inf = .true. + return + else if(exc1(i) > exc2(i)) then + return + end if + end do +end function + + +subroutine tamise_exc(key, no, n, N_key) + use bitmasks + implicit none + + BEGIN_DOC +! Uncodumented : TODO + END_DOC + integer,intent(in) :: no, n, N_key + integer,intent(inout) :: key(4, N_key) + integer :: k,j + integer :: tmp(4) + logical :: exc_inf + integer :: ni + + k = no + j = 2*k + do while(j <= n) + if(j < n) then + if (exc_inf(key(1,j), key(1,j+1))) then + j = j+1 + endif + endif + if(exc_inf(key(1,k), key(1,j))) then + do ni=1,4 + tmp(ni) = key(ni,k) + key(ni,k) = key(ni,j) + key(ni,j) = tmp(ni) + enddo + k = j + j = k+k + else + return + endif + enddo +end subroutine + + +subroutine dec_exc(exc, h1, h2, p1, p2) + implicit none + integer :: exc(0:2,2,2), s1, s2, degree + integer, intent(out) :: h1, h2, p1, p2 + + degree = exc(0,1,1) + exc(0,1,2) + + h1 = 0 + h2 = 0 + p1 = 0 + p2 = 0 + + if(degree == 0) return + + call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2) + + h1 += mo_tot_num * (s1-1) + p1 += mo_tot_num * (s1-1) + + if(degree == 2) then + h2 += mo_tot_num * (s2-1) + p2 += mo_tot_num * (s2-1) + if(h1 > h2) then + s1 = h1 + h1 = h2 + h2 = s1 + end if + if(p1 > p2) then + s1 = p1 + p1 = p2 + p2 = s1 + end if + else + h2 = h1 + p2 = p1 + p1 = 0 + h1 = 0 + end if +end subroutine + + + BEGIN_PROVIDER [ integer, hh_exists, (4, N_det_ref * N_det_non_ref) ] +&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_det_ref * N_det_non_ref + 1) ] +&BEGIN_PROVIDER [ integer, pp_exists, (4, N_det_ref * N_det_non_ref) ] + implicit none + integer,allocatable :: num(:,:) + integer :: exc(0:2, 2, 2), degree, n, on, s, h1, h2, p1, p2, l, i + double precision :: phase + logical, external :: excEq + + allocate(num(4, N_det_ref * N_det_non_ref)) + + hh_shortcut = 0 + hh_exists = 0 + pp_exists = 0 + num = 0 + + n = 0 + do i=1, N_det_ref + do l=1, N_det_non_ref + call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) + if(degree == -1) cycle + call dec_exc(exc, h1, h2, p1, p2) + n += 1 + num(:, n) = (/h1, h2, p1, p2/) + end do + end do + + call sort_exc(num, n) + + hh_shortcut(0) = 1 + hh_shortcut(1) = 1 + hh_exists(:,1) = (/1, num(1,1), 1, num(2,1)/) + pp_exists(:,1) = (/1, num(3,1), 1, num(4,1)/) + s = 1 + do i=2,n + if(.not. excEq(num(1,i), num(1,s))) then + s += 1 + num(:, s) = num(:, i) + pp_exists(:,s) = (/1, num(3,s), 1, num(4,s)/) + if(hh_exists(2, hh_shortcut(0)) /= num(1,s) .or. & + hh_exists(4, hh_shortcut(0)) /= num(2,s)) then + hh_shortcut(0) += 1 + hh_shortcut(hh_shortcut(0)) = s + hh_exists(:,hh_shortcut(0)) = (/1, num(1,s), 1, num(2,s)/) + end if + end if + end do + hh_shortcut(hh_shortcut(0)+1) = s+1 + + do s=2,4,2 + do i=1,hh_shortcut(0) + if(hh_exists(s, i) == 0) then + hh_exists(s-1, i) = 0 + else if(hh_exists(s, i) > mo_tot_num) then + hh_exists(s, i) -= mo_tot_num + hh_exists(s-1, i) = 2 + end if + end do + + do i=1,hh_shortcut(hh_shortcut(0)+1)-1 + if(pp_exists(s, i) == 0) then + pp_exists(s-1, i) = 0 + else if(pp_exists(s, i) > mo_tot_num) then + pp_exists(s, i) -= mo_tot_num + pp_exists(s-1, i) = 2 + end if + end do + end do +END_PROVIDER + + +logical function excEq(exc1, exc2) + implicit none + integer, intent(in) :: exc1(4), exc2(4) + integer :: i + excEq = .false. + do i=1, 4 + if(exc1(i) /= exc2(i)) return + end do + excEq = .true. +end function + + +integer function excCmp(exc1, exc2) + implicit none + integer, intent(in) :: exc1(4), exc2(4) + integer :: i + excCmp = 0 + do i=1, 4 + if(exc1(i) > exc2(i)) then + excCmp = 1 + return + else if(exc1(i) < exc2(i)) then + excCmp = -1 + return + end if + end do +end function + + +subroutine apply_hole(det, exc, res, ok, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer, intent(in) :: exc(4) + integer :: s1, s2, h1, h2 + integer(bit_kind),intent(in) :: det(Nint, 2) + integer(bit_kind),intent(out) :: res(Nint, 2) + logical, intent(out) :: ok + integer :: ii, pos + + ok = .false. + s1 = exc(1) + h1 = exc(2) + s2 = exc(3) + h2 = exc(4) + res = det + + if(h1 /= 0) then + ii = (h1-1)/bit_kind_size + 1 + pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s1) = ibclr(res(ii, s1), pos) + end if + + ii = (h2-1)/bit_kind_size + 1 + pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return + res(ii, s2) = ibclr(res(ii, s2), pos) + + + ok = .true. +end subroutine + + +subroutine apply_particle(det, exc, res, ok, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer, intent(in) :: exc(4) + integer :: s1, s2, p1, p2 + integer(bit_kind),intent(in) :: det(Nint, 2) + integer(bit_kind),intent(out) :: res(Nint, 2) + logical, intent(out) :: ok + integer :: ii, pos + + ok = .false. + s1 = exc(1) + p1 = exc(2) + s2 = exc(3) + p2 = exc(4) + res = det + + if(p1 /= 0) then + ii = (p1-1)/bit_kind_size + 1 + pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s1) = ibset(res(ii, s1), pos) + end if + + ii = (p2-1)/bit_kind_size + 1 + pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) + if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return + res(ii, s2) = ibset(res(ii, s2), pos) + + + ok = .true. +end subroutine + diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index e0689642..5d8d4850 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -1,227 +1,32 @@ use bitmasks -subroutine dec_exc(exc, h1, h2, p1, p2) - implicit none - integer :: exc(0:2,2,2), s1, s2, degree - integer, intent(out) :: h1, h2, p1, p2 - - degree = exc(0,1,1) + exc(0,1,2) - - h1 = 0 - h2 = 0 - p1 = 0 - p2 = 0 - - if(degree == 0) return - - call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2) - - h1 += mo_tot_num * (s1-1) - p1 += mo_tot_num * (s1-1) - - if(degree == 2) then - h2 += mo_tot_num * (s2-1) - p2 += mo_tot_num * (s2-1) - if(h1 > h2) then - s1 = h1 - h1 = h2 - h2 = s1 - end if - if(p1 > p2) then - s1 = p1 - p1 = p2 - p2 = s1 - end if - else - h2 = h1 - p2 = p1 - p1 = 0 - h1 = 0 - end if -end subroutine - - - - BEGIN_PROVIDER [ integer, hh_exists, (4, N_det_ref * N_det_non_ref) ] -&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_det_ref * N_det_non_ref + 1) ] -&BEGIN_PROVIDER [ integer, pp_exists, (4, N_det_ref * N_det_non_ref) ] - implicit none - integer :: num(0:mo_tot_num*2, 0:mo_tot_num*2) - integer :: exc(0:2, 2, 2), degree, n, on, s, h1, h2, p1, p2, l, i - double precision :: phase - - hh_shortcut = 0 - hh_exists = 0 - pp_exists = 0 - num = 0 - - do i=1, N_det_ref - do l=1, N_det_non_ref - call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) - if(degree == -1) cycle - call dec_exc(exc, h1, h2, p1, p2) - num(h1, h2) += 1 - end do - end do - - n = 1 - do l=0,mo_tot_num*2 - do i=0,l - on = num(i,l) - if(on /= 0) then - hh_shortcut(0) += 1 - hh_shortcut(hh_shortcut(0)) = n - hh_exists(:, hh_shortcut(0)) = (/1, i, 1, l/) - end if - - num(i,l) = n - n += on - end do - end do - - hh_shortcut(hh_shortcut(0)+1) = n - - do i=1, N_det_ref - do l=1, N_det_non_ref - call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) - if(degree == -1) cycle - call dec_exc(exc, h1, h2, p1, p2) - pp_exists(:, num(h1, h2)) = (/1,p1,1,p2/) - num(h1, h2) += 1 - end do - end do - - do s=2,4,2 - do i=1,hh_shortcut(0) - if(hh_exists(s, i) == 0) then - hh_exists(s-1, i) = 0 - else if(hh_exists(s, i) > mo_tot_num) then - hh_exists(s, i) -= mo_tot_num - hh_exists(s-1, i) = 2 - end if - end do - - do i=1,hh_shortcut(hh_shortcut(0)+1)-1 - if(pp_exists(s, i) == 0) then - pp_exists(s-1, i) = 0 - else if(pp_exists(s, i) > mo_tot_num) then - pp_exists(s, i) -= mo_tot_num - pp_exists(s-1, i) = 2 - end if - end do - end do - -END_PROVIDER - - - - -subroutine apply_hole(det, exc, res, ok, Nint) - use bitmasks - implicit none - integer, intent(in) :: Nint - integer, intent(in) :: exc(4) - integer :: s1, s2, h1, h2 - integer(bit_kind),intent(in) :: det(Nint, 2) - integer(bit_kind),intent(out) :: res(Nint, 2) - logical, intent(out) :: ok - integer :: ii, pos - - ok = .false. - s1 = exc(1) - h1 = exc(2) - s2 = exc(3) - h2 = exc(4) - res = det - - if(h1 /= 0) then - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 - if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return - res(ii, s1) = ibclr(res(ii, s1), pos) - end if - - ii = (h2-1)/bit_kind_size + 1 - pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) - if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return - res(ii, s2) = ibclr(res(ii, s2), pos) - - - ok = .true. -end subroutine - - -subroutine apply_particle(det, exc, res, ok, Nint) - use bitmasks - implicit none - integer, intent(in) :: Nint - integer, intent(in) :: exc(4) - integer :: s1, s2, p1, p2 - integer(bit_kind),intent(in) :: det(Nint, 2) - integer(bit_kind),intent(out) :: res(Nint, 2) - logical, intent(out) :: ok - integer :: ii, pos - - ok = .false. - s1 = exc(1) - p1 = exc(2) - s2 = exc(3) - p2 = exc(4) - res = det - - if(p1 /= 0) then - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) - if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return - res(ii, s1) = ibset(res(ii, s1), pos) - end if - - ii = (p2-1)/bit_kind_size + 1 - pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) - if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return - res(ii, s2) = ibset(res(ii, s2), pos) - - - ok = .true. -end subroutine - BEGIN_PROVIDER [ double precision, delta_ij_mrcc, (N_states,N_det_non_ref,N_det_ref) ] &BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] use bitmasks implicit none - integer :: gen, h, p, i_state, n, t + integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2 integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2), buf(N_int, 2, N_det_non_ref) logical :: ok + logical, external :: detEq delta_ij_mrcc = 0d0 delta_ii_mrcc = 0d0 i_state = 1 - do gen=1, N_det_generators - !print *, gen, "/", N_det_generators + do gen= 1, N_det_generators + print *, gen, "/", N_det_generators do h=1, hh_shortcut(0) call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) if(.not. ok) cycle - omask = 0 + omask = 0_bit_kind if(hh_exists(1, h) /= 0) omask = mask - !-459.6378590456251 - !-199.0659502581943 n = 1 - ploop : do p=hh_shortcut(h), hh_shortcut(h+1)-1 - - do t=hh_shortcut(h), p-1 - if(pp_exists(1, p) == pp_exists(1,t) .and. & - pp_exists(2, p) == pp_exists(2,t) .and. & - pp_exists(3, p) == pp_exists(3,t) .and. & - pp_exists(4, p) == pp_exists(4,t)) cycle ploop - end do + do p=hh_shortcut(h), hh_shortcut(h+1)-1 call apply_particle(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) - !-459.6379081607463 - !-199.0659982685706 if(ok) n = n + 1 - end do ploop + end do n = n - 1 if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) end do @@ -229,7 +34,6 @@ end subroutine END_PROVIDER - subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffer,Nint,key_mask) use bitmasks implicit none @@ -258,7 +62,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer :: i_state, k_sd, l_sd, i_I, i_alpha integer(bit_kind),allocatable :: miniList(:,:,:) - integer(bit_kind),intent(in) :: key_mask(Nint, 2) + integer(bit_kind) :: key_mask(Nint, 2) integer,allocatable :: idx_miniList(:) integer :: N_miniList, ni, leng double precision, allocatable :: hij_cache(:) @@ -266,18 +70,18 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist - - - + logical, external :: detEq, is_generable + + leng = max(N_det_generators, N_det_non_ref) allocate(miniList(Nint, 2, leng), idx_minilist(leng), hij_cache(N_det_non_ref)) !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint) call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint) - if(fullMatch) then - return - end if +! if(fullMatch) then +! return +! end if allocate(ptr_microlist(0:mo_tot_num*2+1), & N_microlist(0:mo_tot_num*2) ) @@ -286,9 +90,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe if(key_mask(1,1) /= 0) then call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) - call find_triples_and_quadruples_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) + call filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) else - call find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist) + call filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist) end if @@ -332,7 +136,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe do i_alpha=1,N_tq - if(key_mask(1,1) /= 0) then + if(key_mask(1,1) /= 0) then call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then @@ -463,26 +267,27 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe enddo enddo call omp_set_lock( psi_ref_lock(i_I) ) + do i_state=1,N_states 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) + 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) + 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 enddo - !deallocate (dIa_hla,hij_cache) - !deallocate(miniList, idx_miniList) + deallocate (dIa_hla,hij_cache) + deallocate(miniList, idx_miniList) end @@ -494,29 +299,30 @@ end implicit none integer :: i, j, i_state - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc do i_state = 1, N_states if(mrmode == 3) then - do i = 1, N_det_ref - delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) - do j = 1, N_det_non_ref - delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_sub_ij(i,j,i_state) - end do - end do - else if(mrmode == 2) then - do i = 1, N_det_ref - delta_ii(i_state,i)= delta_ii_mrcc(i_state,i) - do j = 1, N_det_non_ref - delta_ij(i_state,j,i) = delta_ij_mrcc(i_state,j,i) - end do + do i = 1, N_det_ref + delta_ii(i_state,i)= delta_ii_mrcc(i_state,i) + do j = 1, N_det_non_ref + delta_ij(i_state,j,i) = delta_ij_mrcc(i_state,j,i) end do + end do +! ! do i = 1, N_det_ref -! delta_ii(i_state,i)= delta_ii_old(i_state,i) +! delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) ! do j = 1, N_det_non_ref -! delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) +! delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_sub_ij(i,j,i_state) ! end do ! end do + else if(mrmode == 2) then + do i = 1, N_det_ref + delta_ii(i_state,i)= delta_ii_old(i_state,i) + do j = 1, N_det_non_ref + delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) + end do + end do else if(mrmode == 1) then do i = 1, N_det_ref delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) @@ -646,7 +452,6 @@ END_PROVIDER end do end do end do - print *, "pre done" END_PROVIDER @@ -708,21 +513,6 @@ END_PROVIDER END_PROVIDER -logical function detEq(a,b,Nint) - use bitmasks - implicit none - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) - integer :: ni, i - - detEq = .false. - do i=1,2 - do ni=1,Nint - if(a(ni,i) /= b(ni,i)) return - end do - end do - detEq = .true. -end function logical function isInCassd(a,Nint) @@ -793,106 +583,6 @@ subroutine getHP(a,h,p,Nint) !isInCassd = .true. end function -integer function detCmp(a,b,Nint) - use bitmasks - implicit none - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) - integer :: ni, i - - detCmp = 0 - do i=1,2 - do ni=Nint,1,-1 - - if(a(ni,i) < b(ni,i)) then - detCmp = -1 - return - else if(a(ni,i) > b(ni,i)) then - detCmp = 1 - return - end if - - end do - end do -end function - - -integer function searchDet(dets, det, n, Nint) - implicit none - use bitmasks - - integer(bit_kind),intent(in) :: dets(Nint,2,n), det(Nint,2) - integer, intent(in) :: nint, n - integer :: l, h, c - integer, external :: detCmp - logical, external :: detEq - - !do l=1,n - ! if(detEq(det(1,1), dets(1,1,l),Nint)) then - ! searchDet = l - ! return - ! end if - !end do - !searchDet = -1 - !return - - - l = 1 - h = n - do while(.true.) - searchDet = (l+h)/2 - c = detCmp(dets(1,1,searchDet), det(:,:), Nint) - if(c == 0) return - if(c == 1) then - h = searchDet-1 - else - l = searchDet+1 - end if - if(l > h) then - searchDet = -1 - return - end if - - end do -end function - - -subroutine sort_det(key, idx, N_key, Nint) - implicit none - - - integer, intent(in) :: Nint, N_key - integer(8),intent(inout) :: key(Nint,2,N_key) - integer,intent(out) :: idx(N_key) - integer(8) :: tmp(Nint, 2) - integer :: tmpidx,i,ni - - do i=1,N_key - idx(i) = i - end do - - do i=N_key/2,1,-1 - call tamiser(key, idx, i, N_key, Nint, N_key) - end do - - do i=N_key,2,-1 - do ni=1,Nint - tmp(ni,1) = key(ni,1,i) - tmp(ni,2) = key(ni,2,i) - key(ni,1,i) = key(ni,1,1) - key(ni,2,i) = key(ni,2,1) - key(ni,1,1) = tmp(ni,1) - key(ni,2,1) = tmp(ni,2) - enddo - - tmpidx = idx(i) - idx(i) = idx(1) - idx(1) = tmpidx - call tamiser(key, idx, 1, i-1, Nint, N_key) - end do -end subroutine - - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] &BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] @@ -1116,6 +806,7 @@ end subroutine BEGIN_PROVIDER [ double precision, h_, (N_det_ref,N_det_non_ref) ] + implicit none integer :: i,j do i=1,N_det_ref do j=1,N_det_non_ref @@ -1125,3 +816,135 @@ BEGIN_PROVIDER [ double precision, h_, (N_det_ref,N_det_non_ref) ] END_PROVIDER + +subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_miniList) + + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,m + logical :: is_in_wavefunction + integer :: degree(psi_det_size) + integer :: idx(0:psi_det_size) + logical :: good + + integer(bit_kind), intent(out) :: tq(Nint,2,n_selected) + integer, intent(out) :: N_tq + + integer :: nt,ni + logical, external :: is_connected_to, is_generable + + integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators) + integer,intent(in) :: N_miniList + + + N_tq = 0 + + i_loop : do i=1,N_selected + do k=1, N_minilist + if(is_generable(miniList(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + + ! Select determinants that are triple or quadruple excitations + ! from the ref + good = .True. + call get_excitation_degree_vector(psi_ref,det_buffer(1,1,i),degree,Nint,N_det_ref,idx) + !good=(idx(0) == 0) tant que degree > 2 pas retourné par get_excitation_degree_vector + do k=1,idx(0) + if (degree(k) < 3) then + good = .False. + exit + endif + enddo + if (good) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then + N_tq += 1 + do k=1,N_int + tq(k,1,N_tq) = det_buffer(k,1,i) + tq(k,2,N_tq) = det_buffer(k,2,i) + enddo + endif + endif + enddo i_loop +end + + +subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) + + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,m + logical :: is_in_wavefunction + integer :: degree(psi_det_size) + integer :: idx(0:psi_det_size) + logical :: good + + integer(bit_kind), intent(out) :: tq(Nint,2,n_selected) + integer, intent(out) :: N_tq + + integer :: nt,ni + logical, external :: is_connected_to, is_generable + + integer(bit_kind),intent(in) :: microlist(Nint,2,*) + integer,intent(in) :: ptr_microlist(0:*) + integer,intent(in) :: N_microlist(0:*) + integer(bit_kind),intent(in) :: key_mask(Nint, 2) + + integer :: mobiles(2), smallerlist + + + N_tq = 0 + + i_loop : do i=1,N_selected + call getMobiles(det_buffer(1,1,i), key_mask, mobiles, Nint) + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + + if(N_microlist(smallerlist) > 0) then + do k=ptr_microlist(smallerlist), ptr_microlist(smallerlist)+N_microlist(smallerlist)-1 + if(is_generable(microlist(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + end if + + if(N_microlist(0) > 0) then + do k=1, N_microlist(0) + if(is_generable(microlist(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + end if + + ! Select determinants that are triple or quadruple excitations + ! from the ref + good = .True. + call get_excitation_degree_vector(psi_ref,det_buffer(1,1,i),degree,Nint,N_det_ref,idx) + !good=(idx(0) == 0) tant que degree > 2 pas retourné par get_excitation_degree_vector + do k=1,idx(0) + if (degree(k) < 3) then + good = .False. + exit + endif + enddo + if (good) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then + N_tq += 1 + do k=1,N_int + tq(k,1,N_tq) = det_buffer(k,1,i) + tq(k,2,N_tq) = det_buffer(k,2,i) + enddo + endif + endif + enddo i_loop +end + + + + diff --git a/plugins/mrcepa0/mrsc2sub.irp.f b/plugins/mrcepa0/mrcc.irp.f similarity index 88% rename from plugins/mrcepa0/mrsc2sub.irp.f rename to plugins/mrcepa0/mrcc.irp.f index 07a07c83..91592e62 100644 --- a/plugins/mrcepa0/mrsc2sub.irp.f +++ b/plugins/mrcepa0/mrcc.irp.f @@ -3,7 +3,7 @@ program mrsc2sub double precision, allocatable :: energy(:) allocate (energy(N_states)) - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc mrmode = 3 read_wf = .True. diff --git a/plugins/mrcepa0/mrcepa0.irp.f b/plugins/mrcepa0/mrcepa0.irp.f index 9473361b..34d3dec5 100644 --- a/plugins/mrcepa0/mrcepa0.irp.f +++ b/plugins/mrcepa0/mrcepa0.irp.f @@ -3,7 +3,7 @@ program mrcepa0 double precision, allocatable :: energy(:) allocate (energy(N_states)) - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc mrmode = 1 read_wf = .True. diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index df10de34..82b1fc9b 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -15,6 +15,7 @@ subroutine run(N_st,energy) integer :: n_it_mrcc_max double precision :: thresh_mrcc + thresh_mrcc = 1d-7 n_it_mrcc_max = 10 diff --git a/plugins/mrcepa0/mrsc2.irp.f b/plugins/mrcepa0/mrsc2.irp.f index d4e1b1d4..d0f44a33 100644 --- a/plugins/mrcepa0/mrsc2.irp.f +++ b/plugins/mrcepa0/mrsc2.irp.f @@ -3,9 +3,8 @@ program mrsc2 double precision, allocatable :: energy(:) allocate (energy(N_states)) - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrsc2 sub + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc mrmode = 2 - read_wf = .True. SOFT_TOUCH read_wf call print_cas_coefs diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index 4e419af5..c46a5bb0 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -11,7 +11,7 @@ subroutine $subroutine_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl integer(bit_kind), intent(in) :: key_prev(N_int, 2, *) PROVIDE N_int PROVIDE N_det - + $declarations @@ -184,7 +184,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl $initialization - + $omp_parallel !$ iproc = omp_get_thread_num() allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), & diff --git a/src/Determinants/connected_to_ref.irp.f b/src/Determinants/connected_to_ref.irp.f index 7a54bdbc..2f53c799 100644 --- a/src/Determinants/connected_to_ref.irp.f +++ b/src/Determinants/connected_to_ref.irp.f @@ -165,7 +165,7 @@ logical function is_connected_to(key,keys,Nint,Ndet) integer :: i, l integer :: degree_x2 - + logical, external :: is_generable_cassd ASSERT (Nint > 0) ASSERT (Nint == N_int) @@ -183,12 +183,35 @@ logical function is_connected_to(key,keys,Nint,Ndet) if (degree_x2 > 4) then cycle else +! if(.not. is_generable_cassd(keys(1,1,i), key(1,1), Nint)) cycle !!!Nint==1 !!!!! is_connected_to = .true. return endif enddo end + +logical function is_generable_cassd(det1, det2, Nint) !!! TEST Cl HARD !!!!! + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) + integer :: degree, f, exc(0:2, 2, 2), h1, h2, p1, p2, s1, s2, t + double precision :: phase + + is_generable_cassd = .false. + call get_excitation(det1, det2, exc, degree, phase, Nint) + if(degree == -1) return + if(degree == 0) then + is_generable_cassd = .true. + return + end if + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + if(degree == 1 .and. h1 <= 11) is_generable_cassd = .true. + if(degree == 2 .and. h1 <= 11 .and. h2 <= 11) is_generable_cassd = .true. +end function + + logical function is_connected_to_by_mono(key,keys,Nint,Ndet) use bitmasks implicit none diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 4476ed45..400345c1 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -664,3 +664,44 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde end +logical function detEq(a,b,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) + integer :: ni, i + + detEq = .false. + do i=1,2 + do ni=1,Nint + if(a(ni,i) /= b(ni,i)) return + end do + end do + detEq = .true. +end function + + +integer function detCmp(a,b,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2), b(Nint,2) + integer :: ni, i + + detCmp = 0 + do i=1,2 + do ni=Nint,1,-1 + + if(a(ni,i) < b(ni,i)) then + detCmp = -1 + return + else if(a(ni,i) > b(ni,i)) then + detCmp = 1 + return + end if + + end do + end do +end function + + diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 0b456751..2b5ae4f1 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -914,7 +914,6 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis fullMatch = .false. N_miniList = 0 N_subList = 0 - l = popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) do ni = 2,Nint l = l + popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2)) @@ -947,8 +946,13 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis miniList(ni,2,N_minilist) = fullList(ni,2,i) enddo else if(k == 0) then - fullMatch = .true. - return + N_minilist += 1 + do ni=1,Nint + miniList(ni,1,N_minilist) = fullList(ni,1,i) + miniList(ni,2,N_minilist) = fullList(ni,2,i) + enddo +! fullMatch = .true. +! return end if end do end if diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index 8d5726f5..2eec0dea 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/src/Determinants/spindeterminants.irp.f @@ -10,7 +10,7 @@ integer*8 function spin_det_search_key(det,Nint) use bitmasks implicit none BEGIN_DOC -! Return an integer*8 corresponding to a determinant index for searching +! Return an integer(8) corresponding to a determinant index for searching END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: det(Nint) @@ -64,9 +64,9 @@ BEGIN_TEMPLATE integer :: i,j,k integer, allocatable :: iorder(:) - integer*8, allocatable :: bit_tmp(:) - integer*8 :: last_key - integer*8, external :: spin_det_search_key + integer(8), allocatable :: bit_tmp(:) + integer(8) :: last_key + integer(8), external :: spin_det_search_key logical,allocatable :: duplicate(:) allocate ( iorder(N_det), bit_tmp(N_det), duplicate(N_det) ) @@ -149,8 +149,8 @@ integer function get_index_in_psi_det_alpha_unique(key,Nint) integer(bit_kind), intent(in) :: key(Nint) integer :: i, ibegin, iend, istep, l - integer*8 :: det_ref, det_search - integer*8, external :: spin_det_search_key + integer(8) :: det_ref, det_search + integer(8), external :: spin_det_search_key logical :: in_wavefunction in_wavefunction = .False. @@ -231,8 +231,8 @@ integer function get_index_in_psi_det_beta_unique(key,Nint) integer(bit_kind), intent(in) :: key(Nint) integer :: i, ibegin, iend, istep, l - integer*8 :: det_ref, det_search - integer*8, external :: spin_det_search_key + integer(8) :: det_ref, det_search + integer(8), external :: spin_det_search_key logical :: in_wavefunction in_wavefunction = .False. @@ -305,10 +305,10 @@ end subroutine write_spindeterminants use bitmasks implicit none - integer*8, allocatable :: tmpdet(:,:) + integer(8), allocatable :: tmpdet(:,:) integer :: N_int2 integer :: i,j,k - integer*8 :: det_8(100) + integer(8) :: det_8(100) integer(bit_kind) :: det_bk((100*8)/bit_kind) equivalence (det_8, det_bk) From f8ece7d40b3cd11f7df81a16460735d2a236ef8e Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 20 May 2016 11:27:39 +0200 Subject: [PATCH 25/42] added OMP - excitations as integer2 --- plugins/MRCC_Utils/mrcc_utils.irp.f | 54 +++++++++++------------ plugins/mrcepa0/dressing.irp.f | 35 ++++++++++++--- src/Determinants/slater_rules.irp.f | 66 +++++++++++++++++++++++++++++ 3 files changed, 123 insertions(+), 32 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 8873a940..42058145 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -288,7 +288,8 @@ logical function is_generable(det1, det2, Nint) implicit none integer, intent(in) :: Nint integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) - integer :: degree, f, exc(0:2, 2, 2), h1, h2, p1, p2, s1, s2, t + integer :: degree, f, exc(0:2, 2, 2), t + integer*2 :: h1, h2, p1, p2, s1, s2 integer, external :: searchExc logical, external :: excEq double precision :: phase @@ -312,7 +313,7 @@ logical function is_generable(det1, det2, Nint) ! ! print *, f ! return - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) if(degree == 1) then h2 = h1 @@ -323,14 +324,14 @@ logical function is_generable(det1, det2, Nint) s1 = 0 end if - if(h1 + s1*mo_tot_num < h2 + s2*mo_tot_num) then + if(h1 + (s1-1)*mo_tot_num < h2 + (s2-1)*mo_tot_num) then f = searchExc(hh_exists(1,1), (/s1, h1, s2, h2/), hh_shortcut(0)) else f = searchExc(hh_exists(1,1), (/s2, h2, s1, h1/), hh_shortcut(0)) end if if(f == -1) return - if(p1 + s1*mo_tot_num < p2 + s2*mo_tot_num) then + if(p1 + (s1-1)*mo_tot_num < p2 + (s2-1)*mo_tot_num) then f = searchExc(pp_exists(1,hh_shortcut(f)), (/s1, p1, s2, p2/), hh_shortcut(f+1)-hh_shortcut(f)) else f = searchExc(pp_exists(1,hh_shortcut(f)), (/s2, p2, s1, p1/), hh_shortcut(f+1)-hh_shortcut(f)) @@ -376,7 +377,7 @@ integer function searchExc(excs, exc, n) use bitmasks integer, intent(in) :: n - integer,intent(in) :: excs(4,n), exc(4) + integer*2,intent(in) :: excs(4,n), exc(4) integer :: l, h, c integer, external :: excCmp logical, external :: excEq @@ -441,8 +442,8 @@ subroutine sort_exc(key, N_key) integer, intent(in) :: N_key - integer,intent(inout) :: key(4,N_key) - integer :: tmp(4) + integer*2,intent(inout) :: key(4,N_key) + integer*2 :: tmp(4) integer :: i,ni @@ -464,7 +465,7 @@ end subroutine logical function exc_inf(exc1, exc2) implicit none - integer,intent(in) :: exc1(4), exc2(4) + integer*2,intent(in) :: exc1(4), exc2(4) integer :: i exc_inf = .false. do i=1,4 @@ -486,9 +487,9 @@ subroutine tamise_exc(key, no, n, N_key) ! Uncodumented : TODO END_DOC integer,intent(in) :: no, n, N_key - integer,intent(inout) :: key(4, N_key) + integer*2,intent(inout) :: key(4, N_key) integer :: k,j - integer :: tmp(4) + integer*2 :: tmp(4) logical :: exc_inf integer :: ni @@ -518,7 +519,7 @@ end subroutine subroutine dec_exc(exc, h1, h2, p1, p2) implicit none integer :: exc(0:2,2,2), s1, s2, degree - integer, intent(out) :: h1, h2, p1, p2 + integer*2, intent(out) :: h1, h2, p1, p2 degree = exc(0,1,1) + exc(0,1,2) @@ -529,7 +530,7 @@ subroutine dec_exc(exc, h1, h2, p1, p2) if(degree == 0) return - call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2) + call decode_exc_int2(exc, degree, h1, p1, h2, p2, s1, s2) h1 += mo_tot_num * (s1-1) p1 += mo_tot_num * (s1-1) @@ -556,12 +557,13 @@ subroutine dec_exc(exc, h1, h2, p1, p2) end subroutine - BEGIN_PROVIDER [ integer, hh_exists, (4, N_det_ref * N_det_non_ref) ] + BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_det_ref * N_det_non_ref) ] &BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_det_ref * N_det_non_ref + 1) ] -&BEGIN_PROVIDER [ integer, pp_exists, (4, N_det_ref * N_det_non_ref) ] +&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_det_ref * N_det_non_ref) ] implicit none - integer,allocatable :: num(:,:) - integer :: exc(0:2, 2, 2), degree, n, on, s, h1, h2, p1, p2, l, i + integer*2,allocatable :: num(:,:) + integer :: exc(0:2, 2, 2), degree, n, on, s, l, i + integer*2 :: h1, h2, p1, p2 double precision :: phase logical, external :: excEq @@ -587,19 +589,19 @@ end subroutine hh_shortcut(0) = 1 hh_shortcut(1) = 1 - hh_exists(:,1) = (/1, num(1,1), 1, num(2,1)/) - pp_exists(:,1) = (/1, num(3,1), 1, num(4,1)/) + hh_exists(:,1) = (/1_2, num(1,1), 1_2, num(2,1)/) + pp_exists(:,1) = (/1_2, num(3,1), 1_2, num(4,1)/) s = 1 do i=2,n if(.not. excEq(num(1,i), num(1,s))) then s += 1 num(:, s) = num(:, i) - pp_exists(:,s) = (/1, num(3,s), 1, num(4,s)/) + pp_exists(:,s) = (/1_2, num(3,s), 1_2, num(4,s)/) if(hh_exists(2, hh_shortcut(0)) /= num(1,s) .or. & hh_exists(4, hh_shortcut(0)) /= num(2,s)) then hh_shortcut(0) += 1 hh_shortcut(hh_shortcut(0)) = s - hh_exists(:,hh_shortcut(0)) = (/1, num(1,s), 1, num(2,s)/) + hh_exists(:,hh_shortcut(0)) = (/1_2, num(1,s), 1_2, num(2,s)/) end if end if end do @@ -629,7 +631,7 @@ END_PROVIDER logical function excEq(exc1, exc2) implicit none - integer, intent(in) :: exc1(4), exc2(4) + integer*2, intent(in) :: exc1(4), exc2(4) integer :: i excEq = .false. do i=1, 4 @@ -641,7 +643,7 @@ end function integer function excCmp(exc1, exc2) implicit none - integer, intent(in) :: exc1(4), exc2(4) + integer*2, intent(in) :: exc1(4), exc2(4) integer :: i excCmp = 0 do i=1, 4 @@ -660,8 +662,8 @@ subroutine apply_hole(det, exc, res, ok, Nint) use bitmasks implicit none integer, intent(in) :: Nint - integer, intent(in) :: exc(4) - integer :: s1, s2, h1, h2 + integer*2, intent(in) :: exc(4) + integer*2 :: s1, s2, h1, h2 integer(bit_kind),intent(in) :: det(Nint, 2) integer(bit_kind),intent(out) :: res(Nint, 2) logical, intent(out) :: ok @@ -695,8 +697,8 @@ subroutine apply_particle(det, exc, res, ok, Nint) use bitmasks implicit none integer, intent(in) :: Nint - integer, intent(in) :: exc(4) - integer :: s1, s2, p1, p2 + integer*2, intent(in) :: exc(4) + integer*2 :: s1, s2, p1, p2 integer(bit_kind),intent(in) :: det(Nint, 2) integer(bit_kind),intent(out) :: res(Nint, 2) logical, intent(out) :: ok diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 5d8d4850..4f99f6e1 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -6,16 +6,28 @@ use bitmasks &BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] use bitmasks implicit none - integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2 - integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2), buf(N_int, 2, N_det_non_ref) + integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2, iproc + integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) + integer(bit_kind), allocatable :: buf(:,:,:) + double precision, allocatable :: delta_ij_mwen(:,:,:,:), delta_ii_mwen(:,:,:) logical :: ok logical, external :: detEq delta_ij_mrcc = 0d0 delta_ii_mrcc = 0d0 i_state = 1 + provide hh_shortcut psi_det_size + allocate(delta_ij_mwen(N_states,N_det_non_ref,N_det_ref,nproc), delta_ii_mwen(N_states,N_det_ref,nproc)) + allocate(buf(N_int, 2, N_det_non_ref)) + delta_ij_mwen = 0d0 + delta_ii_mwen = 0d0 + !$OMP PARALLEL DO default(none) schedule(dynamic) & + !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & + !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mwen, delta_ij_mwen) & + !$OMP private(h, n, mask, omask, buf, ok, iproc) do gen= 1, N_det_generators + iproc = omp_get_thread_num() + 1 print *, gen, "/", N_det_generators do h=1, hh_shortcut(0) call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) @@ -28,12 +40,23 @@ use bitmasks if(ok) n = n + 1 end do n = n - 1 - if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) + if(n /= 0) call mrcc_part_dress(delta_ij_mwen(1,1,1,iproc), delta_ii_mwen(1,1,iproc),gen,n,buf,N_int,omask) end do end do + !$OMP END PARALLEL DO + do iproc=1, nproc + delta_ij_mrcc = delta_ij_mrcc + delta_ij_mwen(:,:,:,iproc) + delta_ii_mrcc = delta_ii_mrcc + delta_ii_mwen(:,:,iproc) + end do END_PROVIDER +! subroutine blit(b1, b2) +! double precision :: b1(N_states,N_det_non_ref,N_det_ref), b2(N_states,N_det_non_ref,N_det_ref) +! b1 = b1 + b2 +! end subroutine + + subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffer,Nint,key_mask) use bitmasks implicit none @@ -463,7 +486,7 @@ END_PROVIDER double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) - provide lambda_mrcc +! provide lambda_mrcc npres = 0 delta_cas = 0d0 call wall_time(wall) @@ -605,8 +628,8 @@ end function call wall_time(wall) print *, "cepa0", wall - provide det_cepa0_active delta_cas lambda_mrcc - provide mo_bielec_integrals_in_map +! provide det_cepa0_active delta_cas lambda_mrcc +! provide mo_bielec_integrals_in_map allocate(idx_sorted_bit(N_det)) sortRef(:,:,:) = det_ref_active(:,:,:) diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 2b5ae4f1..3374dfb2 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -139,6 +139,72 @@ subroutine decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) end +subroutine decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) + use bitmasks + implicit none + BEGIN_DOC + ! Decodes the exc arrays returned by get_excitation. + ! h1,h2 : Holes + ! p1,p2 : Particles + ! s1,s2 : Spins (1:alpha, 2:beta) + ! degree : Degree of excitation + END_DOC + integer, intent(in) :: exc(0:2,2,2),degree + integer*2, intent(out) :: h1,h2,p1,p2,s1,s2 + ASSERT (degree > 0) + ASSERT (degree < 3) + + select case(degree) + case(2) + if (exc(0,1,1) == 2) then + h1 = exc(1,1,1) + h2 = exc(2,1,1) + p1 = exc(1,2,1) + p2 = exc(2,2,1) + s1 = 1 + s2 = 1 + else if (exc(0,1,2) == 2) then + h1 = exc(1,1,2) + h2 = exc(2,1,2) + p1 = exc(1,2,2) + p2 = exc(2,2,2) + s1 = 2 + s2 = 2 + else + h1 = exc(1,1,1) + h2 = exc(1,1,2) + p1 = exc(1,2,1) + p2 = exc(1,2,2) + s1 = 1 + s2 = 2 + endif + case(1) + if (exc(0,1,1) == 1) then + h1 = exc(1,1,1) + h2 = 0 + p1 = exc(1,2,1) + p2 = 0 + s1 = 1 + s2 = 0 + else + h1 = exc(1,1,2) + h2 = 0 + p1 = exc(1,2,2) + p2 = 0 + s1 = 2 + s2 = 0 + endif + case(0) + h1 = 0 + p1 = 0 + h2 = 0 + p2 = 0 + s1 = 0 + s2 = 0 + end select +end + + subroutine get_double_excitation(det1,det2,exc,phase,Nint) use bitmasks implicit none From c7c3e9d64be679cdba9effeb8102e638a11276d4 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 20 May 2016 12:28:20 +0200 Subject: [PATCH 26/42] corrected OMP --- plugins/mrcepa0/dressing.irp.f | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 4f99f6e1..639b62e4 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -8,23 +8,18 @@ use bitmasks implicit none integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2, iproc integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) - integer(bit_kind), allocatable :: buf(:,:,:) - double precision, allocatable :: delta_ij_mwen(:,:,:,:), delta_ii_mwen(:,:,:) + integer(bit_kind) :: buf(N_int, 2, N_det_non_ref) logical :: ok logical, external :: detEq delta_ij_mrcc = 0d0 delta_ii_mrcc = 0d0 i_state = 1 - provide hh_shortcut psi_det_size - allocate(delta_ij_mwen(N_states,N_det_non_ref,N_det_ref,nproc), delta_ii_mwen(N_states,N_det_ref,nproc)) - allocate(buf(N_int, 2, N_det_non_ref)) - delta_ij_mwen = 0d0 - delta_ii_mwen = 0d0 + provide hh_shortcut psi_det_size lambda_mrcc !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & - !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mwen, delta_ij_mwen) & + !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc) & !$OMP private(h, n, mask, omask, buf, ok, iproc) do gen= 1, N_det_generators iproc = omp_get_thread_num() + 1 @@ -40,14 +35,10 @@ use bitmasks if(ok) n = n + 1 end do n = n - 1 - if(n /= 0) call mrcc_part_dress(delta_ij_mwen(1,1,1,iproc), delta_ii_mwen(1,1,iproc),gen,n,buf,N_int,omask) + if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) end do end do !$OMP END PARALLEL DO - do iproc=1, nproc - delta_ij_mrcc = delta_ij_mrcc + delta_ij_mwen(:,:,:,iproc) - delta_ii_mrcc = delta_ii_mrcc + delta_ii_mwen(:,:,iproc) - end do END_PROVIDER From 39618c4300f8aaf64fac22317f99e632051422c0 Mon Sep 17 00:00:00 2001 From: Yann GARNIRON Date: Thu, 26 May 2016 13:52:48 +0200 Subject: [PATCH 27/42] corrected mrsc2 for large systems --- config/ifort.cfg | 6 ++-- plugins/MRCC_Utils/mrcc_utils.irp.f | 51 +++++++++++++++++++++++----- plugins/mrcepa0/dressing.irp.f | 49 +++++++++++++------------- plugins/mrcepa0/dressing_slave.irp.f | 30 ++++++++-------- src/Determinants/davidson.irp.f | 4 +-- 5 files changed, 90 insertions(+), 50 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index 2b2fe0a2..acbfde1f 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,14 +31,14 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g +FCFLAGS : -C -xAVX -O2 -ip -ftz -g -traceback # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -xSSE4.2 -O2 -ip -ftz +FCFLAGS : -xAVX -O2 -ip -ftz # Debugging flags ################# @@ -51,7 +51,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz # [DEBUG] FC : -g -traceback -FCFLAGS : -xSSE2 -C -fpe0 +FCFLAGS : -xAVX -C -fpe0 IRPF90_FLAGS : --openmp # OpenMP flags diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 42058145..cfd6481e 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -102,7 +102,7 @@ END_PROVIDER if (ihpsi_current(k) == 0.d0) then ihpsi_current(k) = 1.d-32 endif - lambda_mrcc(k,i) = min(0.d0,psi_non_ref_coef(i,k)/ihpsi_current(k) ) + lambda_mrcc(k,i) = min(1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then i_pert_count += 1 @@ -356,7 +356,7 @@ integer function searchDet(dets, det, n, Nint) h = n do while(.true.) searchDet = (l+h)/2 - c = detCmp(dets(1,1,searchDet), det(:,:), Nint) + c = detCmp(dets(1,1,searchDet), det(1,1), Nint) if(c == 0) return if(c == 1) then h = searchDet-1 @@ -386,7 +386,7 @@ integer function searchExc(excs, exc, n) h = n do searchExc = (l+h)/2 - c = excCmp(excs(1,searchExc), exc(:)) + c = excCmp(excs(1,searchExc), exc(1)) if(c == 0) return if(c == 1) then h = searchExc-1 @@ -407,7 +407,7 @@ subroutine sort_det(key, idx, N_key, Nint) integer, intent(in) :: Nint, N_key integer(8),intent(inout) :: key(Nint,2,N_key) - integer,intent(out) :: idx(N_key) + integer,intent(inout) :: idx(N_key) integer(8) :: tmp(Nint, 2) integer :: tmpidx,i,ni @@ -557,9 +557,44 @@ subroutine dec_exc(exc, h1, h2, p1, p2) end subroutine - BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_det_ref * N_det_non_ref) ] -&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_det_ref * N_det_non_ref + 1) ] -&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_det_ref * N_det_non_ref) ] + BEGIN_PROVIDER [ integer, N_hh_exists ] +&BEGIN_PROVIDER [ integer, N_pp_exists ] +&BEGIN_PROVIDER [ integer, N_ex_exists ] + implicit none + integer :: exc(0:2, 2, 2), degree, n, on, s, l, i + integer*2 :: h1, h2, p1, p2 + double precision :: phase + logical,allocatable :: hh(:,:) , pp(:,:) + + allocate(hh(0:mo_tot_num*2, 0:mo_tot_num*2)) + allocate(pp(0:mo_tot_num*2, 0:mo_tot_num*2)) + hh = .false. + pp = .false. + N_hh_exists = 0 + N_pp_exists = 0 + N_ex_exists = 0 + + n = 0 + do i=1, N_det_ref + do l=1, N_det_non_ref + call get_excitation(psi_ref(1,1,i), psi_non_ref(1,1,l), exc, degree, phase, N_int) + if(degree == -1) cycle + call dec_exc(exc, h1, h2, p1, p2) + N_ex_exists += 1 + if(.not. hh(h1,h2)) N_hh_exists = N_hh_exists + 1 + if(.not. pp(p1,p2)) N_pp_exists = N_pp_exists + 1 + hh(h1,h2) = .true. + pp(p1,p2) = .true. + end do + end do + N_pp_exists = min(N_ex_exists, N_pp_exists * N_hh_exists) +END_PROVIDER + + + + BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ] +&BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ] +&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ] implicit none integer*2,allocatable :: num(:,:) integer :: exc(0:2, 2, 2), degree, n, on, s, l, i @@ -567,7 +602,7 @@ end subroutine double precision :: phase logical, external :: excEq - allocate(num(4, N_det_ref * N_det_non_ref)) + allocate(num(4, N_ex_exists+1)) hh_shortcut = 0 hh_exists = 0 diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 639b62e4..d2e88d96 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -8,7 +8,7 @@ use bitmasks implicit none integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2, iproc integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) - integer(bit_kind) :: buf(N_int, 2, N_det_non_ref) + integer(bit_kind),allocatable :: buf(:,:,:) logical :: ok logical, external :: detEq @@ -16,27 +16,29 @@ use bitmasks delta_ii_mrcc = 0d0 i_state = 1 provide hh_shortcut psi_det_size lambda_mrcc - !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc) & !$OMP private(h, n, mask, omask, buf, ok, iproc) do gen= 1, N_det_generators + allocate(buf(N_int, 2, N_det_non_ref)) iproc = omp_get_thread_num() + 1 print *, gen, "/", N_det_generators do h=1, hh_shortcut(0) call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) if(.not. ok) cycle omask = 0_bit_kind - if(hh_exists(1, h) /= 0) omask = mask + !if(hh_exists(1, h) /= 0) omask = mask n = 1 do p=hh_shortcut(h), hh_shortcut(h+1)-1 call apply_particle(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) if(ok) n = n + 1 + if(n > N_det_non_ref) stop "MRCC..." end do n = n - 1 if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) end do + deallocate(buf) end do !$OMP END PARALLEL DO END_PROVIDER @@ -58,11 +60,10 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,l,m - integer :: degree_alpha(psi_det_size) - integer :: idx_alpha(0:psi_det_size) + integer,allocatable :: idx_alpha(:), degree_alpha(:) logical :: good, fullMatch - integer(bit_kind) :: tq(Nint,2,n_selected) + integer(bit_kind),allocatable :: tq(:,:,:) integer :: N_tq, c_ref ,degree double precision :: hIk, hla, hIl, dIk(N_states), dka(N_states), dIa(N_states) @@ -76,7 +77,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer :: i_state, k_sd, l_sd, i_I, i_alpha integer(bit_kind),allocatable :: miniList(:,:,:) - integer(bit_kind) :: key_mask(Nint, 2) + integer(bit_kind),intent(in) :: key_mask(Nint, 2) integer,allocatable :: idx_miniList(:) integer :: N_miniList, ni, leng double precision, allocatable :: hij_cache(:) @@ -88,8 +89,8 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe leng = max(N_det_generators, N_det_non_ref) - allocate(miniList(Nint, 2, leng), idx_minilist(leng), hij_cache(N_det_non_ref)) - + allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref)) + allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size)) !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint) call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint) @@ -373,10 +374,15 @@ END_PROVIDER use bitmasks implicit none - integer(bit_kind) :: det_noactive(N_int, 2, N_det_non_ref), nonactive_sorb(N_int,2), det(N_int, 2) - integer i, II, j, k, n, ni, idx(N_det_non_ref), shortcut(0:N_det_non_ref+1), blok, degree + integer(bit_kind),allocatable :: det_noactive(:,:,:) + integer, allocatable :: shortcut(:), idx(:) + integer(bit_kind) :: nonactive_sorb(N_int,2), det(N_int, 2) + integer i, II, j, k, n, ni, blok, degree logical, external :: detEq + allocate(det_noactive(N_int, 2, N_det_non_ref)) + allocate(idx(N_det_non_ref), shortcut(0:N_det_non_ref+1)) + print *, "pre start" active_sorb(:,:) = 0_8 nonactive_sorb(:,:) = not(0_8) @@ -507,12 +513,10 @@ END_PROVIDER end do end do !!$OMP END PARALLEL DO - print *, npres npre=0 do i=1,N_det_ref npre += npres(i) end do - print *, npre !stop do i=1,N_det_ref do j=1,i @@ -609,7 +613,8 @@ end function double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) double precision :: contrib, HIIi, HJk, wall integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ - integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2), sortRef(N_int,2,N_det_ref) + integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2) + integer(bit_kind),allocatable :: sortRef(:,:,:) integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit, searchDet logical, external :: is_in_wavefunction, detEq @@ -618,10 +623,7 @@ end function integer*8, save :: notf = 0 call wall_time(wall) - print *, "cepa0", wall -! provide det_cepa0_active delta_cas lambda_mrcc -! provide mo_bielec_integrals_in_map - allocate(idx_sorted_bit(N_det)) + allocate(idx_sorted_bit(N_det), sortRef(N_int,2,N_det_ref)) sortRef(:,:,:) = det_ref_active(:,:,:) call sort_det(sortRef, sortRefIdx, N_det_ref, N_int) @@ -842,10 +844,10 @@ subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_m integer :: i,j,k,m logical :: is_in_wavefunction integer :: degree(psi_det_size) - integer :: idx(0:psi_det_size) + integer,allocatable :: idx(:) logical :: good - integer(bit_kind), intent(out) :: tq(Nint,2,n_selected) + integer(bit_kind), intent(inout) :: tq(Nint,2,n_selected) !! intent(out) integer, intent(out) :: N_tq integer :: nt,ni @@ -854,7 +856,7 @@ subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_m integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators) integer,intent(in) :: N_miniList - + allocate(idx(0:psi_det_size)) N_tq = 0 i_loop : do i=1,N_selected @@ -897,10 +899,10 @@ subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microl integer :: i,j,k,m logical :: is_in_wavefunction integer :: degree(psi_det_size) - integer :: idx(0:psi_det_size) + integer,allocatable :: idx(:) logical :: good - integer(bit_kind), intent(out) :: tq(Nint,2,n_selected) + integer(bit_kind), intent(inout) :: tq(Nint,2,n_selected) !! intent(out) integer, intent(out) :: N_tq integer :: nt,ni @@ -914,6 +916,7 @@ subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microl integer :: mobiles(2), smallerlist + allocate(idx(0:psi_det_size)) N_tq = 0 i_loop : do i=1,N_selected diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 3491ba7f..08099341 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -42,17 +42,18 @@ subroutine mrsc2_dressing_slave(thread,iproc) integer :: i_state, i, i_I, J, k, k2, k1, kk, ll, degree, degree2, m, l, deg, ni, m2 - integer :: idx(N_det_non_ref, 2), n(2) + integer :: n(2) integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, kn logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al double precision :: diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv(N_states), cj_inv(N_states) - double precision :: contrib, wall, iwall, dleat(N_states,N_det_non_ref,2) + double precision :: contrib, wall, iwall + double precision, allocatable :: dleat(:,:,:) integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp logical, external :: is_in_wavefunction, isInCassd, detEq - integer :: komon(0:N_det_non_ref) + integer,allocatable :: komon(:) logical :: komoned @@ -61,8 +62,8 @@ subroutine mrsc2_dressing_slave(thread,iproc) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) - allocate (delta(N_states,0:N_det_non_ref, 2)) - + allocate (dleat(N_states, N_det_non_ref, 2), delta(N_states,0:N_det_non_ref, 2)) + allocate(komon(0:N_det_non_ref)) do call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) @@ -219,12 +220,14 @@ subroutine push_mrsc2_results(zmq_socket_push, I_i, J, delta, task_id) integer, intent(in) :: i_I, J integer(ZMQ_PTR), intent(in) :: zmq_socket_push - double precision :: delta(N_states, 0:N_det_non_ref, 2) + double precision,intent(inout) :: delta(N_states, 0:N_det_non_ref, 2) integer, intent(in) :: task_id integer :: rc , i_state, i, kk, li - integer :: idx(N_det_non_ref,2), n(2) + integer,allocatable :: idx(:,:) + integer ::n(2) logical :: ok + allocate(idx(N_det_non_ref,2)) rc = f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE) if (rc /= 4) then print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE)' @@ -317,9 +320,9 @@ subroutine pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, task_id) double precision, intent(inout) :: delta(N_states, 0:N_det_non_ref, 2) integer, intent(out) :: task_id integer :: rc , i, kk - integer,intent(out) :: idx(N_det_non_ref, 2) + integer,intent(inout) :: idx(N_det_non_ref,2) logical :: ok - + rc = f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE) if (rc /= 4) then print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE)' @@ -397,7 +400,7 @@ subroutine mrsc2_dressing_collector(delta_ii_,delta_ij_) integer :: task_id, more integer :: I_i, J, l, i_state, n(2), kk - integer :: idx(N_det_non_ref,2) + integer,allocatable :: idx(:,:) delta_ii_(:,:) = 0d0 delta_ij_(:,:,:) = 0d0 @@ -406,10 +409,11 @@ subroutine mrsc2_dressing_collector(delta_ii_,delta_ij_) zmq_socket_pull = new_zmq_pull_socket() allocate ( delta(N_states,0:N_det_non_ref,2) ) - + + allocate(idx(N_det_non_ref,2)) more = 1 do while (more == 1) - + call pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, task_id) @@ -453,8 +457,6 @@ subroutine mrsc2_dressing_collector(delta_ii_,delta_ij_) enddo - print *, "-------------" , delta_ii_(1,:) - print *, "dfdf", delta_ij_(1,10,:) deallocate( delta ) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) diff --git a/src/Determinants/davidson.irp.f b/src/Determinants/davidson.irp.f index c78a3826..3d074563 100644 --- a/src/Determinants/davidson.irp.f +++ b/src/Determinants/davidson.irp.f @@ -241,8 +241,8 @@ subroutine sort_dets_ab(key, idx, shortcut, N_key, Nint) END_DOC integer, intent(in) :: Nint, N_key integer(bit_kind),intent(inout) :: key(Nint,2,N_key) - integer,intent(out) :: idx(N_key) - integer,intent(out) :: shortcut(0:N_key+1) + integer,intent(inout) :: idx(N_key) + integer,intent(inout) :: shortcut(0:N_key+1) integer(bit_kind) :: tmp(Nint, 2) integer :: tmpidx,i,ni From 42dc21372503b96ab0ecd0a2afba8b04cee8aebd Mon Sep 17 00:00:00 2001 From: Yann GARNIRON Date: Fri, 27 May 2016 14:48:27 +0200 Subject: [PATCH 28/42] corrected mrcc for lage systems --- config/ifort.cfg | 2 +- plugins/mrcepa0/dressing.irp.f | 6 ++++-- src/Utils/LinearAlgebra.irp.f | 3 ++- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index acbfde1f..60b771ea 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,7 +31,7 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -C -xAVX -O2 -ip -ftz -g -traceback +FCFLAGS : -xAVX -O2 -ip -ftz -g # Profiling flags ################# diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index d2e88d96..f6a4015d 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -843,7 +843,7 @@ subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_m integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,m logical :: is_in_wavefunction - integer :: degree(psi_det_size) + integer,allocatable :: degree(:) integer,allocatable :: idx(:) logical :: good @@ -856,6 +856,7 @@ subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_m integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators) integer,intent(in) :: N_miniList + allocate(degree(psi_det_size)) allocate(idx(0:psi_det_size)) N_tq = 0 @@ -898,7 +899,7 @@ subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microl integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,m logical :: is_in_wavefunction - integer :: degree(psi_det_size) + integer,allocatable :: degree(:) integer,allocatable :: idx(:) logical :: good @@ -916,6 +917,7 @@ subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microl integer :: mobiles(2), smallerlist + allocate(degree(psi_det_size)) allocate(idx(0:psi_det_size)) N_tq = 0 diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index 13138499..86a58729 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -144,13 +144,14 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) integer, intent(in) :: LDA, ldc, n, m double precision, intent(in) :: overlap(lda,n) double precision, intent(inout) :: C(ldc,n) - double precision :: U(ldc,n) + double precision,allocatable :: U(:,:) double precision :: Vt(lda,n) double precision :: D(n) double precision :: S_half(lda,n) !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D integer :: info, i, j, k + allocate(U(ldc,n)) call svd(overlap,lda,U,ldc,D,Vt,lda,m,n) !$OMP PARALLEL DEFAULT(NONE) & From acc8a8bb7e688ffcb5b2a05c74b0169bd1dad738 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 2 Jun 2016 12:47:35 +0200 Subject: [PATCH 29/42] dirty - corrected mrcepa/mrcc final PT2 --- config/gfortran.cfg | 2 +- plugins/MRCC_Utils/H_apply.irp.f | 6 ++ plugins/MRCC_Utils/mrcc_utils.irp.f | 13 +++- plugins/mrcepa0/mrcepa0_general.irp.f | 92 +++++++++++++++++++++++---- 4 files changed, 96 insertions(+), 17 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index a1940bdb..c0aa875f 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 # 0 : Deactivate # [OPTION] -MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below CACHE : 1 ; Enable cache_compile.py OPENMP : 1 ; Append OpenMP flags diff --git a/plugins/MRCC_Utils/H_apply.irp.f b/plugins/MRCC_Utils/H_apply.irp.f index df2b67a0..57d6d5c1 100644 --- a/plugins/MRCC_Utils/H_apply.irp.f +++ b/plugins/MRCC_Utils/H_apply.irp.f @@ -31,5 +31,11 @@ s.set_perturbation("epstein_nesbet_2x2") s.unset_openmp() print s +s = H_apply_zmq("mrcepa_PT2") +s.energy = "psi_ref_energy_diagonalized" +s.set_perturbation("epstein_nesbet_2x2") +s.unset_openmp() +print s + END_SHELL diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index cfd6481e..e0dcac62 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -73,6 +73,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] +&BEGIN_PROVIDER [ integer, lambda_mrcc_pt3, (0:psi_det_size) ] implicit none BEGIN_DOC ! cm/ or perturbative 1/Delta_E(m) @@ -81,7 +82,7 @@ END_PROVIDER double precision :: ihpsi_current(N_states) integer :: i_pert_count double precision :: hii, lambda_pert - integer :: N_lambda_mrcc_pt2 + integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3 integer :: histo(200), j histo = 0 @@ -92,7 +93,9 @@ END_PROVIDER i_pert_count = 0 lambda_mrcc = 0.d0 N_lambda_mrcc_pt2 = 0 + N_lambda_mrcc_pt3 = 0 lambda_mrcc_pt2(0) = 0 + lambda_mrcc_pt3(0) = 0 do i=1,N_det_non_ref call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& @@ -111,15 +114,21 @@ END_PROVIDER N_lambda_mrcc_pt2 += 1 lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i endif + else + if (lambda_mrcc_pt3(N_lambda_mrcc_pt3) /= i) then + N_lambda_mrcc_pt3 += 1 + lambda_mrcc_pt3(N_lambda_mrcc_pt3) = i + endif endif enddo enddo lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 + lambda_mrcc_pt3(0) = N_lambda_mrcc_pt3 end if print*,'N_det_non_ref = ',N_det_non_ref - print*,'Number of ignored determinants = ',i_pert_count print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) print*,'lambda max = ',maxval(dabs(lambda_mrcc)) + print*,'Number of ignored determinants = ',i_pert_count END_PROVIDER diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 82b1fc9b..0ef4c92b 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -64,8 +64,10 @@ subroutine run_pt2(N_st,energy) double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) integer, intent(in) :: N_st double precision, intent(in) :: energy(N_st) + double precision :: pt3(N_st) allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st)) pt2 = 0.d0 + pt3 = 0d0 !if(lambda_mrcc_pt2(0) == 0) return print*,'Last iteration only to compute the PT2' @@ -85,29 +87,91 @@ subroutine run_pt2(N_st,energy) ! enddo ! SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed - 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 - N_det_cas) + +! +! 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 - N_det_cas) +! do k=1,N_int +! psi_det_generators(k,1,i) = psi_non_ref(k,1,j) +! psi_det_generators(k,2,i) = psi_non_ref(k,2,j) +! enddo +! do k=1,N_st +! psi_coef_generators(i,k) = psi_non_ref_coef(j,k) +! enddo +! enddo +! SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + + N_det_generators = lambda_mrcc_pt3(0) + N_det_ref + N_det_selectors = lambda_mrcc_pt3(0) + N_det_ref + + psi_det_generators(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_selectors(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_coef_generators(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + psi_selectors_coef(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + + do i=N_det_ref+1,N_det_generators + j = lambda_mrcc_pt3(i-N_det_ref) do k=1,N_int psi_det_generators(k,1,i) = psi_non_ref(k,1,j) psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + psi_selectors(k,1,i) = psi_non_ref(k,1,j) + psi_selectors(k,2,i) = psi_non_ref(k,2,j) enddo do k=1,N_st psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + psi_selectors_coef(i,k) = psi_non_ref_coef(j,k) enddo enddo - SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized! psi_coef_energy_diagonalized + call H_apply_mrcepa_PT2(pt2, norm_pert, H_pert_diag, N_st) + + N_det_generators = N_det_non_ref + N_det_ref + N_det_selectors = N_det_non_ref + N_det_ref + + psi_det_generators(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_selectors(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_coef_generators(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + psi_selectors_coef(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + + do i=N_det_ref+1,N_det_generators + j = i-N_det_ref + do k=1,N_int + psi_det_generators(k,1,i) = psi_non_ref(k,1,j) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + psi_selectors(k,1,i) = psi_non_ref(k,1,j) + psi_selectors(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + psi_selectors_coef(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized! psi_coef_energy_diagonalized + call H_apply_mrcepa_PT2(pt3, norm_pert, H_pert_diag, N_st) - call H_apply_mrcc_PT2(pt2, norm_pert, H_pert_diag, N_st) + +!!!!!!!!!!!!!!!! + + + + print *, "2-3 :",pt2, pt3 + print *, lambda_mrcc_pt3(0), N_det, N_det_ref, psi_coef(1,1), psi_ref_coef(1,1) + pt2 = pt2 - pt3 + print *, 'Final step' print *, 'N_det = ', N_det print *, 'N_states = ', N_states From d296285946f762eafe91768d5921f701c78d9ef8 Mon Sep 17 00:00:00 2001 From: Yann GARNIRON Date: Fri, 3 Jun 2016 16:45:11 +0200 Subject: [PATCH 30/42] changes in lambda --- plugins/MRCC_Utils/mrcc_utils.irp.f | 32 +++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index e0dcac62..2c214328 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -16,6 +16,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2_old, (0:psi_det_size) ] +&BEGIN_PROVIDER [ integer, lambda_mrcc_pt3_old, (0:psi_det_size) ] implicit none BEGIN_DOC cm/ or perturbative 1/Delta_E(m) @@ -24,14 +25,21 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] double precision :: ihpsi_current(N_states) integer :: i_pert_count double precision :: hii, lambda_pert - integer :: N_lambda_mrcc_pt2 + integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3 double precision, parameter :: x = 2.d0 - + double precision :: nurm i_pert_count = 0 lambda_mrcc_old = 0.d0 N_lambda_mrcc_pt2 = 0 + N_lambda_mrcc_pt3 = 0 lambda_mrcc_pt2_old(0) = 0 - + lambda_mrcc_pt3_old(0) = 0 + if(N_states > 1) stop "old lambda N_states == 1" + nurm = 0d0 + do i=1,N_det_ref + nurm += psi_ref_coef(i,1)**2 + end do + do i=1,N_det_non_ref call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref, & size(psi_ref_coef,1), N_states,ihpsi_current) @@ -41,18 +49,24 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] ihpsi_current(k) = 1.d-32 endif lambda_mrcc_old(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) - if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 ) then + !if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 .or. lambda_mrcc_old(k,i) > 0d0) then + if ( dabs(ihpsi_current(k))*sqrt(psi_non_ref_coef(i,k)**2 / nurm) < 1.d-5 .or. lambda_mrcc_old(k,i) > 0d0) then i_pert_count += 1 lambda_mrcc_old(k,i) = 0.d0 if (lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) /= i) then - N_lambda_mrcc_pt2 += 1 - lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) = i + N_lambda_mrcc_pt2 += 1 + lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) = i endif + else + if (lambda_mrcc_pt3_old(N_lambda_mrcc_pt3) /= i) then + N_lambda_mrcc_pt3 += 1 + lambda_mrcc_pt3_old(N_lambda_mrcc_pt3) = i + endif + endif ! lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) ! if((ihpsi_current(k) * lambda_pert) < 0.5d0 * psi_non_ref_coef_restart(i,k) ) then ! lambda_mrcc_old(k,i) = 0.d0 ! endif - endif if (lambda_mrcc_old(k,i) > x) then lambda_mrcc_old(k,i) = x @@ -62,6 +76,7 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] enddo enddo lambda_mrcc_pt2_old(0) = N_lambda_mrcc_pt2 + lambda_mrcc_pt3_old(0) = N_lambda_mrcc_pt3 print*,'N_det_non_ref = ',N_det_non_ref print*,'Number of ignored determinants = ',i_pert_count @@ -89,6 +104,7 @@ END_PROVIDER if(old_lambda) then lambda_mrcc = lambda_mrcc_old lambda_mrcc_pt2 = lambda_mrcc_pt2_old + lambda_mrcc_pt3 = lambda_mrcc_pt3_old else i_pert_count = 0 lambda_mrcc = 0.d0 @@ -105,7 +121,7 @@ END_PROVIDER if (ihpsi_current(k) == 0.d0) then ihpsi_current(k) = 1.d-32 endif - lambda_mrcc(k,i) = min(1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) + lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then i_pert_count += 1 From 9b2343087291c2f44120856178084e74a85685f9 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 14 Jun 2016 09:22:32 +0200 Subject: [PATCH 31/42] reactivated microlists --- plugins/mrcepa0/dressing.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index f6a4015d..648d2877 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -28,7 +28,7 @@ use bitmasks call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) if(.not. ok) cycle omask = 0_bit_kind - !if(hh_exists(1, h) /= 0) omask = mask + if(hh_exists(1, h) /= 0) omask = mask n = 1 do p=hh_shortcut(h), hh_shortcut(h+1)-1 call apply_particle(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) From 5db286b027fc96fbafdcf814df15efaaa69ddd97 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 14 Jun 2016 14:37:46 +0200 Subject: [PATCH 32/42] experimental lambda --- plugins/MRCC_Utils/mrcc_utils.irp.f | 175 +++++++++++++++++++++++++++- plugins/mrcepa0/dressing.irp.f | 128 ++++++++++++-------- 2 files changed, 249 insertions(+), 54 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 2c214328..489082eb 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -148,10 +148,44 @@ END_PROVIDER END_PROVIDER - - - - +! BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] +! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] +! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt3, (0:psi_det_size) ] +! implicit none +! BEGIN_DOC +! ! cm/ or perturbative 1/Delta_E(m) +! END_DOC +! integer :: i,ii,k +! double precision :: ihpsi_current(N_states) +! integer :: i_pert_count +! double precision :: hii, lambda_pert, phase +! integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3, degree +! integer :: exc(N_int, 2) +! histo = 0 +! +! i_pert_count = 0 +! lambda_mrcc = 0.d0 +! N_lambda_mrcc_pt2 = 0 +! N_lambda_mrcc_pt3 = 0 +! lambda_mrcc_pt2(0) = 0 +! lambda_mrcc_pt3(0) = 0 +! +! do ii=1, N_det_ref +! do i=1,N_det_non_ref +! call get_excitation(psi_ref(1,1,II), psi_non_ref(1,1,i), exc, degree, phase, N_int) +! if(degree == -1) cycle +! call i_H_j(psi_non_ref(1,1,ii),psi_non_ref(1,1,i),N_int,hii) +! +! +! lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 +! lambda_mrcc_pt3(0) = N_lambda_mrcc_pt3 +! +! print*,'N_det_non_ref = ',N_det_non_ref +! print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) +! print*,'lambda max = ',maxval(dabs(lambda_mrcc)) +! print*,'Number of ignored determinants = ',i_pert_count +! +! END_PROVIDER BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ] @@ -397,6 +431,26 @@ integer function searchDet(dets, det, n, Nint) end function +integer function unsortedSearchDet(dets, det, n, Nint) + implicit none + use bitmasks + + integer(bit_kind),intent(in) :: dets(Nint,2,n), det(Nint,2) + integer, intent(in) :: nint, n + integer :: l, h, c + integer, external :: detCmp + logical, external :: detEq + + do l=1, n + if(detEq(det, dets(1,1,l), N_int)) then + unsortedSearchDet = l + return + end if + end do + unsortedSearchDet = -1 +end function + + integer function searchExc(excs, exc, n) implicit none use bitmasks @@ -617,6 +671,119 @@ END_PROVIDER +BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] + implicit none + logical :: ok + integer :: II, pp, hh, ind, wk + integer, external :: unsortedSearchDet + integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) + double precision, allocatable :: A(:,:) + integer :: N, IPIV(N_det_non_ref), INFO + double precision, allocatable :: WORK(:) + integer, allocatable :: IWORK(:) + + print *, "TI", hh_shortcut(hh_shortcut(0)+1)-1, N_det_non_ref + allocate(A(N_det_non_ref, hh_shortcut(hh_shortcut(0)+1)-1)) + A = 0d0 + do II = 1, N_det_ref + do hh = 1, hh_shortcut(0) + call apply_hole(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) + if(.not. ok) cycle + do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 + call apply_particle(myMask, pp_exists(1, pp), myDet, ok, N_int) + if(.not. ok) cycle + ind = unsortedSearchDet(psi_non_ref(1,1,1), myDet, N_det_non_ref, N_int) + if(ind /= -1) then + A(ind, pp) += psi_ref_coef(II, 1) + end if + end do + end do + end do + + double precision :: B(N_det_non_ref), S(N_det_non_ref) + integer :: rank + B = psi_non_ref_coef(:,1) + allocate(WORK(1), IWORK(1)) + call DGELSD(N_det_non_ref, & + hh_shortcut(hh_shortcut(0)+1)-1, & + 1, & + A, N_det_non_ref, & + B, N_det_non_ref, & + S, & + 1d-6, & + rank, & + WORK, -1, & + IWORK, & + INFO ) + wk = int(work(1)) + print *, "WORK:", wk + deallocate(WORK, IWORK) + allocate(WORK(wk), IWORK(wk)) + call DGELSD(N_det_non_ref, & + hh_shortcut(hh_shortcut(0)+1)-1, & + 1, & + A, N_det_non_ref, & + B, N_det_non_ref, & + S, & + 1d-6, & + rank, & + WORK, size(WORK), & + IWORK, & + INFO ) + print *, INFO, size(dIj), size(B) + dIj(:size(dIj)) = B(:size(dIj)) + print *, "diden" +END_PROVIDER + + +double precision function get_dij(det1, det2, Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) + integer :: degree, f, exc(0:2, 2, 2), t + integer*2 :: h1, h2, p1, p2, s1, s2 + integer, external :: searchExc + logical, external :: excEq + double precision :: phase + + get_dij = 0d0 + call get_excitation(det1, det2, exc, degree, phase, Nint) + if(degree == -1) return + if(degree == 0) then + stop "get_dij" + end if + + call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) + + if(degree == 1) then + h2 = h1 + p2 = p1 + s2 = s1 + h1 = 0 + p1 = 0 + s1 = 0 + end if + + if(h1 + (s1-1)*mo_tot_num < h2 + (s2-1)*mo_tot_num) then + f = searchExc(hh_exists(1,1), (/s1, h1, s2, h2/), hh_shortcut(0)) + else + f = searchExc(hh_exists(1,1), (/s2, h2, s1, h1/), hh_shortcut(0)) + end if + if(f == -1) return + + if(p1 + (s1-1)*mo_tot_num < p2 + (s2-1)*mo_tot_num) then + t = searchExc(pp_exists(1,hh_shortcut(f)), (/s1, p1, s2, p2/), hh_shortcut(f+1)-hh_shortcut(f)) + else + t = searchExc(pp_exists(1,hh_shortcut(f)), (/s2, p2, s1, p1/), hh_shortcut(f+1)-hh_shortcut(f)) + end if + + if(t /= -1) then + get_dij = dIj(t - 1 + hh_shortcut(f)) + end if +end function + + BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ] &BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ] &BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ] diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 648d2877..931d9db3 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -476,58 +476,89 @@ END_PROVIDER END_PROVIDER +! BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] +! use bitmasks +! implicit none +! integer :: i,j,k +! double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall +! integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) +! +! ! provide lambda_mrcc +! npres = 0 +! delta_cas = 0d0 +! call wall_time(wall) +! print *, "dcas ", wall +! do i_state = 1, N_states +! !!$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) +! do k=1,N_det_non_ref +! if(lambda_mrcc(i_state, k) == 0d0) cycle +! npre = 0 +! do i=1,N_det_ref +! call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) +! if(Hki /= 0d0) then +! !!$OMP ATOMIC +! npres(i) += 1 +! npre += 1 +! ipre(npre) = i +! pre(npre) = Hki +! end if +! end do +! +! +! do i=1,npre +! do j=1,i +! !!$OMP ATOMIC +! delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) +! end do +! end do +! end do +! !!$OMP END PARALLEL DO +! npre=0 +! do i=1,N_det_ref +! npre += npres(i) +! end do +! !stop +! do i=1,N_det_ref +! do j=1,i +! delta_cas(j,i,i_state) = delta_cas(i,j,i_state) +! end do +! end do +! end do +! +! call wall_time(wall) +! print *, "dcas", wall +! ! stop +! END_PROVIDER + + BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] use bitmasks implicit none integer :: i,j,k - double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall - integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) + double precision :: Hjk, Hki, Hij + double precision, external :: get_dij + integer i_state, degree -! provide lambda_mrcc - npres = 0 - delta_cas = 0d0 - call wall_time(wall) - print *, "dcas ", wall + provide lambda_mrcc do i_state = 1, N_states - !!$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) - do k=1,N_det_non_ref - if(lambda_mrcc(i_state, k) == 0d0) cycle - npre = 0 - do i=1,N_det_ref - call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) - if(Hki /= 0d0) then - !!$OMP ATOMIC - npres(i) += 1 - npre += 1 - ipre(npre) = i - pre(npre) = Hki - end if - end do - - - do i=1,npre + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + do i=1,N_det_ref do j=1,i - !!$OMP ATOMIC - delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) - end do - end do - end do - !!$OMP END PARALLEL DO - npre=0 - do i=1,N_det_ref - npre += npres(i) - end do - !stop - do i=1,N_det_ref - do j=1,i + call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) + delta_cas(i,j,i_state) = 0d0 + do k=1,N_det_non_ref + + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) + call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) + + delta_cas(i,j,i_state) += Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int) ! * Hki * lambda_mrcc(i_state, k) + !print *, Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int), Hki * get_dij(psi_ref(1,1,j), psi_non_ref(1,1,k), N_int) + end do delta_cas(j,i,i_state) = delta_cas(i,j,i_state) + end do end do - end do + !$OMP END PARALLEL DO end do - - call wall_time(wall) - print *, "dcas", wall -! stop END_PROVIDER @@ -618,7 +649,7 @@ end function integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit, searchDet logical, external :: is_in_wavefunction, detEq - + double precision, external :: get_dij integer :: II, blok integer*8, save :: notf = 0 @@ -659,7 +690,7 @@ end function kloop: do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 !i - if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle + !if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle do ni=1,N_int if(iand(made_hole(ni,1), det_cepa0_active(ni,1,k)) /= 0) cycle kloop @@ -681,13 +712,10 @@ end function j = sortRefIdx(j) !$OMP ATOMIC notf = notf+1 - !if(i/=k .and. dabs(psi_non_ref_coef(det_cepa0_idx(i),i_state)) < dabs(psi_non_ref_coef(det_cepa0_idx(k),i_state))) cycle -! if(dabs(lambda_mrcc(i_state,det_cepa0_idx(i))) > dabs(lambda_mrcc(i_state,det_cepa0_idx(k)))) cycle -! if(dabs(lambda_mrcc(i_state,det_cepa0_idx(i))) == dabs(lambda_mrcc(i_state,det_cepa0_idx(k))) .and. i < k) cycle - !if(.not. j==II .and. dabs(psi_ref_coef(II,i_state)) < dabs(psi_ref_coef(j,i_state))) cycle - + call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) - contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + !contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) + contrib = delta_cas(II, J, i_state) * get_dij(psi_ref(1,1,J), psi_non_ref(1,1,det_cepa0_idx(k)), N_int) !$OMP ATOMIC delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib From 8be7b966335fb78e4c858307d13ada9680197454 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 14 Jun 2016 15:26:50 +0200 Subject: [PATCH 33/42] experimental lambda mrcc --- plugins/mrcepa0/dressing.irp.f | 46 +++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 931d9db3..76ac59c3 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -86,7 +86,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist logical, external :: detEq, is_generable - + double precision, external :: get_dij leng = max(N_det_generators, N_det_non_ref) allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref)) @@ -202,16 +202,16 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe ! Loop if lambda == 0 logical :: loop - loop = .True. - do i_state=1,N_states - if (lambda_mrcc(i_state,idx_alpha(k_sd)) /= 0.d0) then - loop = .False. - exit - endif - enddo - if (loop) then - cycle - endif +! loop = .True. +! do i_state=1,N_states +! if (lambda_mrcc(i_state,idx_alpha(k_sd)) /= 0.d0) then +! loop = .False. +! exit +! endif +! enddo +! if (loop) then +! cycle +! endif call get_excitation_degree(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),degree,Nint) if (degree > 2) then @@ -222,9 +222,14 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe ! hIk = hij_mrcc(idx_alpha(k_sd),i_I) ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),Nint,hIk) + + do i_state=1,N_states - dIk(i_state) = hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) + dIk(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(k_sd)), N_int) !!hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) enddo + + + ! |l> = Exc(k -> alpha) |I> call get_excitation(psi_non_ref(1,1,idx_alpha(k_sd)),tq(1,1,i_alpha),exc,degree,phase,Nint) call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) @@ -246,19 +251,20 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) if (degree == 0) then - loop = .True. - do i_state=1,N_states - if (lambda_mrcc(i_state,idx_alpha(l_sd)) /= 0.d0) then - loop = .False. - exit - endif - enddo +! loop = .True. +! do i_state=1,N_states +! if (lambda_mrcc(i_state,idx_alpha(l_sd)) /= 0.d0) then +! loop = .False. +! exit +! endif +! enddo + loop = .false. if (.not.loop) then call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),exc,degree,phase2,Nint) hIl = hij_mrcc(idx_alpha(l_sd),i_I) ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hIl) do i_state=1,N_states - dka(i_state) = hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 + dka(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(l_sd)), N_int) * phase * phase2 !hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 enddo endif From 79cbe7b7f1563fde45fbd51aeedd7aa35cecb907 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 15 Jun 2016 10:07:00 +0200 Subject: [PATCH 34/42] slow but working experimental lambda --- config/ifort.cfg | 4 ++-- plugins/mrcepa0/dressing.irp.f | 4 ++-- plugins/mrcepa0/dressing_slave.irp.f | 35 +++++++++++++--------------- 3 files changed, 20 insertions(+), 23 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index 60b771ea..03199923 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,14 +31,14 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -xAVX -O2 -ip -ftz -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -xAVX -O2 -ip -ftz +FCFLAGS : -xSSE4.2 -O2 -ip -ftz # Debugging flags ################# diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 76ac59c3..f289fec0 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -15,7 +15,7 @@ use bitmasks delta_ij_mrcc = 0d0 delta_ii_mrcc = 0d0 i_state = 1 - provide hh_shortcut psi_det_size lambda_mrcc + provide hh_shortcut psi_det_size! lambda_mrcc !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc) & @@ -545,7 +545,7 @@ END_PROVIDER double precision, external :: get_dij integer i_state, degree - provide lambda_mrcc + !provide lambda_mrcc do i_state = 1, N_states !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do i=1,N_det_ref diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 08099341..7d64aa5e 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -55,7 +55,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) logical, external :: is_in_wavefunction, isInCassd, detEq integer,allocatable :: komon(:) logical :: komoned - + double precision, external :: get_dij zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_push = new_zmq_push_socket(thread) @@ -124,14 +124,14 @@ subroutine mrsc2_dressing_slave(thread,iproc) if(h_(J,i) == 0.d0) cycle if(h_(i_I,i) == 0.d0) cycle - ok = .false. - do i_state=1, N_states - if(lambda_mrcc(i_state, i) /= 0d0) then - ok = .true. - exit - end if - end do - if(.not. ok) cycle + !ok = .false. + !do i_state=1, N_states + ! if(lambda_mrcc(i_state, i) /= 0d0) then + ! ok = .true. + ! exit + ! end if + !end do + !if(.not. ok) cycle ! komon(0) += 1 @@ -144,7 +144,8 @@ subroutine mrsc2_dressing_slave(thread,iproc) ! if(I_i == J) phase_Ii = phase_Ji do i_state = 1,N_states - dkI = h_(J,i) * h_(i_I,i) * lambda_mrcc(i_state, i) + dkI = h_(J,i) * get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,i), N_int) + !dkI = h_(J,i) * h_(i_I,i) * lambda_mrcc(i_state, i) dleat(i_state, kn, 1) = dkI dleat(i_state, kn, 2) = dkI end do @@ -169,24 +170,20 @@ subroutine mrsc2_dressing_slave(thread,iproc) !if(isInCassd(det_tmp, N_int)) cycle do i_state = 1, N_states - if(lambda_mrcc(i_state, i) == 0d0) cycle + !if(lambda_mrcc(i_state, i) == 0d0) cycle -! call get_excitation(det_tmp,psi_non_ref(1,1,l),exc_IJ,degree2,phase_al,N_int) - contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al -! if(l /= det_cepa0_idx(linked(ll, J))) stop "SPTPqsdT" + !contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al + contrib = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,k), N_int) * dleat(i_state, m, 2) delta(i_state,ll,1) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then delta(i_state,0,1) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) endif if(I_i == J) cycle -! call get_excitation(det_tmp,psi_non_ref(1,1,k),exc_IJ,degree2,phase_al,N_int) -! cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) - contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al -! if(k /= linked(kk, I_i)) stop "SPTPT" + !contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al + contrib = get_dij(psi_ref(1,1,J), psi_non_ref(1,1,l), N_int) * dleat(i_state, m, 1) delta(i_state,kk,2) += contrib - !delta(i_state,det_cepa0_idx(k),2) += contrib if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then delta(i_state,0,2) -= contrib * cj_inv(i_state) * psi_non_ref_coef(k,i_state) end if From d55b0a0b5e20dffeae3bb8749e1b47c05789445a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 16 Jun 2016 11:58:59 +0200 Subject: [PATCH 35/42] lambda using matrix products --- plugins/MRCC_Utils/mrcc_utils.irp.f | 71 ++++++++++++++--------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 489082eb..f576a346 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -674,7 +674,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] implicit none logical :: ok - integer :: II, pp, hh, ind, wk + integer :: i, j, k, II, pp, hh, ind, wk, nex integer, external :: unsortedSearchDet integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) double precision, allocatable :: A(:,:) @@ -682,8 +682,9 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] double precision, allocatable :: WORK(:) integer, allocatable :: IWORK(:) - print *, "TI", hh_shortcut(hh_shortcut(0)+1)-1, N_det_non_ref - allocate(A(N_det_non_ref, hh_shortcut(hh_shortcut(0)+1)-1)) + nex = hh_shortcut(hh_shortcut(0)+1)-1 + print *, "TI", nex, N_det_non_ref + allocate(A(N_det_non_ref, nex)) A = 0d0 do II = 1, N_det_ref do hh = 1, hh_shortcut(0) @@ -700,39 +701,37 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do end do - double precision :: B(N_det_non_ref), S(N_det_non_ref) - integer :: rank - B = psi_non_ref_coef(:,1) - allocate(WORK(1), IWORK(1)) - call DGELSD(N_det_non_ref, & - hh_shortcut(hh_shortcut(0)+1)-1, & - 1, & - A, N_det_non_ref, & - B, N_det_non_ref, & - S, & - 1d-6, & - rank, & - WORK, -1, & - IWORK, & - INFO ) - wk = int(work(1)) - print *, "WORK:", wk - deallocate(WORK, IWORK) - allocate(WORK(wk), IWORK(wk)) - call DGELSD(N_det_non_ref, & - hh_shortcut(hh_shortcut(0)+1)-1, & - 1, & - A, N_det_non_ref, & - B, N_det_non_ref, & - S, & - 1d-6, & - rank, & - WORK, size(WORK), & - IWORK, & - INFO ) - print *, INFO, size(dIj), size(B) - dIj(:size(dIj)) = B(:size(dIj)) - print *, "diden" + double precision, allocatable :: IAtA(:,:), AtB(:), X(:), X_new(:) + double precision :: norm + allocate(IAtA(nex, nex), AtB(nex), X(nex), X_new(nex)) + print *, "allocated", size(IAtA, 1), size(A, 2) + !IAtA = -matmul(transpose(A), A) + + IAtA = 0.d0 + do i=1, size(A,2) + IAtA(i,i) = 1d0 + end do + call dgemm('T','N',nex,nex,N_det_non_ref,1.d0,A,size(A,1),A,size(A,1),-1.d0,IAtA,size(IAtA,1)) + IaTa = -IATa + + call dgemv('T',N_det_non_ref,nex,1.d0,A,size(A,1),psi_non_ref_coef(1,1),1,0.d0,AtB,1) + + !AtB = matmul(transpose(A), psi_non_ref_coef(:,1)) + + X = AtB + do k=1, 1000 + !X_new = matmul(IAtA, X) + AtB + x_new = AtB + call dgemv('N',nex,nex,1.d0,IAtA,size(IAtA,1),X,1,1.d0,x_new,1) + norm = 0d0 + do j=1, size(X) + norm += (X_new(j) - X(j))**2 + X(j) = X_new(j) + end do + print *, "resudu ", norm + end do + dIj = X + print *, "done" END_PROVIDER From 0e18a2790b9432531a93d37972e24cb5054c9f9d Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 20 Jun 2016 10:52:54 +0200 Subject: [PATCH 36/42] parallel AtA*X --- config/ifort.cfg | 2 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 213 +++++++++++++++++++++++----- plugins/mrcepa0/dressing.irp.f | 6 +- 3 files changed, 180 insertions(+), 41 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index 03199923..47a654c3 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -6,7 +6,7 @@ # --align=32 : Align all provided arrays on a 32-byte boundary # [COMMON] -FC : ifort +FC : ifort -g LAPACK_LIB : -mkl=parallel IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index f576a346..c4bfcbc2 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -1,3 +1,4 @@ +use bitmasks BEGIN_PROVIDER [ integer, mrmode ] &BEGIN_PROVIDER [ logical, old_lambda ] @@ -671,66 +672,202 @@ END_PROVIDER + BEGIN_PROVIDER [ integer(bit_kind), psi_non_ref_sorted, (N_int, 2, N_det_non_ref) ] +&BEGIN_PROVIDER [ integer, psi_non_ref_sorted_idx, (N_det_non_ref) ] + implicit none + psi_non_ref_sorted = psi_non_ref + call sort_det(psi_non_ref_sorted, psi_non_ref_sorted_idx, N_det_non_ref, N_int) +END_PROVIDER + + BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] implicit none logical :: ok - integer :: i, j, k, II, pp, hh, ind, wk, nex - integer, external :: unsortedSearchDet + integer :: i, j, k, II, pp, hh, ind, wk, nex, a_col, at_row + integer, external :: searchDet, unsortedSearchDet integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) - double precision, allocatable :: A(:,:) - integer :: N, IPIV(N_det_non_ref), INFO - double precision, allocatable :: WORK(:) - integer, allocatable :: IWORK(:) + integer :: N, INFO, AtA_size, r1, r2 + double precision , allocatable:: AtB(:), AtA_val(:), A_dense(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:) + double precision :: t, norm, cx + integer, allocatable :: A_ind(:,:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:) + nex = hh_shortcut(hh_shortcut(0)+1)-1 print *, "TI", nex, N_det_non_ref - allocate(A(N_det_non_ref, nex)) - A = 0d0 - do II = 1, N_det_ref - do hh = 1, hh_shortcut(0) - call apply_hole(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) - if(.not. ok) cycle - do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 + allocate(A_ind(N_det_ref+1, nex), A_val(N_det_ref+1, nex)) + allocate(AtA_ind(N_det_ref * nex), AtA_val(N_det_ref * nex)) !!!!! MAY BE TOO SMALL !!!!!!!! + allocate(x(nex), AtB(nex), A_dense(N_det_non_ref)) + allocate(A_val_mwen(nex), A_ind_mwen(nex)) + allocate(N_col(nex), col_shortcut(nex)) + A_val = 0d0 + A_ind = 0 + !$OMP PARALLEL DO schedule(static,10) default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind) & + !$OMP shared(hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref) & + !$OMP private(pp, II, ok, myMask, myDet, ind, wk) + do hh = 1, hh_shortcut(0) + !print *, hh, "/", hh_shortcut(0) + do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 + wk = 0 + do II = 1, N_det_ref + call apply_hole(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) + if(.not. ok) cycle call apply_particle(myMask, pp_exists(1, pp), myDet, ok, N_int) if(.not. ok) cycle - ind = unsortedSearchDet(psi_non_ref(1,1,1), myDet, N_det_non_ref, N_int) + !ind = unsortedSearchDet(psi_non_ref(1,1,1), myDet, N_det_non_ref, N_int) + ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int) if(ind /= -1) then - A(ind, pp) += psi_ref_coef(II, 1) + wk = wk+1 + A_val(wk, pp) = psi_ref_coef(II, 1) + A_ind(wk, pp) = psi_non_ref_sorted_idx(ind) end if end do end do end do - - double precision, allocatable :: IAtA(:,:), AtB(:), X(:), X_new(:) - double precision :: norm - allocate(IAtA(nex, nex), AtB(nex), X(nex), X_new(nex)) - print *, "allocated", size(IAtA, 1), size(A, 2) - !IAtA = -matmul(transpose(A), A) - - IAtA = 0.d0 - do i=1, size(A,2) - IAtA(i,i) = 1d0 + !$OMP END PARALLEL DO + + A_dense = 0d0 + AtB = 0d0 + AtA_size = 0 + wk = 0 + col_shortcut = 0 + N_col = 0 + !$OMP PARALLEL DO schedule(dynamic, 100) default(none) shared(k, psi_non_ref_coef, A_ind, A_val, x, N_det_ref, nex, N_det_non_ref) & + !$OMP private(at_row, a_col, t, i, r1, r2, wk, A_ind_mwen, A_val_mwen) & + !$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind) + do at_row = 1, nex + wk = 0 + if(mod(at_row, 1000) == 0) print *, "AtA", at_row, "/", nex + !A_dense = 0d0 + do i=1,N_det_ref + if(A_ind(i, at_row) == 0) exit + AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) + end do + do a_col = 1, nex + t = 0d0 + r1 = 1 + r2 = 1 + do while(A_ind(r1, at_row) * A_ind(r2, a_col) /= 0) + if(A_ind(r1, at_row) < A_ind(r2, a_col)) then + r1 += 1 + else if(A_ind(r1, at_row) > A_ind(r2, a_col)) then + r2 += 1 + else + t = t - A_val(r1, at_row) * A_val(r2, a_col) + r1 += 1 + r2 += 1 + end if + end do + + if(a_col == at_row) t = (t + 1d0)! / 2d0 + if(t /= 0d0) then + wk += 1 + !AtA_ind(1, wk) = at_row + !AtA_ind(2, wk) = a_col + A_ind_mwen(wk) = a_col + !AtA_val(wk) = t + A_val_mwen(wk) = t + end if + end do + + if(wk /= 0) then + !$OMP CRITICAL + col_shortcut(at_row) = AtA_size+1 + N_col(at_row) = wk + AtA_ind(AtA_size+1:AtA_size+wk) = A_ind_mwen(:wk) + AtA_val(AtA_size+1:AtA_size+wk) = A_val_mwen(:wk) + AtA_size += wk + !$OMP END CRITICAL + end if end do - call dgemm('T','N',nex,nex,N_det_non_ref,1.d0,A,size(A,1),A,size(A,1),-1.d0,IAtA,size(IAtA,1)) - IaTa = -IATa + + x = AtB + if(AtA_size > size(AtA_val)) stop "SIZA" + print *, "ATA SIZE", ata_size + allocate (x_new(nex)) + integer :: iproc, omp_get_thread_num + iproc = omp_get_thread_num() + do i=1,nex + x_new(i) = 0.D0 + enddo - call dgemv('T',N_det_non_ref,nex,1.d0,A,size(A,1),psi_non_ref_coef(1,1),1,0.d0,AtB,1) + do k=0,100000 + !$OMP PARALLEL DO default(shared) + do i=1,nex + x_new(i) = AtB(i) + enddo + !$OMP PARALLEL DO default(shared) private(cx, i) + do a_col = 1, nex + cx = 0d0 + do i=col_shortcut(a_col), col_shortcut(a_col) + N_col(a_col) - 1 + cx += x(AtA_ind(i)) * AtA_val(i) + end do + x_new(a_col) += cx + end do + !$OMP END PARALLEL DO - !AtB = matmul(transpose(A), psi_non_ref_coef(:,1)) - - X = AtB - do k=1, 1000 - !X_new = matmul(IAtA, X) + AtB - x_new = AtB - call dgemv('N',nex,nex,1.d0,IAtA,size(IAtA,1),X,1,1.d0,x_new,1) norm = 0d0 + do j=1, size(X) norm += (X_new(j) - X(j))**2 - X(j) = X_new(j) + x(j) = x_new(j) end do - print *, "resudu ", norm + + if(mod(k, 1000) == 0) print *, "residu ", k, norm + if(norm < 1d-9) exit end do - dIj = X + print *, "CONVERGENCE : ", norm + + +!do k=0,500 +! if(k == 1) print *, X(:10) +! x_new = 0d0 +! A_dense = 0d0 +! !!$OMP PARALLEL DO schedule(dynamic, 10) default(none) shared(k, psi_non_ref_coef, x_new, A_ind, A_val, x, N_det_ref, nex, N_det_non_ref) & +! !!$OMP private(a_col, t, i, cx) & +! !!$OMP firstprivate(A_dense) +! do at_row = 1, nex +! ! ! d DIR$ IVDEP +! cx = 0d0 +! do i=1,N_det_ref +! if(A_ind(i, at_row) == 0) exit +! if(k /= 0) A_dense(A_ind(i, at_row)) = A_val(i, at_row) +! cx = cx + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) +! !x_new(at_row) = x_new(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) +! end do +! if(k == 0) then +! x_new(at_row) = cx +! cycle +! end if +! do a_col = 1, nex +! t = 0d0 +! do i = 1, N_det_ref +! if(A_ind(i, a_col) == 0) exit +! t = t - A_val(i, a_col) * A_dense(A_ind(i, a_col)) ! -= pcq I-A +! end do +! if(a_col == at_row) t = t + 1d0 +! cx = cx + t * x(a_col) +! !x_new(at_row) = x_new(at_row) + t * x(a_col) +! end do +! x_new(at_row) = cx +! do i=1,N_det_ref +! if(A_ind(i, at_row) == 0) exit +! A_dense(A_ind(i, at_row)) = 0d0 +! end do +! end do +! !!$OMP END PARALLEL DO + +! norm = 0d0 +! do j=1, size(X) +! norm += (X_new(j) - X(j))**2 +! X(j) = X_new(j) +! end do +! print *, "residu ", k, norm +! if(norm < 1d-10) exit +!end do +! + + dIj(:size(X)) = X(:) + !print *, X print *, "done" END_PROVIDER diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index f289fec0..74a572f5 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -544,8 +544,8 @@ END_PROVIDER double precision :: Hjk, Hki, Hij double precision, external :: get_dij integer i_state, degree - - !provide lambda_mrcc + + provide lambda_mrcc dIj do i_state = 1, N_states !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) do i=1,N_det_ref @@ -670,6 +670,8 @@ end function idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo + ! To provide everything + contrib = get_dij(psi_ref(1,1,1), psi_non_ref(1,1,1), N_int) do i_state = 1, N_states delta_mrcepa0_ii(:,:) = 0d0 From c7f96406b33609711f5aa4bacc2417998d899b78 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 20 Jun 2016 14:09:40 +0200 Subject: [PATCH 37/42] bug in dIj - unsorted index --- plugins/MRCC_Utils/mrcc_utils.irp.f | 36 ++++++++++++++++++----------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index c4bfcbc2..ef3d02cb 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -687,27 +687,28 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] integer, external :: searchDet, unsortedSearchDet integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) integer :: N, INFO, AtA_size, r1, r2 - double precision , allocatable:: AtB(:), AtA_val(:), A_dense(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:) + double precision , allocatable:: AtB(:), AtA_val(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:) double precision :: t, norm, cx - integer, allocatable :: A_ind(:,:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:) + integer, allocatable :: A_ind(:,:), lref(:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:) nex = hh_shortcut(hh_shortcut(0)+1)-1 print *, "TI", nex, N_det_non_ref allocate(A_ind(N_det_ref+1, nex), A_val(N_det_ref+1, nex)) allocate(AtA_ind(N_det_ref * nex), AtA_val(N_det_ref * nex)) !!!!! MAY BE TOO SMALL !!!!!!!! - allocate(x(nex), AtB(nex), A_dense(N_det_non_ref)) + allocate(x(nex), AtB(nex)) allocate(A_val_mwen(nex), A_ind_mwen(nex)) allocate(N_col(nex), col_shortcut(nex)) A_val = 0d0 A_ind = 0 !$OMP PARALLEL DO schedule(static,10) default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind) & !$OMP shared(hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref) & - !$OMP private(pp, II, ok, myMask, myDet, ind, wk) + !$OMP private(lref, pp, II, ok, myMask, myDet, ind, wk) do hh = 1, hh_shortcut(0) !print *, hh, "/", hh_shortcut(0) do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 - wk = 0 + allocate(lref(N_det_non_ref)) + lref = 0 do II = 1, N_det_ref call apply_hole(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) if(.not. ok) cycle @@ -716,16 +717,25 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] !ind = unsortedSearchDet(psi_non_ref(1,1,1), myDet, N_det_non_ref, N_int) ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int) if(ind /= -1) then - wk = wk+1 - A_val(wk, pp) = psi_ref_coef(II, 1) - A_ind(wk, pp) = psi_non_ref_sorted_idx(ind) + !iwk = wk+1 + !A_val(wk, pp) = psi_ref_coef(II, 1) + !A_ind(wk, pp) = psi_non_ref_sorted_idx(ind) + lref(psi_non_ref_sorted_idx(ind)) = II end if end do + wk = 0 + do i=1, N_det_non_ref + if(lref(i) /= 0) then + wk += 1 + A_val(wk, pp) = psi_ref_coef(lref(i), 1) + A_ind(wk, pp) = i + end if + end do + deallocate(lref) end do end do !$OMP END PARALLEL DO - A_dense = 0d0 AtB = 0d0 AtA_size = 0 wk = 0 @@ -737,7 +747,6 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] do at_row = 1, nex wk = 0 if(mod(at_row, 1000) == 0) print *, "AtA", at_row, "/", nex - !A_dense = 0d0 do i=1,N_det_ref if(A_ind(i, at_row) == 0) exit AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) @@ -791,11 +800,12 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] enddo do k=0,100000 - !$OMP PARALLEL DO default(shared) + ! df $ fg OMP PARALLEL DO default(shared) do i=1,nex x_new(i) = AtB(i) enddo - !$OMP PARALLEL DO default(shared) private(cx, i) + + ! sdf $OMP PARALLEL DO default(shared) private(cx, i) do a_col = 1, nex cx = 0d0 do i=col_shortcut(a_col), col_shortcut(a_col) + N_col(a_col) - 1 @@ -803,7 +813,7 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do x_new(a_col) += cx end do - !$OMP END PARALLEL DO + ! sdf $OMP END PARALLEL DO norm = 0d0 From df83a33cac9e5bbcf1d9d6d54b9e644c3f63f069 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 20 Jun 2016 15:02:47 +0200 Subject: [PATCH 38/42] renormalize x_new --- plugins/MRCC_Utils/mrcc_utils.irp.f | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index ef3d02cb..bf5b7694 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -767,7 +767,10 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end if end do - if(a_col == at_row) t = (t + 1d0)! / 2d0 + if(a_col == at_row) then + t = (t + 1d0)! / 2d0 + !print *, a_col, t-1d0 + end if if(t /= 0d0) then wk += 1 !AtA_ind(1, wk) = at_row @@ -814,16 +817,29 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] x_new(a_col) += cx end do ! sdf $OMP END PARALLEL DO + double precision :: norm_cas + norm_cas = 0d0 + do i = 1, N_det_ref + norm_cas += psi_ref_coef(i,1)**2 + end do norm = 0d0 + t = 0d0 + do j=1, size(X) + t = t + X_new(j) * X_new(j) + end do + + x_new = x_new / sqrt(norm_cas + t) + do j=1, size(X) norm += (X_new(j) - X(j))**2 x(j) = x_new(j) end do - + !print *, "NORM X_new", t + if(mod(k, 1000) == 0) print *, "residu ", k, norm - if(norm < 1d-9) exit + if(norm < 1d-16) exit end do print *, "CONVERGENCE : ", norm From e319cb7f1d4f7761fa223988971983a362018b96 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 6 Jul 2016 11:28:52 +0200 Subject: [PATCH 39/42] ref-dependent amplitudes --- plugins/MRCC_Utils/mrcc_utils.irp.f | 59 +++++++++++++++++++++++------ plugins/mrcepa0/dressing.irp.f | 10 +++-- 2 files changed, 54 insertions(+), 15 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index bf5b7694..513e7d09 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -687,18 +687,19 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] integer, external :: searchDet, unsortedSearchDet integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) integer :: N, INFO, AtA_size, r1, r2 - double precision , allocatable:: AtB(:), AtA_val(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:) + double precision , allocatable:: B(:), AtB(:), AtA_val(:), A_val(:,:), x(:), x_new(:), A_val_mwen(:) double precision :: t, norm, cx integer, allocatable :: A_ind(:,:), lref(:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:) - + if(n_states /= 1) stop "n_states /= 1" + nex = hh_shortcut(hh_shortcut(0)+1)-1 print *, "TI", nex, N_det_non_ref allocate(A_ind(N_det_ref+1, nex), A_val(N_det_ref+1, nex)) allocate(AtA_ind(N_det_ref * nex), AtA_val(N_det_ref * nex)) !!!!! MAY BE TOO SMALL !!!!!!!! allocate(x(nex), AtB(nex)) allocate(A_val_mwen(nex), A_ind_mwen(nex)) - allocate(N_col(nex), col_shortcut(nex)) + allocate(N_col(nex), col_shortcut(nex), B(N_det_non_ref)) A_val = 0d0 A_ind = 0 !$OMP PARALLEL DO schedule(static,10) default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind) & @@ -746,7 +747,7 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] !$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind) do at_row = 1, nex wk = 0 - if(mod(at_row, 1000) == 0) print *, "AtA", at_row, "/", nex + if(mod(at_row, 10000) == 0) print *, "AtA", at_row, "/", nex do i=1,N_det_ref if(A_ind(i, at_row) == 0) exit AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) @@ -803,12 +804,12 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] enddo do k=0,100000 - ! df $ fg OMP PARALLEL DO default(shared) + !$OMP PARALLEL DO default(shared) do i=1,nex x_new(i) = AtB(i) enddo - ! sdf $OMP PARALLEL DO default(shared) private(cx, i) + !$OMP PARALLEL DO default(shared) private(cx, i) do a_col = 1, nex cx = 0d0 do i=col_shortcut(a_col), col_shortcut(a_col) + N_col(a_col) - 1 @@ -816,13 +817,13 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do x_new(a_col) += cx end do - ! sdf $OMP END PARALLEL DO + !$OMP END PARALLEL DO double precision :: norm_cas norm_cas = 0d0 do i = 1, N_det_ref norm_cas += psi_ref_coef(i,1)**2 end do - + norm = 0d0 t = 0d0 @@ -830,15 +831,37 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] t = t + X_new(j) * X_new(j) end do - x_new = x_new / sqrt(norm_cas + t) - + !t = (1d0 - norm_cas) / t + !x_new = x_new * sqrt(t) + !!!!!!!!!!!!!! + !B = 0d0 + !do i=1, nex + ! do j=1, N_det_ref + ! if(A_ind(j, i) == 0) exit + ! B(A_ind(j, i)) += A_val(j, i) * x(i) + ! end do + !end do + !t = 0d0 + !do i=1, size(B) + ! t += B(i)**2 + !end do + !print *, "NORMT", sqrt(t + norm_cas) + !x_new = x_new / sqrt(t + norm_cas) +!!!!!!!!!! + + t = (1d0 / norm_cas - 1d0) / t + x_new = x_new * sqrt(t) + do j=1, size(X) norm += (X_new(j) - X(j))**2 x(j) = x_new(j) end do - !print *, "NORM X_new", t - if(mod(k, 1000) == 0) print *, "residu ", k, norm + + if(mod(k, 50) == 0) then + print *, "residu ", k, norm, "norm t", sqrt(t) + end if + if(norm < 1d-16) exit end do print *, "CONVERGENCE : ", norm @@ -898,6 +921,18 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] END_PROVIDER +double precision function get_dij_index(II, i, Nint) + integer, intent(in) :: II, i, Nint + double precision, external :: get_dij + + if(dabs(psi_ref_coef(II, 1)) > 1d-1) then + get_dij_index = psi_non_ref_coef(i, 1) / psi_ref_coef(II, 1) + else + get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint) + end if +end function + + double precision function get_dij(det1, det2, Nint) use bitmasks implicit none diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 74a572f5..e4b63208 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -86,7 +86,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist logical, external :: detEq, is_generable - double precision, external :: get_dij + double precision, external :: get_dij, get_dij_index leng = max(N_det_generators, N_det_non_ref) allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref)) @@ -225,7 +225,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe do i_state=1,N_states - dIk(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(k_sd)), N_int) !!hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) + dIK(i_state) = get_dij_index(i_I, idx_alpha(k_sd), Nint) + !dIk(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(k_sd)), N_int) !!hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) + !dIk(i_state) = psi_non_ref_coef(idx_alpha(k_sd), i_state) / psi_ref_coef(i_I, i_state) enddo @@ -264,7 +266,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe hIl = hij_mrcc(idx_alpha(l_sd),i_I) ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hIl) do i_state=1,N_states - dka(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(l_sd)), N_int) * phase * phase2 !hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 + dka(i_state) = get_dij_index(i_I, idx_alpha(l_sd), N_int) * phase * phase2 + !dka(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(l_sd)), N_int) * phase * phase2 !hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 + !dka(i_state) = psi_non_ref_coef(idx_alpha(l_sd), i_state) / psi_ref_coef(i_I, i_state) * phase * phase2 enddo endif From 6481083bc3c04d380029fa06175c1bc4c6b91a58 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 6 Jul 2016 15:43:21 +0200 Subject: [PATCH 40/42] N_states > 1 --- plugins/MRCC_Utils/mrcc_utils.irp.f | 351 +++++++------------------- plugins/mrcepa0/dressing.irp.f | 43 ++-- plugins/mrcepa0/dressing_slave.irp.f | 11 +- plugins/mrcepa0/mrcepa0_general.irp.f | 43 +--- 4 files changed, 114 insertions(+), 334 deletions(-) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 513e7d09..6c2eb133 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -1,93 +1,11 @@ use bitmasks BEGIN_PROVIDER [ integer, mrmode ] -&BEGIN_PROVIDER [ logical, old_lambda ] -&BEGIN_PROVIDER [ logical, no_mono_dressing ] - implicit none - CHARACTER(len=255) :: test - CALL get_environment_variable("OLD_LAMBDA", test) - old_lambda = trim(test) /= "" .and. trim(test) /= "0" - CALL get_environment_variable("NO_MONO_DRESSING", test) - no_mono_dressing = trim(test) /= "" .and. trim(test) /= "0" - print *, "old", old_lambda, "mono", no_mono_dressing mrmode = 0 END_PROVIDER - -BEGIN_PROVIDER [ double precision, lambda_mrcc_old, (N_states,psi_det_size) ] -&BEGIN_PROVIDER [ integer, lambda_mrcc_pt2_old, (0:psi_det_size) ] -&BEGIN_PROVIDER [ integer, lambda_mrcc_pt3_old, (0:psi_det_size) ] - implicit none - BEGIN_DOC - cm/ or perturbative 1/Delta_E(m) - END_DOC - integer :: i,k - double precision :: ihpsi_current(N_states) - integer :: i_pert_count - double precision :: hii, lambda_pert - integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3 - double precision, parameter :: x = 2.d0 - double precision :: nurm - i_pert_count = 0 - lambda_mrcc_old = 0.d0 - N_lambda_mrcc_pt2 = 0 - N_lambda_mrcc_pt3 = 0 - lambda_mrcc_pt2_old(0) = 0 - lambda_mrcc_pt3_old(0) = 0 - if(N_states > 1) stop "old lambda N_states == 1" - nurm = 0d0 - do i=1,N_det_ref - nurm += psi_ref_coef(i,1)**2 - end do - - do i=1,N_det_non_ref - call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref, & - size(psi_ref_coef,1), N_states,ihpsi_current) - call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) - do k=1,N_states - if (ihpsi_current(k) == 0.d0) then - ihpsi_current(k) = 1.d-32 - endif - lambda_mrcc_old(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) - !if ( dabs(psi_non_ref_coef(i,k)*ihpsi_current(k)) < 1.d-5 .or. lambda_mrcc_old(k,i) > 0d0) then - if ( dabs(ihpsi_current(k))*sqrt(psi_non_ref_coef(i,k)**2 / nurm) < 1.d-5 .or. lambda_mrcc_old(k,i) > 0d0) then - i_pert_count += 1 - lambda_mrcc_old(k,i) = 0.d0 - if (lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) /= i) then - N_lambda_mrcc_pt2 += 1 - lambda_mrcc_pt2_old(N_lambda_mrcc_pt2) = i - endif - else - if (lambda_mrcc_pt3_old(N_lambda_mrcc_pt3) /= i) then - N_lambda_mrcc_pt3 += 1 - lambda_mrcc_pt3_old(N_lambda_mrcc_pt3) = i - endif - endif -! lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) -! if((ihpsi_current(k) * lambda_pert) < 0.5d0 * psi_non_ref_coef_restart(i,k) ) then -! lambda_mrcc_old(k,i) = 0.d0 -! endif - - if (lambda_mrcc_old(k,i) > x) then - lambda_mrcc_old(k,i) = x - else if (lambda_mrcc_old(k,i) < -x) then - lambda_mrcc_old(k,i) = -x - endif - enddo - enddo - lambda_mrcc_pt2_old(0) = N_lambda_mrcc_pt2 - lambda_mrcc_pt3_old(0) = N_lambda_mrcc_pt3 - - print*,'N_det_non_ref = ',N_det_non_ref - print*,'Number of ignored determinants = ',i_pert_count - print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) - print*,'lambda min/max = ',maxval(dabs(lambda_mrcc_old)), minval(dabs(lambda_mrcc_old)) - -END_PROVIDER - - - BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] + BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states, N_det_non_ref) ] &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] &BEGIN_PROVIDER [ integer, lambda_mrcc_pt3, (0:psi_det_size) ] implicit none @@ -99,49 +17,41 @@ END_PROVIDER integer :: i_pert_count double precision :: hii, lambda_pert integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3 - integer :: histo(200), j - histo = 0 - if(old_lambda) then - lambda_mrcc = lambda_mrcc_old - lambda_mrcc_pt2 = lambda_mrcc_pt2_old - lambda_mrcc_pt3 = lambda_mrcc_pt3_old - else - i_pert_count = 0 - lambda_mrcc = 0.d0 - N_lambda_mrcc_pt2 = 0 - N_lambda_mrcc_pt3 = 0 - lambda_mrcc_pt2(0) = 0 - lambda_mrcc_pt3(0) = 0 + i_pert_count = 0 + lambda_mrcc = 0.d0 + N_lambda_mrcc_pt2 = 0 + N_lambda_mrcc_pt3 = 0 + lambda_mrcc_pt2(0) = 0 + lambda_mrcc_pt3(0) = 0 - do i=1,N_det_non_ref - call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& - size(psi_ref_coef,1), N_states,ihpsi_current) - call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) - do k=1,N_states - if (ihpsi_current(k) == 0.d0) then - ihpsi_current(k) = 1.d-32 + do i=1,N_det_non_ref + call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,& + size(psi_ref_coef,1), N_states,ihpsi_current) + call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) + do k=1,N_states + if (ihpsi_current(k) == 0.d0) then + ihpsi_current(k) = 1.d-32 + endif + lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) + lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) + if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then + i_pert_count += 1 + lambda_mrcc(k,i) = 0.d0 + if (lambda_mrcc_pt2(N_lambda_mrcc_pt2) /= i) then + N_lambda_mrcc_pt2 += 1 + lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i endif - lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) - lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) - if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then - i_pert_count += 1 - lambda_mrcc(k,i) = 0.d0 - if (lambda_mrcc_pt2(N_lambda_mrcc_pt2) /= i) then - N_lambda_mrcc_pt2 += 1 - lambda_mrcc_pt2(N_lambda_mrcc_pt2) = i - endif - else - if (lambda_mrcc_pt3(N_lambda_mrcc_pt3) /= i) then - N_lambda_mrcc_pt3 += 1 - lambda_mrcc_pt3(N_lambda_mrcc_pt3) = i - endif + else + if (lambda_mrcc_pt3(N_lambda_mrcc_pt3) /= i) then + N_lambda_mrcc_pt3 += 1 + lambda_mrcc_pt3(N_lambda_mrcc_pt3) = i endif - enddo + endif enddo - lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 - lambda_mrcc_pt3(0) = N_lambda_mrcc_pt3 - end if + enddo + lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 + lambda_mrcc_pt3(0) = N_lambda_mrcc_pt3 print*,'N_det_non_ref = ',N_det_non_ref print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) print*,'lambda max = ',maxval(dabs(lambda_mrcc)) @@ -149,44 +59,6 @@ END_PROVIDER END_PROVIDER -! BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ] -! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt2, (0:psi_det_size) ] -! &BEGIN_PROVIDER [ integer, lambda_mrcc_pt3, (0:psi_det_size) ] -! implicit none -! BEGIN_DOC -! ! cm/ or perturbative 1/Delta_E(m) -! END_DOC -! integer :: i,ii,k -! double precision :: ihpsi_current(N_states) -! integer :: i_pert_count -! double precision :: hii, lambda_pert, phase -! integer :: N_lambda_mrcc_pt2, N_lambda_mrcc_pt3, degree -! integer :: exc(N_int, 2) -! histo = 0 -! -! i_pert_count = 0 -! lambda_mrcc = 0.d0 -! N_lambda_mrcc_pt2 = 0 -! N_lambda_mrcc_pt3 = 0 -! lambda_mrcc_pt2(0) = 0 -! lambda_mrcc_pt3(0) = 0 -! -! do ii=1, N_det_ref -! do i=1,N_det_non_ref -! call get_excitation(psi_ref(1,1,II), psi_non_ref(1,1,i), exc, degree, phase, N_int) -! if(degree == -1) cycle -! call i_H_j(psi_non_ref(1,1,ii),psi_non_ref(1,1,i),N_int,hii) -! -! -! lambda_mrcc_pt2(0) = N_lambda_mrcc_pt2 -! lambda_mrcc_pt3(0) = N_lambda_mrcc_pt3 -! -! print*,'N_det_non_ref = ',N_det_non_ref -! print*,'psi_coef_ref_ratio = ',psi_ref_coef(2,1)/psi_ref_coef(1,1) -! print*,'lambda max = ',maxval(dabs(lambda_mrcc)) -! print*,'Number of ignored determinants = ',i_pert_count -! -! END_PROVIDER BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ] @@ -362,16 +234,6 @@ logical function is_generable(det1, det2, Nint) return end if if(degree > 2) stop "?22??" - !!!!! -! call dec_exc(exc, h1, h2, p1, p2) -! f = searchExc(toutmoun(1,1), (/h1, h2, p1, p2/), hh_shortcut(hh_shortcut(0)+1)-1) -! !print *, toutmoun(:,1), hh_shortcut(hh_shortcut(0)+1)-1, (/h1, h2, p1, p2/) -! if(f /= -1) then -! is_generable = .true. -! if(.not. excEq(toutmoun(1,f), (/h1, h2, p1, p2/))) stop "????" -! end if -! ! print *, f -! return call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) @@ -680,10 +542,10 @@ END_PROVIDER END_PROVIDER -BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] +BEGIN_PROVIDER [ double precision, dIj_unique, (hh_shortcut(hh_shortcut(0)+1)-1, N_states) ] implicit none logical :: ok - integer :: i, j, k, II, pp, hh, ind, wk, nex, a_col, at_row + integer :: i, j, k, s, II, pp, hh, ind, wk, nex, a_col, at_row integer, external :: searchDet, unsortedSearchDet integer(bit_kind) :: myDet(N_int, 2), myMask(N_int, 2) integer :: N, INFO, AtA_size, r1, r2 @@ -691,22 +553,36 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] double precision :: t, norm, cx integer, allocatable :: A_ind(:,:), lref(:), AtA_ind(:), A_ind_mwen(:), col_shortcut(:), N_col(:) - if(n_states /= 1) stop "n_states /= 1" + nex = hh_shortcut(hh_shortcut(0)+1)-1 print *, "TI", nex, N_det_non_ref allocate(A_ind(N_det_ref+1, nex), A_val(N_det_ref+1, nex)) - allocate(AtA_ind(N_det_ref * nex), AtA_val(N_det_ref * nex)) !!!!! MAY BE TOO SMALL !!!!!!!! + allocate(AtA_ind(N_det_ref * nex), AtA_val(N_det_ref * nex)) !!!!! MAY BE TOO SMALL ? !!!!!!!! allocate(x(nex), AtB(nex)) allocate(A_val_mwen(nex), A_ind_mwen(nex)) allocate(N_col(nex), col_shortcut(nex), B(N_det_non_ref)) + allocate (x_new(nex)) + + do s = 1, N_states + A_val = 0d0 A_ind = 0 + AtA_ind = 0 + AtA_val = 0d0 + x = 0d0 + AtB = 0d0 + A_val_mwen = 0d0 + A_ind_mwen = 0 + N_col = 0 + col_shortcut = 0 + B = 0d0 + x_new = 0d0 + !$OMP PARALLEL DO schedule(static,10) default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind) & - !$OMP shared(hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref) & + !$OMP shared(s, hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref) & !$OMP private(lref, pp, II, ok, myMask, myDet, ind, wk) do hh = 1, hh_shortcut(0) - !print *, hh, "/", hh_shortcut(0) do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 allocate(lref(N_det_non_ref)) lref = 0 @@ -715,12 +591,8 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] if(.not. ok) cycle call apply_particle(myMask, pp_exists(1, pp), myDet, ok, N_int) if(.not. ok) cycle - !ind = unsortedSearchDet(psi_non_ref(1,1,1), myDet, N_det_non_ref, N_int) ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int) if(ind /= -1) then - !iwk = wk+1 - !A_val(wk, pp) = psi_ref_coef(II, 1) - !A_ind(wk, pp) = psi_non_ref_sorted_idx(ind) lref(psi_non_ref_sorted_idx(ind)) = II end if end do @@ -728,7 +600,7 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] do i=1, N_det_non_ref if(lref(i) /= 0) then wk += 1 - A_val(wk, pp) = psi_ref_coef(lref(i), 1) + A_val(wk, pp) = psi_ref_coef(lref(i), s) A_ind(wk, pp) = i end if end do @@ -744,13 +616,13 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] N_col = 0 !$OMP PARALLEL DO schedule(dynamic, 100) default(none) shared(k, psi_non_ref_coef, A_ind, A_val, x, N_det_ref, nex, N_det_non_ref) & !$OMP private(at_row, a_col, t, i, r1, r2, wk, A_ind_mwen, A_val_mwen) & - !$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind) + !$OMP shared(col_shortcut, N_col, AtB, AtA_size, AtA_val, AtA_ind, s) do at_row = 1, nex wk = 0 if(mod(at_row, 10000) == 0) print *, "AtA", at_row, "/", nex do i=1,N_det_ref if(A_ind(i, at_row) == 0) exit - AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) + AtB(at_row) = AtB(at_row) + psi_non_ref_coef(A_ind(i, at_row), s) * A_val(i, at_row) end do do a_col = 1, nex t = 0d0 @@ -769,15 +641,11 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do if(a_col == at_row) then - t = (t + 1d0)! / 2d0 - !print *, a_col, t-1d0 + t = (t + 1d0) end if if(t /= 0d0) then wk += 1 - !AtA_ind(1, wk) = at_row - !AtA_ind(2, wk) = a_col A_ind_mwen(wk) = a_col - !AtA_val(wk) = t A_val_mwen(wk) = t end if end do @@ -796,7 +664,6 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] x = AtB if(AtA_size > size(AtA_val)) stop "SIZA" print *, "ATA SIZE", ata_size - allocate (x_new(nex)) integer :: iproc, omp_get_thread_num iproc = omp_get_thread_num() do i=1,nex @@ -821,7 +688,7 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] double precision :: norm_cas norm_cas = 0d0 do i = 1, N_det_ref - norm_cas += psi_ref_coef(i,1)**2 + norm_cas += psi_ref_coef(i,s)**2 end do norm = 0d0 @@ -831,23 +698,6 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] t = t + X_new(j) * X_new(j) end do - !t = (1d0 - norm_cas) / t - !x_new = x_new * sqrt(t) - !!!!!!!!!!!!!! - !B = 0d0 - !do i=1, nex - ! do j=1, N_det_ref - ! if(A_ind(j, i) == 0) exit - ! B(A_ind(j, i)) += A_val(j, i) * x(i) - ! end do - !end do - !t = 0d0 - !do i=1, size(B) - ! t += B(i)**2 - !end do - !print *, "NORMT", sqrt(t + norm_cas) - !x_new = x_new / sqrt(t + norm_cas) -!!!!!!!!!! t = (1d0 / norm_cas - 1d0) / t x_new = x_new * sqrt(t) @@ -858,7 +708,7 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do - if(mod(k, 50) == 0) then + if(mod(k, 100) == 0) then print *, "residu ", k, norm, "norm t", sqrt(t) end if @@ -866,77 +716,50 @@ BEGIN_PROVIDER [ double precision, dIj, (hh_shortcut(hh_shortcut(0)+1)-1) ] end do print *, "CONVERGENCE : ", norm + dIj_unique(:size(X), s) = X(:) + -!do k=0,500 -! if(k == 1) print *, X(:10) -! x_new = 0d0 -! A_dense = 0d0 -! !!$OMP PARALLEL DO schedule(dynamic, 10) default(none) shared(k, psi_non_ref_coef, x_new, A_ind, A_val, x, N_det_ref, nex, N_det_non_ref) & -! !!$OMP private(a_col, t, i, cx) & -! !!$OMP firstprivate(A_dense) -! do at_row = 1, nex -! ! ! d DIR$ IVDEP -! cx = 0d0 -! do i=1,N_det_ref -! if(A_ind(i, at_row) == 0) exit -! if(k /= 0) A_dense(A_ind(i, at_row)) = A_val(i, at_row) -! cx = cx + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) -! !x_new(at_row) = x_new(at_row) + psi_non_ref_coef(A_ind(i, at_row), 1) * A_val(i, at_row) -! end do -! if(k == 0) then -! x_new(at_row) = cx -! cycle -! end if -! do a_col = 1, nex -! t = 0d0 -! do i = 1, N_det_ref -! if(A_ind(i, a_col) == 0) exit -! t = t - A_val(i, a_col) * A_dense(A_ind(i, a_col)) ! -= pcq I-A -! end do -! if(a_col == at_row) t = t + 1d0 -! cx = cx + t * x(a_col) -! !x_new(at_row) = x_new(at_row) + t * x(a_col) -! end do -! x_new(at_row) = cx -! do i=1,N_det_ref -! if(A_ind(i, at_row) == 0) exit -! A_dense(A_ind(i, at_row)) = 0d0 -! end do -! end do -! !!$OMP END PARALLEL DO + end do -! norm = 0d0 -! do j=1, size(X) -! norm += (X_new(j) - X(j))**2 -! X(j) = X_new(j) -! end do -! print *, "residu ", k, norm -! if(norm < 1d-10) exit -!end do -! - dIj(:size(X)) = X(:) - !print *, X print *, "done" END_PROVIDER -double precision function get_dij_index(II, i, Nint) - integer, intent(in) :: II, i, Nint - double precision, external :: get_dij +BEGIN_PROVIDER [ double precision, dij, (N_det_ref, N_det_non_ref, N_states) ] + integer :: s,i,j + print *, "computing amplitudes..." + do s=1, N_states + do i=1, N_det_non_ref + do j=1, N_det_ref + dij(j, i, s) = get_dij_index(j, i, s, N_int) + end do + end do + end do + print *, "done computing amplitudes" +END_PROVIDER - if(dabs(psi_ref_coef(II, 1)) > 1d-1) then - get_dij_index = psi_non_ref_coef(i, 1) / psi_ref_coef(II, 1) + + + +double precision function get_dij_index(II, i, s, Nint) + integer, intent(in) :: II, i, s, Nint + double precision, external :: get_dij + double precision :: HIi + + if(lambda_type == 0) then + get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) else - get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint) + call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint, HIi) + get_dij_index = HIi * lambda_mrcc(s, i) end if end function -double precision function get_dij(det1, det2, Nint) +double precision function get_dij(det1, det2, s, Nint) use bitmasks implicit none - integer, intent(in) :: Nint + integer, intent(in) :: s, Nint integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) integer :: degree, f, exc(0:2, 2, 2), t integer*2 :: h1, h2, p1, p2, s1, s2 @@ -976,7 +799,7 @@ double precision function get_dij(det1, det2, Nint) end if if(t /= -1) then - get_dij = dIj(t - 1 + hh_shortcut(f)) + get_dij = dIj_unique(t - 1 + hh_shortcut(f), s) end if end function diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index e4b63208..3a91f42e 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -6,7 +6,7 @@ use bitmasks &BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] use bitmasks implicit none - integer :: gen, h, p, i_state, n, t, i, h1, h2, p1, p2, s1, s2, iproc + integer :: gen, h, p, n, t, i, h1, h2, p1, p2, s1, s2, iproc integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) integer(bit_kind),allocatable :: buf(:,:,:) logical :: ok @@ -14,16 +14,16 @@ use bitmasks delta_ij_mrcc = 0d0 delta_ii_mrcc = 0d0 - i_state = 1 + print *, "Dij", dij(1,1,1) provide hh_shortcut psi_det_size! lambda_mrcc !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & - !$OMP shared(N_states, N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc) & + !$OMP shared(N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc) & !$OMP private(h, n, mask, omask, buf, ok, iproc) do gen= 1, N_det_generators allocate(buf(N_int, 2, N_det_non_ref)) iproc = omp_get_thread_num() + 1 - print *, gen, "/", N_det_generators + if(mod(gen, 10) == 0) print *, "mrcc ", gen, "/", N_det_generators do h=1, hh_shortcut(0) call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) if(.not. ok) cycle @@ -36,7 +36,9 @@ use bitmasks if(n > N_det_non_ref) stop "MRCC..." end do n = n - 1 + if(n /= 0) call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc,gen,n,buf,N_int,omask) + end do deallocate(buf) end do @@ -86,7 +88,8 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist logical, external :: detEq, is_generable - double precision, external :: get_dij, get_dij_index + !double precision, external :: get_dij, get_dij_index + leng = max(N_det_generators, N_det_non_ref) allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref)) @@ -171,7 +174,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe idx_alpha(j) = idx_microlist_zero(idx_alpha(j)) end do - else call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) do j=1,idx_alpha(0) @@ -184,7 +186,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe k_sd = idx_alpha(l_sd) call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) enddo - ! |I> do i_I=1,N_det_ref ! Find triples and quadruple grand parents @@ -199,7 +200,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe ! |alpha> do k_sd=1,idx_alpha(0) - ! Loop if lambda == 0 logical :: loop ! loop = .True. @@ -220,18 +220,16 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe ! ! - hIk = hij_mrcc(idx_alpha(k_sd),i_I) + !hIk = hij_mrcc(idx_alpha(k_sd),i_I) ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),Nint,hIk) - do i_state=1,N_states - dIK(i_state) = get_dij_index(i_I, idx_alpha(k_sd), Nint) + dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state) !dIk(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(k_sd)), N_int) !!hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) !dIk(i_state) = psi_non_ref_coef(idx_alpha(k_sd), i_state) / psi_ref_coef(i_I, i_state) enddo - ! |l> = Exc(k -> alpha) |I> call get_excitation(psi_non_ref(1,1,idx_alpha(k_sd)),tq(1,1,i_alpha),exc,degree,phase,Nint) call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) @@ -239,7 +237,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe tmp_det(k,1) = psi_ref(k,1,i_I) tmp_det(k,2) = psi_ref(k,2,i_I) enddo - logical :: ok call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint) if(.not. ok) cycle @@ -249,7 +246,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe dka(i_state) = 0.d0 enddo do l_sd=k_sd+1,idx_alpha(0) - call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) if (degree == 0) then @@ -266,7 +262,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe hIl = hij_mrcc(idx_alpha(l_sd),i_I) ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hIl) do i_state=1,N_states - dka(i_state) = get_dij_index(i_I, idx_alpha(l_sd), N_int) * phase * phase2 + dka(i_state) = dij(i_I, idx_alpha(l_sd), i_state) * phase * phase2 !dka(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(l_sd)), N_int) * phase * phase2 !hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 !dka(i_state) = psi_non_ref_coef(idx_alpha(l_sd), i_state) / psi_ref_coef(i_I, i_state) * phase * phase2 enddo @@ -279,7 +275,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) enddo enddo - + do i_state=1,N_states ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) enddo @@ -292,7 +288,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe enddo enddo call omp_set_lock( psi_ref_lock(i_I) ) - do i_state=1,N_states if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5)then do l_sd=1,idx_alpha(0) @@ -546,12 +541,12 @@ END_PROVIDER implicit none integer :: i,j,k double precision :: Hjk, Hki, Hij - double precision, external :: get_dij + !double precision, external :: get_dij integer i_state, degree provide lambda_mrcc dIj do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(no_mono_dressing,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref,dij) do i=1,N_det_ref do j=1,i call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) @@ -561,7 +556,7 @@ END_PROVIDER call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) - delta_cas(i,j,i_state) += Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int) ! * Hki * lambda_mrcc(i_state, k) + delta_cas(i,j,i_state) += Hjk * dij(i, k, i_state) ! * Hki * lambda_mrcc(i_state, k) !print *, Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int), Hki * get_dij(psi_ref(1,1,j), psi_non_ref(1,1,k), N_int) end do delta_cas(j,i,i_state) = delta_cas(i,j,i_state) @@ -659,7 +654,7 @@ end function integer, allocatable :: idx_sorted_bit(:) integer, external :: get_index_in_psi_det_sorted_bit, searchDet logical, external :: is_in_wavefunction, detEq - double precision, external :: get_dij + !double precision, external :: get_dij integer :: II, blok integer*8, save :: notf = 0 @@ -675,7 +670,7 @@ end function enddo ! To provide everything - contrib = get_dij(psi_ref(1,1,1), psi_non_ref(1,1,1), N_int) + contrib = dij(1, 1, 1) do i_state = 1, N_states delta_mrcepa0_ii(:,:) = 0d0 @@ -685,7 +680,7 @@ end function !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) & !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) & - !$OMP shared(notf,i_state, sortRef, sortRefIdx) + !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref @@ -727,7 +722,7 @@ end function call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) !contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k)) - contrib = delta_cas(II, J, i_state) * get_dij(psi_ref(1,1,J), psi_non_ref(1,1,det_cepa0_idx(k)), N_int) + contrib = delta_cas(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) !$OMP ATOMIC delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 7d64aa5e..7c9d7fe0 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -55,7 +55,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) logical, external :: is_in_wavefunction, isInCassd, detEq integer,allocatable :: komon(:) logical :: komoned - double precision, external :: get_dij + !double precision, external :: get_dij zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_push = new_zmq_push_socket(thread) @@ -144,7 +144,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) ! if(I_i == J) phase_Ii = phase_Ji do i_state = 1,N_states - dkI = h_(J,i) * get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,i), N_int) + dkI = h_(J,i) * dij(i_I, i, i_state)!get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,i), N_int) !dkI = h_(J,i) * h_(i_I,i) * lambda_mrcc(i_state, i) dleat(i_state, kn, 1) = dkI dleat(i_state, kn, 2) = dkI @@ -174,7 +174,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) !contrib = h_(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al - contrib = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,k), N_int) * dleat(i_state, m, 2) + contrib = dij(i_I, k, i_state) * dleat(i_state, m, 2) delta(i_state,ll,1) += contrib if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then delta(i_state,0,1) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) @@ -182,7 +182,7 @@ subroutine mrsc2_dressing_slave(thread,iproc) if(I_i == J) cycle !contrib = h_(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al - contrib = get_dij(psi_ref(1,1,J), psi_non_ref(1,1,l), N_int) * dleat(i_state, m, 1) + contrib = dij(J, l, i_state) * dleat(i_state, m, 1) delta(i_state,kk,2) += contrib if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then delta(i_state,0,2) -= contrib * cj_inv(i_state) * psi_non_ref_coef(k,i_state) @@ -483,9 +483,6 @@ end integer :: KKsize = 1000000 - ! -459.6346665282306 - ! -459.6346665282306 - call new_parallel_job(zmq_to_qp_run_socket,'mrsc2') diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index 0ef4c92b..53a0822d 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -16,10 +16,11 @@ subroutine run(N_st,energy) double precision :: thresh_mrcc + thresh_mrcc = 1d-7 n_it_mrcc_max = 10 - if(no_mono_dressing) then + if(n_it_mrcc_max == 1) then do j=1,N_states_diag do i=1,N_det psi_coef(i,j) = CI_eigenvectors_dressed(i,j) @@ -73,44 +74,8 @@ subroutine run_pt2(N_st,energy) print*,'Last iteration only to compute the PT2' threshold_selectors = 1.d0 threshold_generators = 0.999d0 - -! N_det_generators = lambda_mrcc_pt2(0) -! do i=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) -! psi_det_generators(k,2,i) = psi_non_ref(k,2,j) -! enddo -! do k=1,N_st -! psi_coef_generators(i,k) = psi_non_ref_coef(j,k) -! enddo -! enddo -! SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed - - -! -! 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 - N_det_cas) -! do k=1,N_int -! psi_det_generators(k,1,i) = psi_non_ref(k,1,j) -! psi_det_generators(k,2,i) = psi_non_ref(k,2,j) -! enddo -! do k=1,N_st -! psi_coef_generators(i,k) = psi_non_ref_coef(j,k) -! enddo -! enddo -! SOFT_TOUCH N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed - + + N_det_generators = lambda_mrcc_pt3(0) + N_det_ref N_det_selectors = lambda_mrcc_pt3(0) + N_det_ref From 1bc8bb0a062f979505f7bb7031d7d90d330f285a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 6 Jul 2016 15:53:16 +0200 Subject: [PATCH 41/42] added lambda_type --- plugins/mrcepa0/EZFIO.cfg | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 plugins/mrcepa0/EZFIO.cfg diff --git a/plugins/mrcepa0/EZFIO.cfg b/plugins/mrcepa0/EZFIO.cfg new file mode 100644 index 00000000..9979f537 --- /dev/null +++ b/plugins/mrcepa0/EZFIO.cfg @@ -0,0 +1,5 @@ +[lambda_type] +type: Strictly_positive_int +doc: lambda type ( 0 = none, 1 = last version ) +interface: ezfio,provider,ocaml +default: 0 From ee257c3d6fca7d5b3c707499b3756c0dc5013739 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 6 Jul 2016 16:15:47 +0200 Subject: [PATCH 42/42] merge with LCPQ --- README.md | 6 +- config/ifort.cfg | 2 +- configure | 4 +- data/pseudo/tn_df | 785 ++++++++++++++++++ data/pseudo/tn_df_sc | 292 +++++++ data/pseudo/tn_hf | 785 ++++++++++++++++++ data/qp.png | Bin 0 -> 42781 bytes install/scripts/install_ocaml.sh | 1 + install/scripts/install_zeromq.sh | 12 +- ocaml/Atom.ml | 12 +- ocaml/Atom.mli | 1 + ocaml/Basis.ml | 20 +- ocaml/Basis.mli | 2 +- ocaml/Gto.ml | 35 +- ocaml/Gto.mli | 6 +- ocaml/Input_ao_basis.ml | 1 + ocaml/Input_nuclei.ml | 17 + ocaml/Molecule.ml | 11 +- ocaml/Molecule.mli | 1 + ocaml/TaskServer.mli | 84 ++ ocaml/_tags | 2 +- plugins/All_singles/H_apply.irp.f | 3 +- plugins/All_singles/all_singles.irp.f | 2 +- plugins/CAS_SD/H_apply.irp.f | 4 - plugins/DDCI_selected/ddci.irp.f | 23 +- plugins/FOBOCI/EZFIO.cfg | 25 +- plugins/FOBOCI/H_apply.irp.f | 16 +- plugins/FOBOCI/NEEDED_CHILDREN_MODULES | 2 +- plugins/FOBOCI/all_singles.irp.f | 335 ++++++-- plugins/FOBOCI/all_singles_split.irp.f | 442 ++++++++-- plugins/FOBOCI/collect_all_lmct.irp.f | 436 ++++++++++ plugins/FOBOCI/corr_energy_2h2p.irp.f | 425 ++++++++++ plugins/FOBOCI/diag_fock_inactiv_virt.irp.f | 48 ++ plugins/FOBOCI/dress_simple.irp.f | 61 +- plugins/FOBOCI/fobo_scf.irp.f | 59 ++ .../foboci_lmct_mlct_threshold_old.irp.f | 124 ++- plugins/FOBOCI/foboci_reunion.irp.f | 18 + plugins/FOBOCI/generators_restart_save.irp.f | 158 ++-- plugins/FOBOCI/hcc_1h1p.irp.f | 83 ++ plugins/FOBOCI/modify_generators.irp.f | 1 + plugins/FOBOCI/new_approach.irp.f | 339 +++++++- plugins/FOBOCI/new_new_approach.irp.f | 132 +++ plugins/FOBOCI/routines_dressing.irp.f | 497 ++++++++++- plugins/FOBOCI/routines_foboci.irp.f | 262 +++++- plugins/Full_CI/H_apply.irp.f | 5 + plugins/Full_CI/micro_pt2.irp.f | 4 + plugins/Generators_restart/generators.irp.f | 28 +- plugins/Hartree_Fock/damping_SCF.irp.f | 4 +- plugins/MRCC_CASSD/mrcc_cassd.irp.f | 13 +- plugins/MRCC_Utils/H_apply.irp.f | 7 +- plugins/Molden/NEEDED_CHILDREN_MODULES | 2 +- plugins/Molden/aos.irp.f | 196 ----- plugins/Molden/print_mo.irp.f | 6 +- plugins/Perturbation/pt2_equations.irp.f | 2 + plugins/Properties/hyperfine_constants.irp.f | 13 + plugins/Properties/mulliken.irp.f | 31 + plugins/Properties/print_hcc.irp.f | 15 +- plugins/Properties/print_mulliken.irp.f | 31 +- plugins/QmcChem/e_curve_qmc.irp.f | 102 +++ plugins/QmcChem/save_for_qmcchem.irp.f | 51 +- plugins/loc_cele/loc.f | 4 +- plugins/loc_cele/loc_cele.irp.f | 502 ++++++----- .../qmcpack/qp_convert_qmcpack_to_ezfio.py | 27 +- scripts/compilation/qp_create_ninja.py | 7 +- scripts/ezfio_interface/ei_handler.py | 2 +- .../ezfio_generate_provider.py | 33 +- scripts/ezfio_interface/qp_edit_template | 10 +- scripts/generate_h_apply.py | 65 +- src/AO_Basis/aos.irp.f | 211 ++++- src/Bitmask/bitmask_cas_routines.irp.f | 17 + src/Bitmask/bitmasks.irp.f | 43 +- src/Determinants/H_apply.irp.f | 41 +- src/Determinants/H_apply.template.f | 26 +- src/Determinants/H_apply_nozmq.template.f | 8 +- src/Determinants/H_apply_zmq.template.f | 68 +- src/Determinants/SC2.irp.f | 6 +- src/Determinants/davidson.irp.f | 77 +- src/Determinants/determinants.irp.f | 2 +- src/Determinants/diagonalize_CI_SC2.irp.f | 8 +- src/Determinants/s2.irp.f | 44 +- src/Determinants/save_natorb.irp.f | 1 + src/Determinants/slater_rules.irp.f | 5 +- src/Integrals_Bielec/ao_bi_integrals.irp.f | 19 +- src/Integrals_Bielec/map_integrals.irp.f | 1 - src/Integrals_Bielec/mo_bi_integrals.irp.f | 13 +- src/Integrals_Monoelec/mo_mono_ints.irp.f | 1 + .../pot_ao_pseudo_ints.irp.f | 10 +- src/Utils/util.irp.f | 12 - src/ZMQ/utils.irp.f | 27 +- tests/bats/qp.bats | 4 +- 90 files changed, 6161 insertions(+), 1217 deletions(-) create mode 100644 data/pseudo/tn_df create mode 100644 data/pseudo/tn_df_sc create mode 100644 data/pseudo/tn_hf create mode 100644 data/qp.png create mode 100644 ocaml/TaskServer.mli create mode 100644 plugins/FOBOCI/collect_all_lmct.irp.f create mode 100644 plugins/FOBOCI/corr_energy_2h2p.irp.f create mode 100644 plugins/FOBOCI/fobo_scf.irp.f create mode 100644 plugins/FOBOCI/foboci_reunion.irp.f create mode 100644 plugins/FOBOCI/hcc_1h1p.irp.f create mode 100644 plugins/FOBOCI/new_new_approach.irp.f delete mode 100644 plugins/Molden/aos.irp.f create mode 100644 plugins/QmcChem/e_curve_qmc.irp.f diff --git a/README.md b/README.md index e313f444..5372b7ac 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,7 @@ -Quantum package -=============== - +![QP](https://raw.githubusercontent.com/LCPQ/quantum_package/master/data/qp.png) [![Build Status](https://travis-ci.org/LCPQ/quantum_package.svg?branch=master)](https://travis-ci.org/LCPQ/quantum_package) - [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/LCPQ/quantum_package?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) - Set of quantum chemistry programs and libraries. (under GNU GENERAL PUBLIC LICENSE v2) diff --git a/config/ifort.cfg b/config/ifort.cfg index 47a654c3..b7d03fbb 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -51,7 +51,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz # [DEBUG] FC : -g -traceback -FCFLAGS : -xAVX -C -fpe0 +FCFLAGS : -xAVX -C -fpe0 IRPF90_FLAGS : --openmp # OpenMP flags diff --git a/configure b/configure index c3a22683..de5b3d56 100755 --- a/configure +++ b/configure @@ -142,7 +142,7 @@ ezfio = Info( default_path=join(QP_ROOT_INSTALL, "EZFIO")) zeromq = Info( - url='http://download.zeromq.org/zeromq-4.0.7.tar.gz', + url='https://github.com/zeromq/zeromq4-1/releases/download/v4.1.4/zeromq-4.1.4.tar.gz', description=' ZeroMQ', default_path=join(QP_ROOT_LIB, "libzmq.a")) @@ -166,7 +166,7 @@ d_info = dict() for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt", "resultsFile", "ninja", "emsl", "ezfio", "p_graphviz", - "zeromq", "f77zmq","bats" ]: + "zeromq", "f77zmq","bats"]: exec ("d_info['{0}']={0}".format(m)) diff --git a/data/pseudo/tn_df b/data/pseudo/tn_df new file mode 100644 index 00000000..2ba941be --- /dev/null +++ b/data/pseudo/tn_df @@ -0,0 +1,785 @@ +H GEN 0 2 +6 + 1.00000000 1 34.44662515 + -0.89096601 2 40.13885591 + -4.35250792 2 24.66307521 + -11.58011743 2 20.49225491 + 12.58011743 2 30.23909011 + 34.44662515 3 22.28419700 +6 + -262.22422461 2 17.87367530 + 258.22981252 2 28.75598991 + 5613.63467960 2 19.10096571 + -4192.30569417 2 18.88256059 + -1341.04802395 2 20.95302325 + -79.28421640 2 34.10653707 +6 + -199.48848662 2 37.85954681 + 197.31066276 2 28.79454664 + 4870247.22276531 2 40.22839783 + -5277181.77014563 2 40.34690459 + -196566.81095176 2 39.13989706 + 603502.35555458 2 40.91315002 + +He GEN 0 2 +6 + 2.00000000 1 22.64777484 + -0.00700692 2 23.54196640 + -8.90169316 2 18.71556903 + 113.56926776 2 15.15150658 + -112.56926776 2 13.80465850 + 45.29554968 3 12.54192267 +6 + 747.63794984 2 13.33611411 + -753.70091072 2 23.45392111 + -397.08293819 2 12.23651194 + 10.35341837 2 14.87987639 + -1430.53848568 2 18.32138342 + 1818.26602949 2 21.24054054 +6 + 305.67933642 2 21.32319132 + -307.98355807 2 12.22370696 + 5957.66379729 2 14.11720170 + -6099.62872267 2 14.41269814 + 523.59639310 2 17.66028106 + -380.63505659 2 21.52626637 + +Li GEN 2 2 +6 + 1.00000000 1 0.78732101 + -2.23999912 2 0.79224763 + 0.10376190 2 1.79622268 + 4.27489122 2 1.83637465 + -3.27489122 2 1.91213904 + 0.78732101 3 0.79291624 +6 + 256.80790655 2 1.78312879 + -255.81956741 2 0.95553059 + 90.30361668 2 0.87617279 + 272.13155048 2 1.09621549 + -180.73373018 2 1.43900642 + -180.70146573 2 1.83085147 +6 + -4.80714862 2 1.53942961 + 3.36281864 2 0.84742021 + -305.38012622 2 0.78976831 + -509.40184487 2 0.98031681 + 436.16121675 2 0.81548364 + 379.61797456 2 1.02582853 + +Be GEN 2 2 +6 + 2.00000000 1 1.20639978 + -5.40313229 2 1.18425537 + 1.72394027 2 2.81826911 + 2.83884922 2 2.37513515 + -1.83884922 2 2.82920954 + 2.41279956 3 1.18219335 +6 + -1045.63679908 2 2.59240356 + 1047.85482764 2 1.41685787 + -1899.15859219 2 1.48536566 + 1398.06780686 2 1.70076501 + -696.13481389 2 2.03898674 + 1198.22571139 2 2.57766211 +6 + 630.90931326 2 1.84421403 + -632.78437074 2 1.13419132 + 441.35012255 2 1.13393716 + 435.97021325 2 1.22419150 + -353.63284449 2 1.39760436 + -522.69065435 2 1.88595068 + +B GEN 2 2 +6 + 3.00000000 1 2.72292969 + -11.78419674 2 2.41356794 + 5.22993640 2 4.60628004 + 0.42834165 2 3.81569642 + 0.57165835 2 4.75281449 + 8.16878907 3 2.42655010 +6 + -260.26050710 2 2.55536939 + 265.37594882 2 4.54575013 + 76.89512909 2 2.14992133 + -57.25691791 2 2.71845869 + 4293.37943873 2 3.54567059 + -4312.01708538 2 3.65811356 +6 + 236.98381086 2 3.86703012 + -239.59777090 2 2.15409783 + 4347.09682018 2 2.51320631 + -4637.07702775 2 2.58243237 + 786.10765740 2 3.15459528 + -495.13181880 2 3.69673537 + +C GEN 2 2 +6 + 4.00000000 1 6.85914037 + -69.31783111 2 7.66877502 + 58.73619595 2 8.89164866 + -5.11066199 2 4.63398124 + 6.11066199 2 5.40104250 + 27.43656147 3 6.79273179 +6 + 430.61454744 2 8.62389774 + -421.35054055 2 5.03244470 + -33212.40034531 2 6.89861917 + 44.12655159 2 3.96628687 + 96.39927700 2 5.01313881 + 33072.87650778 2 6.85964729 +6 + -104389.58452246 2 4.75057662 + 104386.03365951 2 8.95366858 + 690570.92310077 2 7.84605551 + 105067.78650436 2 4.75435948 + -142604.06718444 2 8.80450514 + -653033.64724842 2 7.81116996 + +N GEN 2 2 +6 + 5.00000000 1 11.01983025 + -747.65378590 2 7.70260962 + 731.28815439 2 7.83791198 + -3.54162255 2 8.41784728 + 4.54162255 2 12.53426384 + 55.09915125 3 6.76845507 +6 + 189.29450948 2 10.95064006 + -174.81483163 2 7.48980682 + 148422.74289741 2 6.18035270 + -167161.90534269 2 6.21695388 + 34280.43140051 2 6.81408633 + -15540.26812247 2 7.23413705 +6 + -5338.70218681 2 6.15987128 + 5334.35386770 2 7.49726635 + -1839.21100223 2 8.80963870 + 16010.85000728 2 6.52067091 + -16722.95522386 2 6.97790252 + 2552.31199840 2 8.37871646 + +O GEN 2 2 +6 + 6.00000000 1 8.86932353 + -28.04199287 2 6.05326172 + 11.15704031 2 5.51480979 + 180.82432510 2 10.77878397 + -179.82432510 2 10.23693413 + 53.21594115 3 7.90462675 +6 + -9212.20980516 2 7.28893859 + 9226.86567950 2 6.05971190 + 58203.26727502 2 10.83143357 + -5120.48607364 2 5.75281092 + -93321.50266843 2 10.51155711 + 40239.72318888 2 9.72227746 +6 + 10001.55649464 2 7.43321349 + -10012.86801601 2 5.85047476 + 8554.95973537 2 5.79011164 + -20342.33136146 2 8.08750969 + 11739.44079236 2 8.43229920 + 48.92837040 2 4.71055456 + +F GEN 2 2 +6 + 7.00000000 1 16.52048840 + -10.46754024 2 13.26693551 + -11.21567917 2 18.77563836 + -32.41582195 2 10.96778594 + 33.41582195 2 21.09729680 + 115.64341877 3 13.46927525 +6 + 1201.43391413 2 19.92490215 + -1182.60889584 2 11.77163137 + -8770.99026936 2 12.30043337 + 5336.21358848 2 11.63810105 + 8729.77565724 2 14.12189391 + -5293.99672165 2 16.53091209 +6 + 92.58757506 2 8.66992000 + -108.46085404 2 9.40009036 + -319.30686222 2 9.08633595 + 524.57586653 2 9.90194004 + -443.63347077 2 13.57164540 + 239.36118945 2 16.47995554 + +Ne GEN 2 2 +6 + 8.00000000 1 21.64664513 + 1794.02959527 2 14.45731213 + -1828.03241002 2 14.11697591 + 23.90491418 2 14.10774236 + -22.90491418 2 20.42359560 + 173.17316107 3 11.93940404 +6 + -5911.13460210 2 12.24993716 + 5941.26076308 2 20.24332306 + 2840.09993994 2 12.20646543 + 1742.40556167 2 11.50431394 + 8834.09207695 2 16.82066882 + -13415.59681607 2 18.72208419 +6 + 53626.32637171 2 20.56468824 + -53639.90888359 2 19.92390926 + -576.65341012 2 13.02834964 + 1907.80575476 2 15.43385134 + 5623.71426075 2 18.06950435 + -6953.86800222 2 22.66963993 + +K GEN 18 2 +6 + 1.00000000 1 0.50008727 + 1416.76952428 2 0.63134777 + -1419.89095139 2 0.60241926 + -302.74307268 2 0.68724573 + 303.74307268 2 0.55624069 + 0.50008727 3 0.50008691 +6 + -854959.33457742 2 0.55297829 + 854960.96236303 2 0.59508099 + -2735051.37932036 2 0.55136787 + -797902.82136562 2 0.59254779 + -90621.33409241 2 0.60683509 + 3623576.53510235 2 0.55188848 +6 + 5366450.44923246 2 0.56834617 + -5366449.39460951 2 0.57395202 + 506392.75510780 2 0.65188562 + 1065012.45735119 2 0.60395254 + -764583.36396565 2 0.55451976 + -806820.84832728 2 0.64359720 + +Ca GEN 18 2 +6 + 2.00000000 1 0.74758765 + 308735.40641498 2 0.72269274 + -308740.90975833 2 0.72197603 + 7202.81432103 2 0.70435779 + -7201.81432103 2 0.73462875 + 1.49517531 3 0.98521314 +6 + 3358.40551562 2 0.85820603 + -3354.33378202 2 0.50055931 + 645.82930380 2 0.77593512 + -4032.30085432 2 0.85197466 + 3315.68514964 2 0.50005881 + 71.78714429 2 1.01826143 +6 + 3797.10880911 2 0.54666026 + -3794.15970380 2 0.55760964 + 1988.78457523 2 0.66771019 + 13912.48066729 2 0.71662858 + -408.96685813 2 0.50701325 + -15491.29677996 2 0.71335086 + +Sc GEN 18 2 +6 + 3.00000000 1 6.99258598 + -124.50237230 2 4.24128187 + 97.21802227 2 1.68870852 + -87.09390293 2 1.51321231 + 88.09390293 2 5.62659050 + 20.97775795 3 2.67617421 +6 + 375.73920548 2 5.45654024 + -350.54708476 2 5.82486421 + -11.58800164 2 0.51173797 + 12.31935173 2 0.56805032 + 20.80334597 2 0.78399590 + -20.53480959 2 1.25273408 +6 + 6092.78689761 2 1.30970450 + -6068.65474455 2 6.97688197 + 6074.16548241 2 6.96312742 + -2.71306889 2 0.50000000 + 562.44223581 2 1.09627007 + -6632.89448781 2 1.28901234 + +Ti GEN 18 2 +6 + 4.00000000 1 4.58962911 + 29.78882355 2 12.99080675 + -64.03604684 2 6.47044482 + 4.09908827 2 7.32890448 + -3.09908827 2 0.86508310 + 18.35851644 3 11.66884823 +6 + 204.54741131 2 6.98984163 + -173.26765359 2 1.14387234 + -179.62280834 2 7.98041969 + 81.98571631 2 1.30274954 + -105.23530836 2 0.79373704 + 203.87378660 2 0.87617820 +6 + 47.21398743 2 4.46327869 + -17.03315162 2 12.03758238 + -1.80345968 2 1.82986618 + -67.65022794 2 0.85432599 + 83.23157126 2 0.75234069 + -12.77614240 2 0.56466795 + +V GEN 18 2 +6 + 5.00000000 1 4.80344323 + 22.35774108 2 18.78787979 + -64.07198704 2 7.13216682 + 4.33388926 2 9.27213879 + -3.33388926 2 0.97989891 + 24.01721615 3 16.08839186 +6 + 180.61077610 2 8.25076842 + -142.94184574 2 0.97905818 + -150.64642751 2 9.92043295 + -6.71407277 2 0.62363714 + 176.09329684 2 0.95148528 + -17.73131270 2 1.07801133 +6 + 57.45110361 2 5.32960287 + -20.81111514 2 14.24980571 + -8.29286428 2 1.85925508 + -5.73287020 2 0.58593750 + 29.10022105 2 0.79878530 + -14.07269455 2 1.00225258 + +Cr GEN 18 2 +6 + 6.00000000 1 12.84308988 + -3.09604991 2 0.99382054 + -44.89504234 2 7.58819115 + -170.55613293 2 14.51774012 + 171.55613293 2 16.43682827 + 77.05853926 3 12.82491986 +6 + -18202.34922306 2 1.98782159 + 18244.42867028 2 31.32646602 + 30868.09979612 2 30.37846452 + 17868.98085600 2 1.97809129 + -49114.96837018 2 30.73273877 + 378.88775116 2 2.67913288 +6 + 29.20236180 2 19.25203633 + 12.37319603 2 0.97567458 + 4072.48148684 2 17.43196546 + -17623.52674725 2 16.30880219 + 0.00000000 2 1.00000000 + 13552.04578438 2 15.92770430 + +Mn GEN 18 2 +6 + 7.00000000 1 15.05016398 + 76.06668034 2 15.84783194 + -134.18719488 2 9.80426007 + 5.15310013 2 22.40715541 + -4.15310013 2 1.28870598 + 105.35114786 3 9.24698903 +6 + 5.29793560 2 36.81344701 + 46.23395617 2 10.22325416 + -60.32817992 2 19.40077237 + 47.36691946 2 10.31192728 + -593.48022661 2 0.82035751 + 607.44155846 2 0.82499832 +6 + 43.56050065 2 39.11191097 + 6.67450664 2 5.89010993 + 273.74198710 2 12.39309544 + -27.45450618 2 46.10455298 + -256.40166892 2 15.13448958 + 11.11513392 2 0.96513012 + +Fe GEN 18 2 +6 + 8.00000000 1 15.22430826 + 44.74166498 2 23.61492800 + -111.48295214 2 10.92989564 + 4.87905385 2 34.25190536 + -3.87905385 2 1.33822720 + 121.79446608 3 12.33553803 +6 + -19.50464924 2 30.77395752 + 78.13974335 2 10.21396062 + -93.51149367 2 7.16717891 + -5331.00729306 2 2.86167947 + 2973.12062964 2 2.65030718 + 2452.39961633 2 3.20024669 +6 + 24692.89537881 2 35.68878072 + -24635.37117467 2 1.90446408 + 67.20321584 2 9.50100295 + -24719.85685234 2 35.67756831 + 155.45498669 2 2.48480944 + 24498.19947049 2 1.90126047 + +Co GEN 18 2 +6 + 9.00000000 1 16.99448342 + 49.13807967 2 27.18614115 + -125.28324533 2 12.21218102 + 5.11388765 2 39.14513799 + -4.11388765 2 1.47717612 + 152.95035078 3 13.67966454 +6 + -14.42629264 2 42.14707531 + 80.80701231 2 9.38147677 + -241.37463154 2 5.80599555 + -2375.49390008 2 3.20236619 + 1470.87516654 2 3.85735739 + 1146.99509265 2 2.77670509 +6 + 136.98013925 2 35.88691706 + -71.59603354 2 2.32679268 + 69.29537053 2 14.47120857 + -182.97334302 2 33.48566094 + 53.73921710 2 5.03596368 + 60.93980797 2 1.71252673 + +Ni GEN 18 2 +6 + 10.00000000 1 22.08639324 + -144.93688782 2 14.51813938 + 58.56151708 2 31.72005545 + 5.46467869 2 46.47610840 + -4.46467869 2 1.64348434 + 220.86393239 3 17.23929992 +6 + -1037.96291767 2 23.63013626 + 1112.68285967 2 22.54579447 + -202.88667032 2 10.67846148 + -1992.46747856 2 2.78611652 + 261.70081349 2 7.26891690 + 1934.65478930 2 2.71695433 +6 + -53.30731307 2 26.78098186 + 127.09013633 2 3.54449677 + -4806.85555998 2 9.97427088 + 4887.04372410 2 10.06368893 + -212.17359382 2 2.46160888 + 132.98697057 2 1.97486742 + +Cu GEN 18 2 +6 + 11.00000000 1 2.82733696 + -34.48196386 2 1.92614044 + -60.25585479 2 16.36117816 + 95.74606505 2 26.07073787 + -94.74606505 2 15.23964803 + 31.10070652 3 2.17204001 +6 + -45.62927216 2 31.69953680 + 125.91417027 2 1.14930323 + -14.54702824 2 1.62190112 + 4.20903863 2 5.04037704 + 108.15433753 2 13.02666762 + -96.81611101 2 1.08245080 +6 + 95.22440516 2 11.30741812 + -15.05535618 2 0.88219501 + 50.51809351 2 1.10244974 + -44.11033096 2 1.38963093 + 24.77977412 2 1.74927941 + -30.18619193 2 36.48037929 + +Zn GEN 18 2 +6 + 12.00000000 1 31.07239014 + -200.01988966 2 17.28158695 + 92.10229536 2 34.39655496 + 5.98135501 2 49.89939973 + -4.98135501 2 1.96865590 + 372.86868168 3 19.34259724 +6 + -36.14038802 2 38.52109994 + 128.37782465 2 12.00212013 + -1.61496737 2 1.07625274 + -1.83786181 2 49.67118376 + 65.46563590 2 2.17772473 + -61.01291439 2 3.24812913 +6 + -65.64354860 2 18.09701361 + 156.02859885 2 36.00255883 + 172.20201747 2 14.96596000 + -192.17040837 2 36.71242576 + 4.39165632 2 5.39429237 + 16.57829500 2 1.49031308 + +Ga GEN 28 2 +6 + 3.00000000 1 1.13608798 + 164.07678897 2 1.26217688 + -167.28328999 2 1.14858151 + -669.79177234 2 1.15353581 + 670.79177234 2 1.12952095 + 3.40826394 3 1.10744970 +6 + 2326.37321481 2 0.75031475 + -2323.38047364 2 0.75000124 + 386.83516033 2 2.39556890 + 3373.92258044 2 1.92296729 + -3444.97340674 2 2.01243025 + -314.78429931 2 1.54022372 +6 + -49.00749762 2 0.97248539 + 49.23559677 2 1.12030491 + 13.15736344 2 1.17799318 + 125.85888665 2 1.43966818 + -194.32447492 2 1.61975153 + 56.31063114 2 1.96345236 + +Ge GEN 28 2 +6 + 4.00000000 1 1.37803409 + 19.62241898 2 1.39153725 + -23.72148814 2 1.27769848 + 2.49161805 2 1.59279926 + -1.49161805 2 0.64699203 + 5.51213636 3 0.92923210 +6 + -2.74466220 2 0.87224298 + 6.62035166 2 1.17293014 + -2420.40847648 2 1.99495027 + -82306.43955717 2 2.42954180 + 6740.23721390 2 2.16484262 + 77987.61073589 2 2.43883104 +6 + -2107.38453991 2 1.16911036 + 2108.21076604 2 1.46731756 + 1481.43044167 2 1.13494844 + -5605.67944848 2 1.57427397 + 1698.46708565 2 1.69705377 + 2426.78290985 2 1.49642085 + +As GEN 28 2 +6 + 5.00000000 1 1.43022249 + -9.34297986 2 1.49610460 + 4.21498088 2 6.47107540 + 10.09813510 2 3.25241162 + -9.09813510 2 5.07144325 + 7.15111245 3 1.33657021 +6 + 13218.94379269 2 1.93743539 + -13214.39886844 2 1.06114866 + -12968.43207956 2 1.94924972 + 13915.97822491 2 1.06566409 + -954.00698285 2 1.23265097 + 7.46088753 2 4.89271387 +6 + 1464.46500602 2 1.99905491 + -1463.07044815 2 1.47578217 + 368.93680276 2 1.30626554 + -20015.22902646 2 1.76510607 + -4931.41969774 2 1.62454622 + 24578.71284776 2 1.71245824 + +Se GEN 28 2 +6 + 6.00000000 1 1.51096144 + 18985.66456772 2 2.92355341 + -18994.15945825 2 2.92032845 + -67662.27071451 2 3.11248219 + 67663.27071451 2 3.11189793 + 9.06576863 3 1.65761092 +6 + 9.98441274 2 1.51889669 + -2.50844675 2 1.97738476 + -180236.05319146 2 2.70806322 + 388717.66809223 2 2.76186155 + -395809.31847294 2 2.85646715 + 187328.70401255 2 2.90992434 +6 + -0.64003892 2 1.60286011 + 4.75615253 2 1.39335643 + -1221.08696720 2 2.09669307 + -10412.15615824 2 2.41527013 + 11345.50935270 2 2.36453165 + 288.73492615 2 3.03391531 + +Br GEN 28 2 +6 + 7.00000000 1 1.41289916 + -7.52651514 2 1.15658370 + -0.55005317 2 2.42725255 + 32.50767838 2 2.88316202 + -31.50767838 2 2.65601102 + 9.89029412 3 1.40346702 +6 + 28526.73706896 2 2.34791729 + -28520.73498833 2 2.45113975 + -99003.29767895 2 2.50553756 + 749850.19071550 2 2.81179865 + -1128475.81390516 2 2.78141408 + 477629.92118992 2 2.68265676 +6 + 17.76908748 2 1.31119911 + -15.01578842 2 1.60289186 + -18723.09651802 2 2.55330648 + -655.15159005 2 2.02749820 + 16349.83148583 2 2.49321553 + 3029.41777740 2 2.76331597 + +Kr GEN 28 2 +6 + 8.00000000 1 8.52108317 + -122698.81335772 2 3.24264497 + 122687.31930993 2 3.40822193 + -118092.31104849 2 3.40804203 + 118093.31104849 2 3.23631062 + 68.16866536 3 4.68396906 +6 + -494.70169718 2 5.76331362 + 503.25343741 2 2.73098609 + -367021.57369848 2 3.66759371 + -1529686.47073208 2 3.83008505 + 1834642.13235417 2 3.78655002 + 62066.91317383 2 4.17980892 +6 + -73.83484449 2 5.20603747 + 79.00632901 2 4.70236432 + 1062.70264892 2 4.15470411 + -40873.21549348 2 3.08586486 + 43280.45283221 2 3.10363880 + -3468.93856436 2 3.63224008 + +Al GEN 10 2 +6 + 3.00000000 1 0.91821413 + -12.79791788 2 1.10715442 + 7.32796626 2 2.03989390 + -52053.92058080 2 2.04204466 + 52054.92058080 2 2.04199047 + 2.75464240 3 0.94029840 +6 + -42.72903905 2 1.99445589 + 47.15203530 2 1.12469986 + 3231.39534748 2 1.72843552 + -398.06113457 2 1.37872018 + 6652.21368423 2 1.92811339 + -9484.54780105 2 1.87995009 +6 + 830.07508675 2 1.87943518 + -827.97758021 2 1.42508183 + -1235.04705829 2 1.80941062 + -21.40768628 2 0.95469299 + 154.21154335 2 1.20079877 + 1103.24388863 2 1.53169350 + +Si GEN 10 2 +6 + 4.00000000 1 1.22418085 + 40.72596063 2 2.05337336 + -48.11509746 2 1.71412850 + -37.28006653 2 2.41395005 + 38.28006653 2 2.32084434 + 4.89672339 3 1.35299631 +6 + -7.68509694 2 1.13070385 + 13.98411213 2 1.16859753 + -116498.38332824 2 2.36994226 + -9121.48068622 2 2.16734100 + 31941.11999828 2 2.44879942 + 93679.74429067 2 2.32322104 +6 + 41248.64599856 2 1.86811003 + -41245.51022334 2 2.10179754 + -60.37864776 2 1.33467919 + 4180.55486914 2 2.29835912 + -142125.41164262 2 1.93345601 + 138006.23630568 2 1.99192523 + +P GEN 10 2 +6 + 5.00000000 1 3.71332384 + -13724.87406260 2 3.31759335 + 13714.20593187 2 3.65850189 + -19470.81568886 2 3.61426447 + 19471.81568886 2 3.37579099 + 18.56661922 3 2.21831587 +6 + -1411.99322697 2 3.20289077 + 1421.31824558 2 2.14807352 + 576236.74902855 2 2.65372234 + -397754.23263905 2 2.69778221 + -194403.08693812 2 2.58386669 + 15921.57087605 2 2.99361065 +6 + 64.03084909 2 2.59482433 + -58.63734715 2 3.43313766 + 365.80442210 2 2.95557705 + -12.13895471 2 1.75387879 + 158.27628825 2 3.69699906 + -510.94109430 2 3.15077203 + +S GEN 10 2 +6 + 6.00000000 1 2.51977085 + -84.83332404 2 3.22007986 + 70.54487302 2 4.71655238 + 3581.56671658 2 4.39998291 + -3580.56671658 2 4.41784559 + 15.11862509 3 2.54586294 +6 + -231.72652822 2 4.61819246 + 244.26248418 2 2.30938314 + -920.53494189 2 2.65072450 + 2410.83323256 2 3.31119070 + -2429.46016726 2 3.80226712 + 940.16251250 2 4.46824294 +6 + 957.88712772 2 4.48874898 + -950.12559451 2 3.37845034 + 6481.05990210 2 3.83307173 + -157.23448173 2 1.92699416 + 186.18956071 2 1.98946862 + -6509.01396292 2 3.99439281 + +Cl GEN 10 2 +6 + 7.00000000 1 6.06473582 + -454.17116717 2 5.57110302 + 436.13184861 2 5.26917938 + -712.97599461 2 4.62455647 + 713.97599461 2 4.94326867 + 42.45315074 3 3.47635853 +6 + 3561.38023524 2 4.48278574 + -3545.84042135 2 3.43372818 + -348465.51723117 2 3.74855830 + 12627.08188052 2 3.20650110 + 404246.19776785 2 3.70673786 + -68406.76197098 2 3.45681590 +6 + 19.30024745 2 3.79400952 + -9.26766424 2 3.06020678 + 508.81151546 2 4.47438492 + -7.59455659 2 2.43219723 + -757.15587217 2 4.97983429 + 256.93953188 2 5.71145786 + +Ar GEN 10 2 +6 + 8.00000000 1 3.61306766 + 326.13269394 2 4.01911273 + -346.66642426 2 5.31624938 + -7083.13498801 2 4.62848435 + 7084.13498801 2 4.70295676 + 28.90454131 3 3.84612203 +6 + 323.59441180 2 3.28236424 + -306.35028843 2 3.72212609 + -6283.46399338 2 4.23452843 + 435312.63926384 2 4.90386840 + 20087.00527001 2 5.30220051 + -449115.17955704 2 4.93088566 +6 + -2470.88386165 2 5.66191962 + 2481.68427537 2 4.62960722 + 48097.69821672 2 2.45115265 + -48060.46858390 2 2.45082141 + -1386.79918148 2 4.23753203 + 1350.57102634 2 6.12344921 + + + + diff --git a/data/pseudo/tn_df_sc b/data/pseudo/tn_df_sc new file mode 100644 index 00000000..aa3234af --- /dev/null +++ b/data/pseudo/tn_df_sc @@ -0,0 +1,292 @@ +Sc GEN 12 2 +8 + 9.00000000 1 18.44478556 + -28.08765281 2 1.72227091 + 6.39250114 2 38.78217945 + 135.57316128 3 4.25767220 + 30.42990876 3 30.59237471 + 732.69856731 4 3.04901650 + -839.18407578 4 3.26586693 + 306.02608763 4 19.55311974 +8 + -0.66275990 2 28.84167604 + 15.34001225 2 2.35022973 + -2135.70086146 3 2.36887926 + -272.32226474 3 1.53860208 + 2408.02312621 3 2.24659807 + 101.49528202 4 3.20659052 + 2308.19070504 4 1.65816906 + -2392.74854053 4 1.70062176 +8 + 253.56902450 2 1.38158346 + -244.79525414 2 7.79906720 + 613.28437434 3 3.46268859 + -167.40250936 3 1.44953060 + -445.88186498 3 4.19986338 + -558.92885001 4 2.84253773 + -139.52186395 4 8.10103826 + -860.39715397 4 5.29686620 + +Ti GEN 12 2 +8 + 10.00000000 1 22.29649672 + -72305.15340277 2 6.07562013 + 72279.39956641 2 7.08549167 + -5.38004642 3 1.85317121 + 228.34501358 3 11.48488557 + 72347.84359974 4 6.58565089 + -36.31015055 4 10.79509368 + 524.90430538 4 4.36759114 +8 + -1486.27686725 2 1.90199524 + 1504.05739312 2 3.17280244 + -346.63236251 3 7.28185273 + 297.60206194 3 1.60782556 + 49.03030057 3 31.70876802 + 1363.17044217 4 2.57136209 + 173.13661454 4 15.10326471 + 408.87838151 4 10.51280239 +8 + 770.58828172 2 4.79017059 + -760.06500844 2 16.39428027 + 4131.47101858 3 2.73641831 + -2.86068712 3 1.26533109 + -4128.61033146 3 2.75566672 + -4681.55429918 4 13.54811035 + -216.64417046 4 3.18165696 + -3871.27097394 4 7.38011991 + +V GEN 12 2 +8 + 11.00000000 1 7.61152016 + -2254.24090893 2 3.39807975 + 2224.02899636 2 6.97361870 + -110446453.80565737 3 4.55862146 + 110446537.53237911 3 4.55862102 + 3279.23908558 4 3.96488312 + 110445429.80748074 4 5.79893896 + -110440859.60674113 4 5.79892709 +8 + 793493.20383269 2 1.90936932 + -793472.27490442 2 1.96341714 + -208.86387558 3 5.49944355 + 258.48298732 3 4.42141770 + -49.61911175 3 2.27427679 + -42873.55595686 4 1.93670396 + -750668.26686351 4 13.81929388 + 750696.33209725 4 13.81951796 +8 + 563.75098077 2 2.73920868 + -551.25384718 2 8.34159772 + 565.60881231 3 6.86565518 + -552.54712531 3 7.02672916 + -13.06168700 3 1.72160118 + 766.15325384 4 5.21722741 + -1341.96583800 4 3.64504781 + -2478.29367021 4 6.45896159 + +Cr GEN 12 2 +8 + 12.00000000 1 37.30558989 + -31.65683900 2 2.72495980 + -3.82112970 2 82.35078893 + -1340.05228092 3 5.03605834 + 1787.71935961 3 8.49223479 + 1670.38275859 4 5.05934149 + -297.67363866 4 11.22316422 + -1773.64577915 4 12.78798168 +8 + 1321.32584937 2 2.01494487 + -1297.16280545 2 9.11769637 + 172456.79432585 3 2.74640213 + -172130.54143941 3 2.73601029 + -326.25288644 3 8.22966405 + 3318.19479259 4 8.93660753 + -4964.77333719 4 4.18996691 + -7518.15931266 4 8.08712175 +8 + 426.08303476 2 2.13852920 + -410.95463497 2 6.95873057 + -26339.61341213 3 10.51865586 + 27348.01671881 3 10.59655900 + -1008.40330668 3 12.57249470 + -1190.97633771 4 3.81958382 + -242.50982893 4 2.30397730 + -515.04540222 4 8.50147041 + +Mn GEN 12 2 +8 + 13.00000000 1 5.18371402 + -578541.89058487 2 5.06065032 + 578503.38848415 2 6.70792867 + -51913.84692424 3 6.17952209 + 51981.23520653 3 6.17539491 + 363344.02202434 4 6.42176078 + 267112.71548476 4 5.85884127 + 322304.52239107 4 5.30004030 +8 + 1419.16815158 2 2.36735511 + -1393.80593768 2 10.44777616 + 90835.30824196 3 3.38832573 + -87236.54130341 3 3.33976449 + -3598.76693855 3 4.59371397 + -6244.54083570 4 4.53305698 + 1227.60592152 4 6.80451212 + -6185.56255228 4 8.40561309 +8 + 4024.75281098 2 2.94114594 + -4009.68099577 2 7.86104996 + 6036.24229971 3 5.47734943 + 597.55987937 3 7.26632213 + -6633.80217908 3 5.64966653 + -8536.73955532 4 4.35053539 + -2120.81538582 4 3.10976563 + -9025.36229250 4 6.88076377 + +Fe GEN 12 2 +8 + 14.00000000 1 5.12237041 + -40.17016318 2 2.51511645 + -1.31093574 2 68.88205922 + 233.53970769 3 8.04518971 + -161.82652195 3 11.87602774 + -1791.82033120 4 5.09693593 + 1599.45078669 4 4.72210640 + 1.03695301 4 1.70594204 +8 + 26.70612465 2 1.98046097 + 0.57578912 2 129.99498266 + 3039.39666376 3 2.39996246 + -3165.32503397 3 2.43500497 + 125.92837021 3 5.42607639 + -291.65810402 4 8.00515516 + 391.88052787 4 5.38996549 + 27.51771082 4 21.57361672 +8 + 624.99065580 2 2.73200743 + -610.14663705 2 8.14205971 + 1017.89543597 3 6.81776145 + -40.92293045 3 25.88593190 + -976.97250552 3 5.88766735 + -1433.26030940 4 3.94271278 + -167.70300401 4 2.68547503 + -1659.40792313 4 8.24853344 + +Co GEN 12 2 +8 + 15.00000000 1 7.54679164 + 144513.79744165 2 3.67362404 + -144558.25171900 2 4.84501436 + 107.53071842 3 2.40342575 + 5.67115611 3 26.17864786 + -58433.23776581 4 3.80837544 + -86187.09039425 4 4.51680318 + -24877.11683436 4 4.40937071 +8 + 95.23258759 2 2.24610518 + -66.50913381 2 5.03497074 + 5039.10184384 3 3.22714612 + 106438.82887427 3 4.39051698 + -111477.93071810 3 4.34028955 + -3416.23892647 4 3.35420522 + -108155.92422115 4 5.08283495 + 111451.19401338 4 5.04411598 +8 + 595.60664332 2 4.48956443 + -581.05689813 2 7.69628175 + -1377.49199281 3 3.90883087 + 825.53641688 3 4.85597858 + 551.95557593 3 2.42496884 + -403.44284159 4 2.48937518 + 360.79216631 4 7.08237042 + -1755.31252545 4 7.01264199 + +Ni GEN 12 2 +8 + 16.00000000 1 7.69817381 + 1050.11428773 2 7.53303210 + -1144.28791364 2 25.60798551 + 13641.04856576 3 13.90272560 + -13517.87778478 3 14.02243059 + -99.93959073 4 5.40919366 + -14590.22326277 4 19.39187326 + -6702.20081903 4 10.04177364 +8 + -137324.04248861 2 3.00959957 + 137399.59146577 2 2.97820277 + 137895.50489379 3 3.20429852 + -1036.38091066 3 8.22563766 + -136859.12398313 3 3.17346613 + 1370.72380067 4 18.22958633 + -904.80564965 4 6.63637638 + -4552.45338879 4 4.01705177 +8 + -315.28909178 2 15.14825706 + 371.76324185 2 5.57172908 + 471.27416207 3 2.88437623 + 165.43855728 3 3.75784965 + -636.71271936 3 3.41699124 + -172.18113847 4 5.67830819 + -148.24251004 4 2.70288433 + -2384.29249546 4 8.91177457 + +Cu GEN 12 2 +8 + 17.00000000 1 14.72121260 + 0.43564135 2 173.23217215 + -51.26559465 2 2.58024469 + 3.82433122 3 80.09883693 + 246.43628291 3 9.08368916 + 6456.72306266 4 4.49885474 + -6459.98303523 4 4.56436500 + -53.55070822 4 20.14135032 +8 + -7.61322720 2 104.42478595 + 38.51618543 2 3.64199543 + -12.00344193 3 52.46064977 + 288.99573247 3 4.33410703 + -276.99229053 3 8.38373584 + 876.14551285 4 3.01347300 + -1144.52462196 4 3.25680498 + -386.35474053 4 59.52152812 +8 + 142.97388030 2 48.08520852 + -128.80933064 2 49.90034500 + -186.15554307 3 11.18440029 + 180.45159943 3 5.04653753 + 5.70394364 3 85.01391269 + 101.90155258 4 3.06268644 + -238.17133323 4 3.55821337 + 583.56858981 4 22.24622222 + +Zn GEN 12 2 +8 + 18.00000000 1 16.25309578 + -62.06001046 2 3.04359000 + 8.22443626 2 52.31604625 + 284.31836352 3 4.12635237 + 8.23736049 3 129.68855961 + 11442.99692797 4 7.94323624 + -11664.25528103 4 7.74821809 + 462.64311342 4 34.44853266 +8 + 140.30017448 2 3.16683649 + -108.24959569 2 14.80839343 + 88.79372352 3 43.94225321 + 949.52154936 3 3.34122685 + -1038.31527288 3 8.34153430 + 780.81282740 4 18.34782011 + -1958.42831296 4 4.00418064 + 18.92059615 4 597.07325481 +8 + 664.93623774 2 5.16678579 + -651.12455824 2 11.88724380 + 930.96426186 3 7.96788974 + -913.07841414 3 5.27302550 + -17.88584772 3 127.63757255 + 3275.61040524 4 37.54266998 + -3957.43240479 4 9.90068894 + -3622.67126499 4 37.33250038 + + + diff --git a/data/pseudo/tn_hf b/data/pseudo/tn_hf new file mode 100644 index 00000000..a036558a --- /dev/null +++ b/data/pseudo/tn_hf @@ -0,0 +1,785 @@ +H GEN 0 2 +6 + 1.00000000 1 33.97261756 + -5.73227574 2 41.31028903 + -0.09126064 2 25.25940941 + -20.89980944 2 22.55290552 + 21.89980945 2 32.44131356 + 33.97261756 3 21.12884239 +6 + -792.10375913 2 18.05333002 + 788.69064150 2 28.72271273 + 243.76232429 2 17.34000000 + 1971.45741618 2 20.31094085 + -1795.56663560 2 22.08154655 + -418.65661775 2 30.98799599 +6 + 20.17177614 2 43.35000000 + -21.74798121 2 30.58059209 + 81.48044293 2 43.35000000 + -250.69197995 2 42.07548166 + 88.72115024 2 36.90496619 + 81.48044293 2 43.35000000 + +He GEN 0 2 +6 + 2.00000000 1 20.98762121 + -33.61186426 2 22.14709418 + 24.51669349 2 23.61790706 + 130.14113834 2 15.38761786 + -129.14113834 2 14.22621787 + 41.97524242 3 12.59257273 +6 + 1056.41263785 2 13.17618363 + -1062.28560366 2 23.62254131 + -463.87351954 2 12.04168890 + -676.20404915 2 15.14280380 + -595.21618656 2 19.81607243 + 1736.29130578 2 22.34342328 +6 + 428.21432838 2 21.71652417 + -430.31401911 2 12.32378638 + 7327.65357096 2 14.04426129 + -7501.20178041 2 14.34477832 + 827.37705616 2 17.58948890 + -652.83515208 2 21.22706329 + +Li GEN 2 2 +6 + 1.00000000 1 0.78732101 + -2.23995793 2 0.79224763 + 0.10336496 2 1.79622268 + 4.26591073 2 1.83637465 + -3.26591073 2 1.91213904 + 0.78732101 3 0.79291624 +6 + 256.06005883 2 1.78312879 + -255.07112703 2 0.95553059 + 89.99417499 2 0.87617279 + 271.48958394 2 1.09621549 + -180.35430387 2 1.43900642 + -180.12948429 2 1.83085147 +6 + -6.15265886 2 1.51120608 + 4.70876577 2 0.76936375 + -145.31681550 2 0.76874061 + -238.21930857 2 0.99080928 + 219.67347903 2 0.80457655 + 164.85986038 2 1.07164892 + +Be GEN 2 2 +6 + 2.00000000 1 1.20639978 + -5.40210132 2 1.18425537 + 1.72285109 2 2.81826911 + 2.83477794 2 2.37513515 + -1.83477794 2 2.82920954 + 2.41279956 3 1.18219335 +6 + -1045.56923435 2 2.59240549 + 1047.78889524 2 1.41686040 + -1899.02207714 2 1.48536195 + 1398.02036098 2 1.70076266 + -696.17508584 2 2.03898393 + 1198.17691383 2 2.57766021 +6 + 630.77503458 2 1.84421403 + -632.64959849 2 1.13419132 + 441.30858401 2 1.13393716 + 435.76647651 2 1.22419150 + -353.48689426 2 1.39760436 + -522.59133089 2 1.88595068 + +B GEN 2 2 +6 + 3.00000000 1 2.72292969 + -11.77602579 2 2.41356794 + 5.22133296 2 4.60628004 + 0.40709712 2 3.81569642 + 0.59290288 2 4.75281449 + 8.16878906 3 2.42655010 +6 + -259.65579181 2 2.54943794 + 264.77623108 2 4.54559309 + 79.19161122 2 2.15270531 + -59.67150303 2 2.71820746 + 4276.39654293 2 3.54458188 + -4294.91608677 2 3.65732479 +6 + 236.40878048 2 3.85965228 + -239.02058908 2 2.15130911 + 4065.68265375 2 2.50786619 + -4354.92616892 2 2.58144728 + 782.08428825 2 3.14947869 + -491.84514677 2 3.69136935 + +C GEN 2 2 +6 + 4.00000000 1 6.85924392 + -68.83281650 2 7.67473342 + 58.31001518 2 8.89832626 + -5.23010100 2 4.63334409 + 6.23010100 2 5.40036758 + 27.43697568 3 6.78357071 +6 + 15927.37261280 2 7.83879438 + -15918.16480090 2 5.19308059 + 2266.75441213 2 7.53204263 + 199.75030501 2 9.76960112 + 15915.92435302 2 5.19521204 + -18381.42723477 2 7.82847044 +6 + -153360.42295057 2 4.77965478 + 153356.81223147 2 7.75552602 + -369415.66050006 2 7.39994991 + 152547.92039307 2 4.77641318 + -50035.07991665 2 8.01352516 + 266903.80850142 2 7.30461659 + +N GEN 2 2 +6 + 5.00000000 1 11.01983025 + -745.67280403 2 7.70260962 + 729.30210222 2 7.83791198 + -3.61639106 2 8.41784728 + 4.61639106 2 12.53426384 + 55.09915126 3 6.76845507 +6 + 190.73305357 2 10.95092720 + -176.25003778 2 7.48977970 + 138618.50426238 2 6.17989888 + -156031.83911197 2 6.21713643 + 33624.66842989 2 6.84042808 + -16210.33273520 2 7.23938652 +6 + -6963.78021671 2 6.00000000 + 6959.42174113 2 6.82157159 + -1881.92821431 2 8.95497565 + 13576.39988827 2 6.21477468 + -14307.35309373 2 6.69426410 + 2613.87687182 2 8.63240466 + +O GEN 2 2 +6 + 6.00000000 1 8.86965578 + -28.03502457 2 6.05347085 + 11.15565054 2 5.51487970 + 180.73182495 2 10.77996678 + -179.73182495 2 10.23800841 + 53.21793471 3 7.90307811 +6 + -9301.89903913 2 7.28355994 + 9316.57793048 2 6.06026884 + 59864.04331135 2 10.82203807 + -5153.55178109 2 5.75221581 + -94673.29831259 2 10.51025188 + 39963.80850689 2 9.71187643 +6 + 1682.75815189 2 6.93414347 + -1694.05800561 2 5.70161443 + 848.47217112 2 5.90927487 + -8787.11179775 2 8.69956320 + 7632.94108771 2 8.89513889 + 306.69604455 2 4.97067782 + +F GEN 2 2 +6 + 7.00000000 1 16.52363418 + -6.34751135 2 13.25777643 + -15.15415075 2 18.76649923 + -34.29784879 2 10.97564997 + 35.29784879 2 21.10568925 + 115.66543928 3 13.45706123 +6 + 3851.10542697 2 18.85020393 + -3832.40250429 2 12.48878559 + -237433.87385812 2 13.23599298 + 4380.91891820 2 11.79852686 + 240164.95590264 2 13.28196243 + -7110.99868861 2 17.38283172 +6 + -154.12048513 2 8.59949907 + 138.11297468 2 9.44224375 + 90.42851925 2 8.92886754 + 24.83173716 2 10.18592724 + -424.59591732 2 14.47166344 + 310.33244840 2 16.45175456 + +Ne GEN 2 2 +6 + 8.00000000 1 21.65168713 + 1792.30188007 2 14.45374325 + -1826.14661180 2 14.11313946 + 24.26469360 2 14.10779016 + -23.26469360 2 20.42281751 + 173.21349705 3 11.94458523 +6 + -3233.03788910 2 12.39056574 + 3263.09949012 2 20.60119535 + 1065.47298248 2 11.30677784 + 846.05067282 2 12.27737462 + -34052.05079344 2 17.82669542 + 32141.52790433 2 17.34318949 +6 + 64989.42116117 2 20.31242587 + -65003.08394100 2 20.05277414 + -486.55828399 2 12.87396775 + 2895.04182579 2 15.84533388 + -261.91821074 2 19.42277681 + -2145.56672184 2 23.82700477 + +K GEN 18 2 +6 + 1.00000000 1 0.68724959 + 7665.13435390 2 0.62381187 + -7668.26785841 2 0.59278246 + -3877.60874288 2 0.63961163 + 3878.60874288 2 0.57860350 + 0.68724959 3 0.50008691 +6 + 477943.00813868 2 0.60446875 + -477941.36080643 2 0.55281419 + -533027.54468668 2 0.57763214 + 644866.44840953 2 0.56624742 + -347063.87255621 2 0.60823749 + 235225.96911606 2 0.54903924 +6 + 5177368.01138896 2 0.56835236 + -5177366.94506877 2 0.57395949 + 479730.23987439 2 0.65183506 + 1027151.48932830 2 0.60393420 + -737636.25038898 2 0.55451546 + -769244.47868615 2 0.64345811 + +Ca GEN 18 2 +6 + 2.00000000 1 1.02097432 + -10036.20006734 2 0.76570985 + 10030.67757963 2 0.83608195 + -8136.00883920 2 0.84362927 + 8137.00883920 2 0.75729596 + 2.04194863 3 0.94514267 +6 + -34706.02643508 2 0.85912364 + 34710.12533681 2 0.50000000 + 860.68953329 2 0.79227941 + 33806.87817612 2 0.85997136 + -34747.30927870 2 0.50004940 + 80.74228959 2 1.01833438 +6 + 514.89542915 2 0.50045897 + -511.93073005 2 0.57886998 + -1374495660.24999190 2 0.50000000 + 687246875.87136328 2 0.50000000 + 595.96081232 2 0.56402502 + 687248189.41960287 2 0.50000000 + +Sc GEN 18 2 +6 + 3.00000000 1 8.57059896 + 39.59298139 2 7.59719947 + -67.37349200 2 5.06179469 + 3.54689568 2 11.85222547 + -2.54689568 2 0.70815643 + 25.71179688 3 5.04858060 +6 + 414.99811890 2 5.58945823 + -389.30527335 2 5.93611719 + 8.74915776 2 0.56803113 + -23.92388226 2 0.60868170 + 42.12589000 2 0.76957270 + -25.95178014 2 1.21300456 +6 + 87.05758924 2 1.12946939 + -62.19670511 2 8.56362761 + 66.37833241 2 7.27494713 + 16.41391965 2 0.74327556 + 43.70031508 2 2.03252459 + -125.49197853 2 1.19227023 + +Ti GEN 18 2 +6 + 4.00000000 1 4.77516915 + 28.34758957 2 10.86929502 + -63.21363466 2 5.37319310 + 5.17935660 2 6.86168513 + -4.17935660 2 0.95669336 + 19.10067660 3 3.52162434 +6 + 211.66189616 2 7.01854391 + -179.82099411 2 1.03880358 + -185.28466640 2 8.02474194 + 43.44334388 2 1.22490803 + -44.06205312 2 0.73917909 + 186.90335758 2 0.89595855 +6 + 49.26886952 2 4.65596397 + -18.32131307 2 12.03001514 + -5.50633295 2 2.16547114 + -342.25486254 2 0.92182600 + 304.90681508 2 0.90099079 + 43.85505055 2 0.99684289 + +V GEN 18 2 +6 + 5.00000000 1 7.54069430 + 35.58763613 2 13.63949328 + -78.03044429 2 6.35551182 + 6.53716910 2 2.59423528 + -5.53716910 2 1.16176108 + 37.70347150 3 6.00940761 +6 + 194.57815114 2 8.18606241 + -156.25972501 2 0.95585889 + -162.29334861 2 9.81441300 + -7.74379387 2 0.70017858 + 244.84040986 2 0.97854682 + -73.80312462 2 1.14925292 +6 + 58.91069981 2 5.48333809 + -21.55840127 2 14.40777862 + -10.12891199 2 2.12080402 + 2.52953175 2 0.69388688 + 109.28174657 2 1.01378564 + -100.68144081 2 1.02780261 + +Cr GEN 18 2 +6 + 6.00000000 1 5.86829616 + -3.09900314 2 0.98487638 + -44.94655388 2 6.96616660 + 135.46731129 2 13.59887742 + -134.46731129 2 11.34882544 + 35.20977696 3 8.91110617 +6 + -526.12421414 2 1.73784849 + 568.24328209 2 32.55674074 + -4019.88240027 2 29.55364033 + 495.64908693 2 1.64707294 + 3445.48735974 2 29.05037955 + 79.74580069 2 3.85284016 +6 + 31.31844062 2 19.50625909 + 10.30743573 2 0.86978393 + -81.88780266 2 15.20370471 + 461.22634080 2 10.28610919 + 1.00599253 2 29.84121604 + -379.34381792 2 10.93761710 + +Mn GEN 18 2 +6 + 7.00000000 1 15.05016398 + 76.91199595 2 15.84783194 + -135.08366030 2 9.80426007 + 5.12036990 2 21.62193241 + -4.12036990 2 1.26331891 + 105.35114786 3 9.24698903 +6 + 4.45077705 2 37.07900996 + 46.93892122 2 10.09409180 + -59.63952162 2 18.98557107 + 47.25376130 2 10.16267391 + 2270.38024432 2 0.79460121 + -2256.99438460 2 0.79345224 +6 + 43.65884288 2 39.18960573 + 6.58957965 2 5.88646925 + 273.41973132 2 12.35978155 + -27.85882166 2 45.92825074 + -255.64090683 2 15.10051906 + 11.08093098 2 0.96083847 + +Fe GEN 18 2 +6 + 8.00000000 1 20.13246747 + 61.79343671 2 20.09868712 + -128.55600523 2 10.70685691 + 4.84472314 2 28.79726611 + -3.84472314 2 1.31374323 + 161.05973977 3 11.74858936 +6 + -20.21006220 2 30.42214774 + 78.68908034 2 10.18491881 + -104.38370168 2 6.69228251 + 11879.61125830 2 2.98725076 + 4067.63536025 2 2.63900793 + -15841.86182474 2 2.88538957 +6 + 52.35701571 2 38.26448010 + 4.85142656 2 5.90250183 + 2169.08154283 2 14.09502191 + -40.04038813 2 42.65213493 + -2140.34005623 2 14.44188153 + 12.29991314 2 1.06050818 + +Co GEN 18 2 +6 + 9.00000000 1 18.31609159 + 47.84627034 2 26.91264651 + -123.98809879 2 11.91957078 + 5.09540361 2 38.50128360 + -4.09540361 2 1.45636943 + 164.84482431 3 13.41744556 +6 + -22.55314559 2 34.07535172 + 88.75521276 2 10.45260699 + -158.32924566 2 5.91087540 + -53402.80058080 2 3.13684604 + 49767.17959800 2 3.16692544 + 3794.95155282 2 2.81533596 +6 + 61.92019742 2 38.11279103 + 2.85881103 2 5.82898971 + -387.27158530 2 15.59733227 + -64.65478412 2 38.57519906 + 439.30094674 2 13.98109833 + 13.62664636 2 1.17046441 + +Ni GEN 18 2 +6 + 10.00000000 1 19.84291404 + -195.32353012 2 16.02128656 + 108.98533897 2 26.59513762 + 6.08469364 2 39.39261550 + -5.08469364 2 1.73812596 + 198.42914037 3 16.63287860 +6 + 636.14358475 2 21.00974643 + -561.54325704 2 22.88188409 + -146.65571659 2 11.08963477 + 1590.91833845 2 2.66405882 + 203.15470938 2 6.84512029 + -1646.41568069 2 2.74451213 +6 + 67.70992628 2 28.31556957 + 5.37743585 2 4.16521410 + 374.49405320 2 17.37825451 + -389.83846114 2 21.96153313 + 1.91671522 2 49.74424984 + 14.42906054 2 1.27579002 + +Cu GEN 18 2 +6 + 11.00000000 1 35.47715926 + -18105.91023962 2 21.73013363 + 18011.23386368 2 21.83870561 + 6.01228206 2 18.42008793 + -5.01228206 2 1.78198604 + 390.24875182 3 20.58922180 +6 + -51.41016015 2 31.92243640 + 131.47547623 2 14.07215286 + -100490.54220540 2 4.21909683 + 20675.75763691 2 3.56801887 + 263590.56712535 2 4.06536588 + -183774.78117039 2 3.92650866 +6 + 68.62159615 2 31.47726702 + 10.70810140 2 4.95987737 + 233.01753836 2 17.95562228 + -258.78181256 2 26.97191776 + 12.01106739 2 46.85069031 + 14.75422657 2 1.35614623 + +Zn GEN 18 2 +6 + 12.00000000 1 26.60492300 + -196.98442222 2 17.93401272 + 89.18558790 2 36.25784521 + 6.19159911 2 49.96784160 + -5.19159911 2 1.99109193 + 319.25907600 3 19.77027094 +6 + -177.37971474 2 32.01501166 + 269.42130045 2 23.08836163 + 60361.29701582 2 4.67975974 + 1343973.13568915 2 5.29114502 + -619902.07009680 2 5.11539109 + -784431.36064381 2 5.38368747 +6 + 46.22045015 2 19.08371294 + 43.98275320 2 50.00000000 + 103.59052598 2 16.88459979 + -129.86700605 2 37.83300205 + 11.83058445 2 5.11918008 + 15.44716451 2 1.45112568 + +Ga GEN 28 2 +6 + 3.00000000 1 1.29464779 + 1852.96920182 2 1.20541500 + -1856.15440251 2 1.17879070 + -513.51787928 2 1.21964580 + 514.51787928 2 1.12868888 + 3.88394338 3 1.06946118 +6 + -10.41248284 2 0.75266853 + 13.44253658 2 0.82344143 + -163070.82529640 2 1.96346903 + 118782.06261627 2 1.90761481 + 72439.51450979 2 2.00432013 + -28149.75180125 2 1.83309310 +6 + -55.43707314 2 0.98715132 + 55.68679311 2 1.18143237 + 95.35935510 2 1.24163917 + -111.55606197 2 1.48647971 + 6.22134153 2 1.87957113 + 10.97737885 2 2.24689865 + +Ge GEN 28 2 +6 + 4.00000000 1 0.64699203 + 1042.65966555 2 1.17600365 + -1045.50742663 2 1.40672708 + -522.21837337 2 1.06148136 + 523.21837337 2 1.52689039 + 2.58796812 3 0.70634661 +6 + 298.52031462 2 1.37488700 + -295.91758286 2 3.05395101 + -65778.83466330 2 1.99750874 + 253302.61962618 2 2.10159773 + 25864.29161720 2 2.35028323 + -213387.07659768 2 2.16152517 +6 + -1416.87913796 2 1.43279054 + 1416.49405157 2 1.27947333 + -4677.12774504 2 1.39756889 + 6758.57740664 2 1.50728327 + -2630.12555402 2 1.70834188 + 549.67778384 2 1.92912262 + +As GEN 28 2 +6 + 5.00000000 1 1.90897798 + -8.55267316 2 1.59326524 + 3.44617934 2 1.10844459 + -8.94709126 2 1.02625257 + 9.94709126 2 1.90897549 + 9.54488990 3 1.18318262 +6 + -299.57003383 2 1.31601774 + 303.89084920 2 0.88992491 + 34018.91875930 2 0.82417957 + -44808.38727678 2 0.87058735 + 19528.43031171 2 0.91644709 + -8737.95845690 2 0.77833472 +6 + 46094.50987530 2 1.90902784 + -46093.10097169 2 1.56895782 + -1934.82978262 2 1.41134047 + -240427.05172601 2 1.84187044 + 36043.17172862 2 1.53235052 + 206319.71069040 2 1.81590910 + +Se GEN 28 2 +6 + 6.00000000 1 1.73885845 + -4868.76631948 2 3.10952817 + 4860.07291481 2 2.76656612 + 247376.94576273 2 2.93723435 + -247375.94576273 2 2.93039894 + 10.43315069 3 1.80783830 +6 + 43.48906338 2 1.54256367 + -36.07303722 2 1.99876644 + -1338.16209913 2 2.22244851 + 88855.15492433 2 3.01653570 + -93322.17292948 2 3.00370283 + 5806.18068397 2 2.62760372 +6 + 101.24952978 2 1.51703915 + -96.89194467 2 1.50669503 + -561.81915381 2 2.17759706 + 1474.30831735 2 2.47900419 + -87533.83638244 2 3.02701983 + 86622.34849171 2 3.03071493 + +Br GEN 28 2 +6 + 7.00000000 1 1.29861066 + -8.22129971 2 1.15959643 + 0.21335410 2 2.29768788 + -14617.16154553 2 2.88622041 + 14618.16154553 2 2.88664159 + 9.09027461 3 1.38987227 +6 + 1993.56030565 2 1.99554365 + -1988.14839885 2 2.18330258 + 62338.94920254 2 2.78298975 + 91516.94063906 2 2.50252605 + -109846.25447802 2 2.70576408 + -44008.63516555 2 2.38434210 +6 + 17.36412726 2 1.29580803 + -14.67327121 2 1.60078690 + -6128.76923065 2 2.16344915 + 12563.02678529 2 2.26961184 + 757.63553722 2 2.83383736 + -7190.89195704 2 2.41971949 + +Kr GEN 28 2 +6 + 8.00000000 1 6.82429532 + 2245.94610147 2 4.82301962 + -2257.24927570 2 3.38163452 + 1889.52842356 2 3.29088128 + -1888.52842356 2 4.98656184 + 54.59436254 3 3.01373570 +6 + -2003.10975854 2 6.01573226 + 2010.79212346 2 4.07497664 + 13467772.94730707 2 4.47273823 + -18464141.82809087 2 4.45030979 + -2607955.84552628 2 4.28291762 + 7604325.72641131 2 4.35368575 +6 + -6512.57971257 2 5.33963561 + 6517.54562224 2 4.41831473 + 55170.14413687 2 3.66247372 + -35314.20447418 2 3.56293692 + -27094.88743738 2 3.99199621 + 7239.94695795 2 5.23539786 + +Al GEN 10 2 +6 + 3.00000000 1 0.90167530 + -12.07740634 2 1.08338853 + 6.60507677 2 2.07851308 + -13877404.00590185 2 2.08053590 + 13877405.00590186 2 2.08053570 + 2.70502591 3 0.92748596 +6 + -41.26842670 2 2.04866185 + 45.70193781 2 1.11866688 + 2946.69575922 2 1.71721106 + -376.01922297 2 1.36753958 + 4331.41613799 2 1.93292012 + -6901.09265568 2 1.86705782 +6 + 504.79904464 2 1.88548919 + -502.69536383 2 1.42616967 + -769.46860271 2 1.80548694 + -17.66088618 2 0.95520911 + 101.43853505 2 1.20112583 + 686.69150206 2 1.52824179 + +Si GEN 10 2 +6 + 4.00000000 1 2.54461774 + -2902.58084906 2 2.24978528 + 2895.18838752 2 2.53789008 + 7161.72254279 2 2.34887222 + -7160.72254279 2 2.46336277 + 10.17847098 3 1.52421025 +6 + 4.24352962 2 1.08064949 + 2.05989979 2 1.33341749 + 88608.14855737 2 2.39993059 + -849.93508619 2 1.92845396 + -1434647.87047626 2 2.35634772 + 1346890.65714548 2 2.35320332 +6 + -15264.86061936 2 1.82998100 + 15267.99758945 2 1.91566514 + -0.49522434 2 1.35066217 + 2807.17037795 2 2.16756956 + 6912.45723497 2 1.79762600 + -9718.13169060 2 2.03990309 + +P GEN 10 2 +6 + 5.00000000 1 2.20104239 + -14571.76154266 2 3.30954781 + 14561.08785293 2 3.65491917 + -21023.88213100 2 3.60582863 + 21024.88213100 2 3.36814532 + 11.00521195 3 2.06883762 +6 + -214.99423753 2 3.00175595 + 224.31212541 2 1.90508764 + -1320.42895216 2 2.23252373 + 2262.27394007 2 2.56842585 + -5217.11058123 2 3.22957222 + 4276.26614237 2 3.32169865 +6 + -4655.41288683 2 1.51251059 + 4660.80718311 2 1.51289861 + -994.25816078 2 3.31761981 + -19.30793578 2 2.04639527 + 311.57919748 2 3.70626860 + 702.98798215 2 3.09154453 + +S GEN 10 2 +6 + 6.00000000 1 3.76431332 + 518.21506704 2 2.91975646 + -532.35656437 2 2.26777538 + 14394.84387811 2 2.49556645 + -14393.84387811 2 2.51698479 + 22.58587994 3 2.71241239 +6 + -104.19902150 2 4.55895180 + 116.57081427 2 2.10503756 + -994.81335242 2 2.63814508 + 2203.13414043 2 3.11140569 + -1617.61176296 2 3.62963239 + 410.29160018 2 4.55921172 +6 + 723.09548214 2 4.48128068 + -715.46568241 2 3.35956681 + 9063.41201304 2 3.83857196 + -16.38228027 2 1.92699416 + 44.06704522 2 2.30670170 + -9090.09577098 2 3.92706305 + +Cl GEN 10 2 +6 + 7.00000000 1 4.77392870 + 719885.76609499 2 4.74019033 + -719903.82223984 2 4.74189768 + -37102.89380181 2 4.67979490 + 37103.89380181 2 4.71510215 + 33.41750090 3 3.29732864 +6 + 959.05010082 2 5.01134618 + -943.54843009 2 3.64529189 + -6456.16063099 2 4.20510279 + 637.70704529 2 2.74283267 + -1479.66774202 2 3.00605599 + 7299.12201388 2 3.90198120 +6 + -121.63220275 2 3.86324469 + 131.70125226 2 3.08695111 + 5447.27282828 2 5.92092153 + -52.94814165 2 2.63467524 + 559.83762330 2 5.08437179 + -5953.16139883 2 5.86183616 + +Ar GEN 10 2 +6 + 8.00000000 1 5.17746158 + -76.72264736 2 5.90884243 + 56.16280755 2 3.53735685 + -660.63282107 2 4.53072721 + 661.63282107 2 4.90879705 + 41.41969264 3 3.95156133 +6 + 496.48392385 2 3.21092458 + -479.29969508 2 3.39224537 + -12086.26924659 2 4.28061928 + 37151.97923364 2 4.62803105 + 496310.90908097 2 5.10487541 + -521375.61810527 2 5.08995306 +6 + -1901.02320099 2 5.53714820 + 1911.87432982 2 4.52372637 + -127.53875733 2 2.45115265 + 198.78501467 2 2.62001527 + -976.26297293 2 3.97593759 + 906.01814260 2 6.12659776 + + + + diff --git a/data/qp.png b/data/qp.png new file mode 100644 index 0000000000000000000000000000000000000000..777e5ac0cc72347072c2ac8464e868dd05b17c24 GIT binary patch literal 42781 zcmV*WKv}Oospf02y>e zSad^gZEa<4bO1wgWnpw>WFU8GbZ8()Nlj2!fese{03ZNKL_t(|+U&hokYw3;=l473 zT$8@CT-)ldaU2H>W?(oV7KQ>r03w&cSSZL3l z2X3s9Vin6JxdcUmSc2jZ0AU7WyJy-|S5tp8T9bN#nLGTgZaK(+l8psBQ<{6}tW{-1iaxyLu_ zV{nMap#O-0d${orgPrTYKis}S9BdE|H;?rhesh7w+$X8D7ypqz_2fTw+{)t{`xx|( zj}rs#-5b9j?A{<8Y>)(-kLJs?p+56GmG&a_`A>>U>(b)|cntc-$D=yp!6xx=yl(h#)=ny)>eLg|=3b;a^@OOjEiNpQ!H2;3)SMJvrqRN9MFT8q?XKOxj(e&8|aKdML2 zSt1#3?8N=`si1q4c(7i8TYtpwcX4$B1Oid|-DnMJ9>4iCj@O`h_PNEznP-+B@0iD+ zKULt42kRyoY|z_!leoVDX?P;f^^pr30dfR!5RgVG=`dh89FPVv#&Pi~O?i{#0+-3q#{KM0SJUBZ+LOc4^2;( zHWvap0eFKT2}9CeNEi)>1_{b@k!}sYQbVZA_!vU44Gc?Y= zK=aJcG5f@;LV2~vo9{8`Kcpkwh2D1!fbMq~bhionL%Q89;v_;MFhU?Q^Y*?4!3QSA zjv#O{u*yl02Sbv6L>LT6VvSNR((_Sn1;_CanXzvW7@ge@sqJ%mbU&n0qYt*vAP~gq zfM_^C4+kV^Ol9gE?Zwa2I{(~m>)i8g=dmDo4Ejfk^*Cg(bNwIgtp51-XPZN6XU{@v ztQVW#!#E=9?l2tm81#4O?Q{@|%nF#W22PkDCw_IER(yGOt`n2h2RN}zRN~!h% z2W)S4*x207@19j#+F;Pk&(E`Pd4c&eXSuj|8QE%E0bok{EslwHcNhje2E82yyIoLX zw3#z7$&&xP$ESXfpxhp}!~UMeA#o6q1QBsCLPINi?Fj~qV5vW?oHxw`_T8R9CSh;MWzXbU~6lKZg0T$PKV949pY4% z1cAY5LvyOh-25DuE?;JTexCLdPhnM?8MAYBr^{fFaRY;G(l8pi0~6X`7{NG;c5f{% z_95Y-;Se3i41$e=N)u^K$p2%Uk}q!ye2A|*+avA@sX zH!0MLTbhGEG5HxGv_UFCrP;)9HmJ6$xV2^`WDWVg-fw@qm1+FeB3^5eO6&5+P7r*g zK_3sdh&oHJhn=OD;_ec|?yU#o8Xh)fYB4gTlO~wK{^bGgODf+ zNcz^2(MlqW0iB!V`+!g9!eVlt=**-S7VO2BGiJt{oG26&nz?Mfh;099J+8rXz~?WR z#2`IMrQX1ws!^>qaO>6Lo|X5p$?xSc4zIaDrFof3YjMe&T3qz1Gmk-k@`<*9sI&B? zsJHZ&!;QCz`zw!{`5Hr<%ouz7oFqv@dffp#oemr8`?v&HYhZqUj`?%*T)4Qv{JFE# z&YlBpN^XG$1G?9zKiDQ32K4*eBw^# z&A#qJ23HE@Jo)+onz{Hr698K4L*F+7ycxYi8&Yk*)A1CZU#HS;P^s4N>NSKhq{b9~ z3;C^j`1{yzUZghr0$%g-ulcRTKm4d<6rNhphn*FIt+!0ry+yEn^#So~9=afqnKd8^ z!cNld_t@FmWplg3_Ewi5jP_UquIqB)@&)G4o#W!d0<%v(Y1LjX1agg<#6*KG!JtpS z+r#nO_>Bde>O66Om(IpjdK)+Bt}h{lDnL(a8FQg?-EL_$J#jA{Dd00TZn7^j*?Xn$ zQmNOeH=B6PDz58i=Q0lRw4}*D=%#HYnet+N@ElHwuvFnS+HDaDZQa5)NZPNFRS{k=pF@_*09gLJ*ud z(8s|R(eBdg!PYx3g`FjmX!}E4)kh!*CU}8d2v}{K(An*=-RZEov0JzVjcSEP&8OEN z5XUL!&dzaex6@%?n2D`WD ztX-qCc8#RJYuR@rtu+7`A+ux}3-~e}co5)CDbXhftI!1pk5mqoW}RxYNwrZ$xqjh} zjPFD9!1q4=5cjp~PvcE3;x(;B;8tcHgMQ?PhlE>izaDmPy%hGANP0)}!#@f|D`TvB z$psJ^bP^E73F$B*3WxTZQ&S3I8Pa`-Gl4(|2OJO2tD-73oQkyqJimeR8o0GOj@QER zYAC0IQi@@Jlg`@v40mtSx%(c&?Yn?PNkM7^N@kxfB&pFzG7F&u_%s9j$WPZuD6(iOOgZ(wwKwxeU<*kHFnl+AVi*V zCv7+{b6ZTBX2hVuaeTaHm0G<)wOK_t6-;(kq6BjEe$jvrXv1@I1dLn1NOkT7yvF4( zd#%gg`=E%zM+W+^w?eq}wu!pSguNxq2T^^dPnO0oVlrh#f=-E|AxS?bjw6ydwqd{A zm(8fPgG}kkYn)s^qYXlsLI9Y=GVvIlX={N|3deQv{2J12;8yD>r$MFGL{?jPl?G15 zS_VQ@kd9)wy+mj2eR{XA)8Aet8g^02#c$Uw$QuWP{Kz4+k9f++y#$VsK7Q*mUh6WI z*%yTWi1>kr0{XCfi==zYguPpYn{Q)G#AG_D{%Efzq@(zADUgRrV!|LmhcRiKkfa)8 z((+0dntBg_%bVl~U?2NEHDens2cF6PmD6UGP~bW!r-JX-kbcwh0bUKa(!{MaP?ZK= zrH&FI-Sum9*WX0>)sGHnPw2S|=~A0{5vO$t{~;w39UJs%91w25eKYRfx*Tl2i4h4> zx+Gx-($s1bDN1PIL(3_Dqyk4^iLa6p7ep=z;->4TI)QOnHTX|mp*0G%+HS7n(WA+AFTc4_0IJ_c**sr zaO=}Zw}r?`B83nr1W7U=4LijB9g<{+G_naKxtW{$sPQ>xL(0N!Y}@ZB0ty+)F2@?i342Kai58q|l#-y4v^Rt}0c!7n* zMW*M@P?>5J`R+v~VfM{Yze^Mi2?sr*a6l5rWE-Uj0q)yaP0I&Q6s=X+UAKuLkvf&!8#Wn*ib?X6vQdwn+6x68Yx$RKP?HJF{7W#Q5#E?&Gu zieyxh@ds*(fE)~+~!bC5-Fe2k9gvuL$!1mS_TbmuWJ3Tfwc8KG2 zLJ-&t!t)CkxODj<7ZxrtJ97r=E<}1{5tNQ-*dvUFM1wwYI3UfU8GC?#L_wfG1RY*p zLQ9g4D*USTDLlW5SF7QBb!0v3_M_86*=30j^lsl}ePfL~t1E1-ZLq$vSzNm7cudXC zG2Nb{)t;kPZ(-1wc*rmqkVZpH5~2-Ue&shf^XxB)`vU#$oBzTj-5W=`Py;CGA{`&$ z_z2%eIaPEf1afn}5ClSCghU$qf26J5*1-;G&?AkyB*_j&k3vl#5w`Erv4udsiOZWP z3}bW>69thiN=eOFTwG)eGVTw5_<%RU6lJExXKRD1xKt}O{8kOWTE+3aQ3anKx!_0T zamv<@F0TZ?Qls6TV|s3mT5XC(a|)w1X*?v30^*=g8ixhvQ0~9bJo6mS z{^Eaif1uxa{dY||xN~fYSFpiC;y6{LTS53fcwPotku9`S2!hd~N|+fK!#?RCAPTyeEaxBxeX-#WQ3A&!j3@I7GIGs~0Pa@n zcwUWaqlN2u$YvWz?e@(9UTAT}*3wOuZ!NR6xyHuY2Hj4txR(N`wWet{TFlJN(rC|8 z@#`3^(NUk_aEM8UBylvpP-4#y0My!-dH(DF{r!VJJ~HUp3zmJX0Y_C(eifm7WTj%w z%X}jlRkTvh1%VVY^L6ZN+QcN`4(YH%ns!N}&@M#j1{!HCf+*0WVMwAiNtm(DV>fD? zf!#3+H%pOX@+S)dq z-hlOuT{hM?$6Nv_GBQgWE?l%lMGKb}xp46!R5AgU>haD)KpI61!)}(r*dqysb~UqJ zge5QTNYJQ|L!{L>vy@cyu!x%2J7n^ zNFfR>4p48kX-~~DH9ODr^ejRujM3;Y19?0kj)Mbw7anfi)MhU8{MYUi^jkmuXUEX= zhclPs;2Pan$EhHFALZ1Lo@W)A;<%m-n^8`w_D=*tMnTzCC8+cw7uUf(L8_0Td1n^vvBnF%j*|xH}%+~rk zt2b|Pd-XO5+sxC*krmROnWZ%|PrcD*sy&aC(rWU!PcZD0#C_5@D%{_Z^>Tdor9OR` z7ry=>gZ@xqFabOvJsh`!<5m!riUqtV^@o=c@#quQ+E`!$@3)#TcYgIt*Xn_ry7 zL+tUxM*=_yK^Z*0-;^;louEnI>kzbms5J;!BwevXC97dd}nf%%J zG>QnqF3B(?jQi+dIL8b=q>s;f5_JIPuX7n2^fV` zGV6BZ6oLRaGDCkXuusI>O%^*>()#3;W-SA`Q)u}zcO*_AxF1B|j0u8_6A;p_ffR!E z^=&%cUf~j?Ny;8aQCouW+`>hsXXm)Mc$sQ5>yekFBTHZus2~b@2(3o|&m5=XMk`@E z8fReduC24Vc9)IKHSXM6Wqo6FUw|ver9C@OdwQN$dyaZ@$_jR!5C=Via6lUMNt4+2 zAuPEcwgKqFB_nIom-)ok|A*56`g^gZIis$?@p1hs%J&h;BDOZxSXo(N_2w-$HaAG3xJXdSm4dV;Mc=c&2%~{-98?Q2p+nA%$oPo+5P~9U0;_bKCzWKN8EdPXIXRQzdMP-^4 z2%~KNyadd6{=6=+sv@g*SB^uqQKMF`;rdk^-?hy1A(?ik{xFY75Xe#TRvf16bUJKp zZ?V3%OSjiYDn%OG#1);j;L;e*oxi|^h4akL&vWMD0$#)V=vzxSSzljcYh#03OUv{- zU4)c2p>(3ku~MtkZqGA4dzRMp9G+K2YmG?*qF_Kg=n%(&?fUy6fP9=&5wzwOdG?q7 zyZZxuaP{}iVCxo%)|}kEY2hz~WaZi$6FuD(p5r2FP5fFLx6;C|weg$txb=A|^)|9L z3u8A?%KO_@7^ft3=j$_WR{;UK3JHhHm+B-LL?1{g8{*yLlO^0tbN%Il#H41AN1iU!OYpGdEzVo z^?@hh9QFZjUgw>j^rD!|T$2(houX>QU`U8Dy-mXI1_+5GU6kviYE3G&X}tOjZoN&V zI*VJM#jDLibq;s>CC*O2#M%5ShBw(*`T^TFen=;4Dj}7kTCY)UwW!vsIIc5po}012 zU`9}heIqXV1IQ!)u!>xcDr`hiY%&5kTBD7@uePZ+YIv0Z@-Gwl||| zrO1Y4S~Gv`?p<8ZDfWlKP;IqoPoH6WdXDzYS)>x^)R4w~f?kJyyh;)eOE}2HgcJq9 z%?WU=WX5kvd3c!eP|%A)YMyXEF(cwUuR@w6`N<=MMhF)v^ZIccuG7(gBaJBF{gMcA6|H!YMYNvg~=W=@R0>7D;atji9Ssq+i3W)bOg)c=c)g`YcXu z1~*wFPP;huy6tK!=kS0u?vn&vFcERw2a}-n-ui))R#N&w3maofAkXSJ${_drCQiLM zirM8LmszT|(e&3gSYBS@`qlSYSzbjcg(D?G%1q;rl71Y=p*?$+TC2@;>kKpVXGnEQ znrhOpM`vw?BtG3BKeh{S6pz^mILYo{QR^lIQi(Al<}mGJ#)ehMqMqDf&|!}t>@wKB zYdr_oWq#pVXir&kPp4>^f{tzYP&ugj3<8NS9FlZ^j)s`HPn`51CwWXM5^zEV!6O5C zsnSeIAFpN0NS(&?1juc16GDN}gxwA|uU=(kX_@8aRoh|=iBJO9b+S&vwzk}H9HwW_ z(VUrQX66jd<`jue(WxOBcG$UllQ6QGoQxam#f~q2*C#VvdMLZ4&7PvHV}t%QZAa<4 zm?X(6!;T^>$~R0F&xsO&q_V2D;V=LsX)i`r9B@)QIKq|==90sj`6fX~iC1kxwTWjW znv^sepralp2}yO3b+4UFvlK@I(kTPER0_W_WkK#Y!1u}rGR0~jrXpwy1LBL z%@z8+-iUCM0-@~O0FA+`)R~=`r#*Xy#?&;8#tf;B3XpHzT_P@lTp;%S|HtV#6!b|p zLg>R}oR22qtoBsOBO!QTQC0K=u%3Xe8?V&~db>>Nai6G?m6F7T7j?Ea9O5s+U_>~5( z*FaV)`5$C8%eyVG)Ogb)Z_nk@4W@F7*k z0B4nZ#u#)Q62>7>QHJZ`R6LwY1=p*fT#1kdkxGyPjV9H3HkY)+FP$p1Y8V6+3`sIT zheLE4q0_-W(_zIugrEKZ?l1eK`rET~{U)_W3+305l?jk%M4GLI5NzDK#p?1B%S$WV zUReQ|kNglQCu3W*p<0__e*PTo*|W4~&LD*gB0)zn!LUPT_YQH;C61!f#9e`qs#veb z$8m_fob5J-lOEy~0;J#TCY;8g4QUIW*w zBI}J2$SHwb2vCyV+8QgjZgT79GRw=$=p?Zaml7pap>d~X&oVQ2hN<=$T2nI!$HOEM zCQS&sTSP&hFzk{hL2dp^Q-5Lx#ior0DUMQTe`vuZ#`NpPldtJz7UF-g)x zMhNvRjTMSHuJI8z;$alwK^zg1aez{Z0l{6B;4I)`Q}aTtgLYL z>U*|HsvM2Vl2V|xVR~ks_WW7eGv}C@Ifpjd`r}cberJPlxQmGcl1!7E4C)d!)^gnN z_$VA1@t~kLr{s>Nj5Pdx?EAyWKSMT~-W(M&<2PO!t0&ViAPobC#vp{mQ69>7@hcUC z?;;#ogoyH)vP!CAA+;1Je+tJJcnHuDaXi2zF*+Hbb+V5TIEpZs0C}ddmGbcG%@N3@ z$|}%A)|V^IKrUdAa(nd_D>rZO-qrW%_j*O1hd>~u!u1^5^XHkKK0|x{JdMVTtszfh zk~m~{V}&r-B@TL+Br4X<`05=103ZNKL_t*3?BUntgjMnQ$RQvxduu~J%9>tC2dTuv zA-YPRAs>*(G!y5OTLVcNk_tn>TLo{*`xG zU0G%A&N|8yg~=_X#IMzvn>$ORHN(uA3)Jh=R+A^1IPTFYgIq^h$JY$xN)|55W3T+^ z7O9PRJ^<+L6jHON3(g7UEp6(h*w3ebFkjaQZHG8c%t?O;YgGEdkeZNTKP2dNGeP0t z*DClG4=G)g@7RvKS%(;noii_`%t}+ibt>Rg3h*V#5S<2?ARyJzm=)om@ETQIuYu!d zAkU9UkmJ(3v&QnRn_Rp49!pCrNGXbDn!;67Di-8ZXU@}}J&#|hBQlVOVUO)QHwnWX z;;0XC))=xVN+~fCV$>DNd~7}R``b^NdneW0lgP_UKTm@pB@9U6a9IAJybmiNHz$oT zA6SUThF)TVeoWBQ*|~c-RS&P~<0=p7J0JwwqzEl+uDY=!r}O-4<+v!v1Ahu36meo( zF*%N)I&;C^v?8ZGZ(Sz9a|w5Lxpwsmw{9(QdwGR$5LuR8*usw1^eoeJ=b4>7OLKY_ z$E_norpbdYoz5oVaC-!DDN4kfEUcit$+M4-N6LMD)Fd6sMd;{Ap_(JR0S1sC+^yO( z_)@5BB1%FuOo#@(kr1f3IKGGH`L;1;#^35RABCA)J`yQY6bj?Fs5X2^k}PH}!BGr% zc38c!#OmrTZrxa+*Xi0}6v6_1_QC~PtyyMf&oO=G!f0G|stJc%^tbL3gmM?UyI`4BZkJP>&k2FTg<`(5-BCWID z0#=Ae;eeg39$VX8+GiI~O3~ZAOW5y_1Utmxu*5Bh!s>Yp@{fUeZ;Ei8K24}UR%F*4 zO8}hK@R7j?%kB$fQ)7jM{?2U%ojaq7Gntng+rlC1i;J<#e{8Iu+(Tv>&V1Z7ecn>} z7;hiv0}eRSQ|_J?Rs6a3HWuVUs-iJ$IrHr?xR2pZa&HUB7?bsIFdw?LbSUU`K4|n5 zNq8Y2Ug_z0lMR^YhIM*2XPzE!O6V7&=o6=<_-M6;`H+CW=QV96tY%SC$&W^`YpowF zBhThTou1?z47je?-@JKHGM}v9+9`Btg|TF;F}7ErlpjoQypI#W4+8wyWTO+H z)wQuxV1+1VOWw=MJ*qh@kqm|*t!jO5kG#`h(Px!HqSU!ot7Be=Il|8;Ueh0U2bkji z>9UTWn5L{tCVigXq_GvtCQo;gV$4c-P~YEZ!?mk-`TqB=vV3!c?#_@;ymHxs{^O+S z9VN3)E62N`hjDpA2!s-JdIQeQ%$#OjKmKcK!*)WM`}XO}dtZo0ClvAyKk^6^ggj7V z@4X-L5J|5wc5p;V@8=owt1k>oAgOWfFEgXJ0DdQX1whSV9;6= z0z^xJ(WA~pn4Z{bR$<5?zEiigIP z2qaPnf?;5{mlT{vM$a6yzUF8NM>){J&H->72haBbh@%Lt(=iQmkhU@TFpp#V;|GD& z9N|jydJMCtMYP;caFm$f(LIvI-{%@%>rp!|orUm(7{$r+n7ok&jX;f^(O%Xc;QN1h zh4-%9Vfn^7J6i)j|BKJ^YrpZiiM24i@uQmu+zs3Fp#0v+`|a#q-0?SM7RiZ+zw0Wb zk!Yb0T>kqd_#}dUFSLbr=JXQZ<^lM%d`l=L@qM3Kt%mD)#8E^X#|J8lbf3fS!jf>@Q_5Wm6&hps{`ao(v%kH`oz-n#{_GR{`ak%5woZEmWWN{k{l9vT zZ~Xep#U)&QdzCmzICH+updZrf49i|U_abSIgb;Ir(@%9~TDgAB#?{5ceJCZlv$lcj zsE=1Id6tMNCAf~n_Z+IVngx8d3PKQuAwdw3rfF8vY4(`*xs1%4iWdL$_(Nn5U0T!f z*3D-E%HkmoNv=7V%o9=+-(fPXEpnY+5-M^Zr05BYNr;h_H+yegfg4#me+0bt-FLb1 z{#}A$bPxW?3chRa+-7^LUp)JrKYkN{=U=)=YpQyD!u!xy(*%*&8TBVox8<$5{aOV_ z*{&}Sb>4cG>?4JsQLWlWlBaCsp}=HAb#2=#n~5ti!W6voL9-F06!?AxzvAO42ha2H zD?U<4y1g!g!H_79N8Ob&=f7-mj`7nb*MuXg>&WY@4Mqyv;yL@U(Pxau-*t(Z*Exxn zokyCzFLznRr2oz+tX7<5HZeCX?v*G2Z~M&K-;FkeVZze;>%8-`RTiI_=hLq~m7T*# zaFm6jpj4bQApp)VOmlmAi}gDl-g|SE&wl9{wzv9h+}TA4!80$O=h~IK3IzDpLk(w!uxw{LOvP6p+#sjWkVmuKSUs`CrQ{?v-DY9^>4{V+3U% z-Ao9dv?L%*(JG|e=dV1Ueq8&Tl51d$L2JXx%}tU-^Tab}_&@%aKc%xXz!<~X^X*Jv zjJ{iP^wRGyefALsqhMSE`JE6WR z7^$dM8$60^xqPTZnxrFR(ma@u`cOOsa|~MCSPftCE3~KDv|24(*Cm&FX&jTp36A67 zCMXzO6v`c>*W{V?ZfIwOVDWJ%v)r?o_2f2$a?+rSLot&+~|) zumt+?-FHyUMs6DG2|=As*eCnnnu+*#DJFiH<5dQ{HU@>rTpW?L1~Uh61BT%+;`-G! zuDrF%t?L`?ZViazWbA#8tH#3|xv8ynk)Q84$1@j`IOR*f`~ugm+#w2MzWb+d((eT* zrFiMpC+>TV?-{4pn3L(n8iO$@?V0J(v7<`sQt}UA@c3-44Mp9$Q4$b?~b$t#*~O z=cjn~ljrx988$D$AOs{j#gTHNu|`%GvCq!Z+Hm=)d7ggmJnz4Io8@ck0Mwg4i%-oz z8ql9~EnjUi!y!2LH9fEPv-{R75z zg(!=YRWiZe8C%7Z)-9r88%m{K8kB<l)Jif|sJjG}K&eOdA?w#TsKL4ekJHQ=%NSfZ9z&O3p2CY+O=4bB-^7{?5 z*`|?_t*uP}YSl`i>F#A7iwVtF{yi^i&3~SJ&)EAOmVC@&^p?FZm4(Rt1%ok$IF1<( zhoosbnmcCw@=B(XJJMK*DApH_SOUB_Ym{Q(zH2!Pz*AEO~AA~yS`N>4Vr z$k@a0{PCN-@uMX=+XG&Bd4Z>&KS#e80O0v9wT939*%nLJ)(Hcfg!IxYmw4q1Pi9%Q z2k$T;vU+<-VIwB{5S2L@dQdUf`AgGWerk?8D?3!{KA-*a{-7W9qeDOENT5#>Q&bC` zAgdl@pgGgVsW_PQn8h_m76Jk#CA-@_Te7Qd?z%q8y_g`gMEUn}J;pwTDPrP%55pMH z22|l+XMoq)NMj+!xDaC?j$;P>0YV7UG{tcoq*Q2~5@i{9Q4|q|5owxc8dVe{ueB-r z_2$5JydP$?hzgX}Q)J=1Jme+z5eQoE6Cf1u-dnfXTJIL`(ZJaYZJvJa98W!amP=30 zQLX#@t8t=n9BVwNv{?KvDrjYR~?A;-y@=Kk)5DV=*hN1nWap*YyAHxCgu z8iUM;ygcL0B$){yC(V0E(gdwjq>?B{p|vK;O#UDU&{~sf>u1}JMG|B3T<~N+m0nz1 zZY_yNxUc^3U;l_Ve{_o^u_9n=z02a$b1XhJH>!5id)G;p2sLp8f}~L3+Uy}Wa`#x6 zk&qemLc$=)+y{qC&&(g<)#!V201Hpfj*)=YgZqeS`uynaba{XGZO%V&nO1wsY8g0I zrq?}GJyD_w`vFo4Tp`CYosRu+!m{Fy;}lvTP17vFLw~rm$t2l`1+nXSxSop?k|>S{ zf`A|hh@xbaJ1;EZX-k@Qk=sxX+dU{haj;8evi4|uGckLepa48TcX!B-Uc1iuOVhY+ z=FsnB!Rd0bK~@-K_9P(f%_!8_#Y#s(WI;U`M5LuGQKJn%{Qur(*bf1iKi6VmaqhtD zR_f7YggN)}pNnZ1C+sj;LC4j%uV5U>%b$A%*HxrxW?t(1H;$#WB@%aT-$rB^U^>gb zI_kYB{Bi+~^28l^i3h{A~P{KNc` zKl0w3B;14)IIe^5`*@y*loF-X2>8aJGtftIOcaL1NkW<=MNa!+iB{&Q!oZZZ)IR4r z!MMAwi|>0lN|B@~aU2oF5!#HZ@^b4$3ajavD9aX;OtLxHOupCg|Nh&baplcb2EC9Z zNpT#-7ry#zQE-xL`~BA3aTJYqm7R?qul>bUo_zKU)3dcg_>G;B9xuMxZ(58fadNqJ znNJIP`nfY~+};6T`T8b*^soMw_H3Q?yB)SSdVpZ@=`(!wS6|}NlXK(!AEe+{fAg~z zy!z3NQ<9uo)Jx(xCQTC@N1+hB_Lr~m)|>C(c^*nS838579@g*79%BCo(ss*PU)w?f zo^p-^_DOIGVViY2$|(SDv?fi{tkaA^3W4i-RI4>w%_i-3o2jWO8jXf6ba9-K#^(VU z{mJGCy7VxkM}E$p zb_RvXo+K$heeHS{i^z&^v@U)wAM@v0y!grjQc8NAA%FI7e>Tb@G~=f2q-M=as}BN> z%misJ8b19CPZss@U|74e%au1**YTlpp zO48kKZ`55BaB;bLV~Nd;4L~xaI#SXf25fEZ;U}lZnJi0m!)ePy#4wrFMa0Ho;_|Y221IQ+!8SR zEOus9h_N~VLwmZ$*ZCAd%G)5zjMQ@-#}==+wtywibyu!SMM{)%a2=Px35mkYr%v^OLq*L# zVL*%_6$W=Ax;$!ut;bAz$5D8$gOUQBro>@L9NU&yd*wx5rB*5&$z%0n?X&hL=He*j z_x{OWOoX|{k01QiwJ}pY%>;RGcgVFXYrOFCg?n-u)3bG6{LCfR{-{Her2OQsuk-YC zXZDa~lkT5wGP0*iCL8E&>jz|(0_e-pu;Itw{|P_)$?HhZL%I&ak)XuAAC6>oWu?f< zGddH12mQ-m6XVZoqe*m1oW%B#CPYb05QPkbA^ky*Zm&yk&}T3hFbD>OQAnD^7^4x6 z!mCwjOtqMvZqsT{Wo@clgk=2t#KgIj{(oSYQS99TLP%W4#dTezl$L9VB9bIIU@wW0 zAS-3=G}=k+{x?1e{b( z;!)IU%cEHjr?>^S!K*mb6PJD%j~2;fKA6-vxZHUECQ%ge>Ce4VWR;minR^97aqH&o zj6H>By?P|KU=OQS)?E7}ZloDooa&S$j&WR<#7%Hrw|Gcp2Y4vYrLGj7=MoHqB3_ zfBwIJkIwFpU>Nb={?ET&Xj6SeLg}raEEn2wX1>9zUwMYxx3&wg-nq5I&gOu*v(0-_ zgsvm`$~RwN>Dney81s`K++=rau&=q6>Jc{}q+mFRig#3M9;5I?1~dse(I9Q|Sl;5= z#x(DvNb3++>cB8))_d<>HTKTE{J@hszcRn@M!i9j^a+zFi*aR@WLhGnMth3YTesQS z?(ns5{t{9-R@;;cFUnd@D#e}UmCQ$VvbIfzBM*2jmnxVeyf`FX$jlUv0rb7xzeJ=fyN zpPSE^aM)Pya(j7)*)xqpn^WYlo1Jg))nEGr-~KnRb9Z%TOz?}(Jn_sKs&#MA?0H*Qll9A=Y=Qj{3Mrx}W%>Fh@4mIluYBv32cqUr^{|WF>}pTd z>Goj|M0V2&vIYnesloAJFzEB0Kl=;5`paKMx^6ap#7x?@;7G2&_a2V41fJH0TGc;t zJlITt?Wlh<3f-keQHz%(c%Db0kR#KRagL3ptUrBSGkqxnB&nR0j0% zL9a2~S=r^ryx4H7>ZFV;MAO(&R{NMlVuldT?U*Z#=US$4!!)6$2vxfjK`^fgT zi#_)#w@3_d^ZgA5J)7uKskl7(+!+AQoNw{sr!Vo=kF6DO{pvdXZn(FT%=l(53?SEc zdG*Urb7y&nL6#jid#1^YFJC0@8R*DSM_f7CxI^qSmP%)SyDtAOj}-#j-5GG>>KgC8 zb(`gzoAf%tSj0q1S=0_3E->_iX?k-C2059`v}#W^+1c%qNKHPIB5$)KwB68yewXk3 z$)EDoZ+-(D2PyQ(S5S(T>o*XNL}d%;SKSY#iHOlwTWYN{3&57LT7Y|ao{Pwse#iG| z2pa-)9G4&%5=AlN31@l~UJ_Yb4O6sh&pPHv9LGf|2ZJDv6QU>~i8ZUsJACikZ*%L~ z#zfZ`d;ICY`!Vldxy?7f^=TSyXAgV7mpc)Mj<*N6d2LkF{=%mh09d`X!?kzsa^uR{ z$n*_k-uUq{U;Ns$_tc(XlMpX1&hUk=J;zkL%H^l#@O>vE;U+EQQHQ09?qk-O} z#b!D2rhaB}O;0u0?e>V%)b>I%*=Qo$f(7L|^t(O2^QYhDtKax0IF2>-r2xm{o!8&M z%~@z^@RYQT9`2FRzu&;t1GzOZ;u6d~#$=_bLFA_F?*p&({d8!*!Jf+S9e(uEHrcBmzO%@<{U|iL1i6p1pCL? z^PdF*EkQAA)G?;bw=HovHC@}wtCn&R+B0=7KRwUl({o&UYVLTguEjBY`u#@Wh|@H( zF=MGMY03ZNKL_t)hrxA^+z0Ut?>{)}+7x&MGhc`~_-_eHf)|Fht&)ZomDR zx8>ek@3FPsE1uuXKHqT^m8wgrPDlU_IA>YKND;pK~#a|mMQ&$f8_#dCb( zGnXt>vx>m60K~*p%+XX?vd+8KS5MK|Xw>n}xrcIT0(Q5Dy#LN^Zd_fXyF0{nY&2$P ztIu!!H(x(+KmF=&eum3W%{>&(>qzE({^mS)<5Z1qOYP#;8#U4{L}{Fv`kDBW2BU5A z%V4|9>p%EgKJ|-VvYP6>8@6GF0<=PCgYWxUx#E#s@;#b<@@JKy&9dFLqs^fy>iKi2 zAx#s~RA+==TIBS5o`+-HtbwJ%uhz3vWQTsQN30>%qtLt%qUZ;o3wI?Yp6lW$TS~jS zw9X&?Uq2)YV`_Duul?Om^7Qj(3-iGD9oma^e)(5k=3o8Z_W)SC-64&wQ$CqrlBQYP z>(u5L2n11F?%*LvjUY}8?_XUj&du{(no|{;Q&r~9wYYd`nsWu7zqiiQ&z?EFc3y)>_eQ4f33?$;_av8GXtkO(qA;X8 z9A;fmGbx;9Pf1sC^Zjce1fTl+&vWy=Ye?nTg_S@Aj#7{09P_4gO zU;Xkk1>h$I;ES&;LI!%B+H9T>91lEl82!aG zEGS9oL@OL;*|ygeIhs0yd+F_oWgRmWOVlPBIGQeVw$p%MO~7ky@%C$%@Zul8jw=_} zVXZ|Z1d^15G}A1CF&3*=wzkz~h+>Hg=hpD%D;M$RtCz68N>$H){XhRQtQjDk(CPLN?|x0 zp;o$45OyOwE;wW)!3FiM@4t5m@4Rsl0MK8|@bG7jwe;Cr0nLG>#k_k_2@WB6XKj@3 zDi9|mz2zqaKm6Vg!~Z}1-2LeHb9{JtGxWZ365)$qekfdz#z{(B3#7dW&wur?sl%n4 zv{-P}3GIwwFsvn;=R`CcL&ye@v#uIqt?{A>1|1g609H7qe8%y{56|Lv{`p^lGg8dG z@AM%&_{b5QdiXFF7E)|%j8T`WL-v_QT@K@2YK$TK%Ga+_P{yMJ5W1U~uYiEuH` z+;gz=e}{&JwKZi}H{Vav6sbuNQObiA0&*e2Vg(2uVKf?`E(B@kwJxeSjv*u+K;Qq) zTOk1Qeu9-F{Xn&CeNt&ICyvk2M;fT*|hVtFP|IYi(h^Wb)_*LRrubw-^NRB z-hS-FGXBQTeI5%-8UEz=eiVM@i(h#RD=UYZ_s4B1(%hf$4PWtSt;05B$mMJTXmguN z)=n-hIiGpn?e75+!?8w%E(CI?!%B z)$A~Hc!n5_So{aUVG&0k&D%pl4JMqzo&`r6Y3hb&{Dkn+Meo0i)`*otk|f|!4Dbj@ zWAr!&=M1W<5XF*KOf4Vy}g&z|~8e zcp^Q@CX0u+nwI|iKkEDZ~q5h!s$ouA*!#n_>F(~ z3+`a%ZqbQGg;I#lNYr{`Rpv9Nn{3oIs=7i|)zC^o8|{{Twi&EiKTf3o{@4H4cd_PF za{cW`-}?a1{nY8Ea`2{>c+%#@1K_E5FAMyp;R?3h)iUC+tOOo#v+ZAn|8{Yhl%=Z z?@LlYBlnr?Mgzb7yOh!}W*jv5tTr%QAZ9U`jbNojwwUAC@nhJ^2N0Yi%Ti=n77n2} zja$zZ;4DVJ-w$I#tu>4_c=xsQ_{%@18Ge#TJo&j(SYKZc2hX$5-H$7muH)+Eb!=^o zvAI6R%E26uJ##Of`rQ3E`M@Cv!Exovm4Jd{k_5w;qwNZ(Qq00d%^3p|0@6KiDJ8kj zn3QxAtvd*+I>>h`rLeV8;L-zBj7f9%T-K^xO)CI8v~`b}Iqzt;J=l_LvtIWSsvMKO)Bs0xMAu*AW`{cW!EJqlw6 z;)u5|`jljRXp1aPQPs-rL^p&R+tNkX#vqo?AJ6VhX47JOq7Gc9GD^X?ahc!(NfZ-- z#5m#18^95|OEeb7UF=$jW@XiFP+1|dxVVTc?Gd6bXuHlU-yAuz9K40V$+=4{03B1^u675;7JrQetzxz_nvNP!3u>HIk>XuHGX`I3|b zU6@ndjUXc#X83U&gUQG#InZIo8QD?$>}`wztU+DZxbLCEh$4=%G}u@lKA`}-gwfxd;Rn;J&BX| zAH;Y5?YnrRHIAHz#9utWj?0%eaq-+5uAE;Ft~);K&%M6g>ct zBUDU5S=I2Vy#c1v8jEAm8f)E(-#cUTj!_!{rJNQU5b@YC#)Y+K+F~l>fnh_jh1Xp;bMU*-jceYgqsB1uL7*}=|^%&Q$ zUkAXNURX-xJ>rCyWr?5pTTkIH{^Sk3|MpdsCCPMMzPJGnKt>{Dx4KgJ<{!R{=l`ag znFn3GY4;e`DOuRI^JK>6ym8?WWuX^m4EU%2%QsNhBm(`^=k7&SDS#1g|4)AJfiq$r4ojU>7@3!Hi9Dh?f649q_6 zcnR7OpI&?UJbvuU4|OQLQVLi@grat(w;d9H^uz%?@|oi}{n*hdk&xX2d9$dv+t2A4 z3re4#rfd%ofh3M3N=1t~0mCpHQ6ylo^XTJ-8vO0*ehXNwX{x{(5}uNFUK~SO@>jE3 zkxH$Ul+n`^X_6pL5=0RZaUcY#`C1DY4X7GW8g*5nQW{2clCxGdii(21*UJNdmu4Ay zy&igb4#pTBeApmKBV4__f%WSnT)#HJ@=A_V4;{w&_gC@aAH5MW;Me}&Z$n6ihn_q% zMJ8xWI$Kqhojuy<>>$k0Bv@Y^V*T0(*Cx;osxsUx@XfEk z8V;r>K6?_6KYIdN8;pwrg4a%&C<2!P!_5*`E^KthW&m*Nffd|yY8hwVq;=lQAFN~T z+5r7Lh6RzAPMtm!f_`&jgm3=AYk29~XK>{B5{82kS1zuT1_5I@c5)fde)0Yw3gU17 z;D7j=&GoqpORIVD?tkuvfxOP0@1RAy8v^wN5JwVPX{u^m6h<<-63>6U7!F94h|2D!+VLB!IJri?LAx<(`|SS%bLoxy0JsudEYf)kH* zns|(Ha4vA*04cggQH1sNb&SVF2+SxF_`;V?V{x&Mr2~sNbaV+KHUKZf>zS0|^6oJ~ zPS&)FeD^KZk|irEg>Qf39lZI&OHNFq`cWl%zVY?f@WFf60Fd4DPyO6u zv?A+P4z)F~wuY(|xD>c>ZWY4;VHL|OISwAmVXQ?lR*2Jv!!Xz?aQ@7796zxPDH+l% z!joUP57(}2;r#p8VT{4%`UsorBb;|zfW`u8BJudMC-LOx?!~baOE<)>yQNj`PU*>- zorU)9^fJG4Wub+IU;==~t_?o_rEi*9niUI^N9i{l7snjlRRNLRKyqCQ1YRiZ9Q z6Thy=d8RBY(#q31Sa5~1+FBT4!EGZLLUvlUL+l$~dtKMC)N8V4cwNaodRj}Kh{EgrE+N-$g_Wb(`DSrM}o^jx88*>1x)zGj&Rpaf~FNWuS z==dVO@%7j7{@Yh6Lr>h^{NY7B^Tkt;l7P8m_blP7fA<-@^8ItT^uanTEH+k0V1ncH zqet+_XO82Z`<6Qr+uKT;?UDL!cJZ@!C6L!0;W0!)ke(aEjkECBE)IkV!e8fGoH^1^ zf~=Pz%X&zY1W}q$pUxO%^tyts6^gPzF(zF+Z-1qzXPHA&{mimY0{2rYVvn!RqQNHa9l|uRHH&h$0z$>cgTgvmFn^8pVqJofZGSUS)P z%P6dkHMqB}7*%-p^+q%A?H^t0yqifX5ygT8IRIR}vWZLQ*6_fiM<9rsh=Ygw_^F?L z3`J36v{hm8K!zldv`BS3CAwWS2%pN*zWov-AxQGrSj2(^ByI{onWL!Twcj|S3L}bR zByo&1O_63P(lmpJWMe26XK#H`NpbUJgei z6yq_ZqvUF1kh(G8%ArHxLVyc_&5aGRvEm$DIEyi3TWyR}s$oD?DO^0ehWFpPiX@A+ zm9?r$g+KlMSFyG_1Y-Lp_dTT7}IQ5*%2`arDFzjvQOSzx=1)32)*zzWy2>eE4t}_cD;! zXWmPY_mW$N{oZJ%H#ZgZpYE2v$@ZK~o2Zn1K70iXSeQ**7T{_P*X zfmO$Dd-}Qi@Yye&nhNOl!M3v@sm12{2rvHO8@T@A7M^+TJ{&)}+&P~a1Ag$==fY1M zzxMzhc=#}m-**6qjx8d~;=nz4;L#&kyEedsj~>BePv0{YC&t*@-XU_^px4Yo!N7c~ zL*8XyXK%Et*SZ6F#7k3kdv-uNU@p&lNK=QHM-kahX^pBFqpB(t#TespfvPHDj13Dh zy(C8BY?6reWua}+NK0d$>W+0n5lww>nQ4}N9A03QLQxbL4hE2J>rZP^=G9uG*Xtok z5*#{2$bK;{5GORY(n<%_T>nO_ULE4xyVp9;YOqn@{kN~-v8Sg=CR-Z?Ui&_=)v{h3 z?5eh_j(s;jsf>5}v7@+hVFQD$BD@Q)y>uSeu596RUwQx!KXD9^Q=nmBc;~f-JOA^) z@(d2H^kKAtVU3p^;|#y}D^Eej((U52;946TY-b!opVYWJ(CBwFr-%J?2l?!5zjs7_ zp2od*jfq`W@AZ0QOXV!1thH3Cmj#NVY@zQo4{kH%IOnLU%28}3(lm7+C>*NZHHvKi zIXTgy@6(E{-;1}fsOp+zueF9UI+$1L7G_|w6mb+IiAfZ5!C8yZf{k{jj;^eJ<fs(knLE8zfJI@rUZqx~JPMGsn;iO=sdpFfFbo;!t?zWqMVw3Kr{ zytsis{oNm7?aBa;K6?U(k1pWsJJ+DyNOEbphct--c+D*%VAQ$z2q_#Juo2}84iggk*(6*?&{;1yxn(tg$|G7i}=A`z8`*nT`Bz4pTC0-&R)mk&z!)^ ze{~iIk1XJ!$ByFhXHOu>BDXWpeN@w4zH0Rc2F?SN-&!PoPdB#nfw4o->)qQt-$g;* z`Os(B82i56XZH54dQlW)KV4NW%X>i1PJz$?bJIX=RGYC5%!e`E7vpwK3j*`zp@8a}^(6+Qe|HoOvz0{=+l)&;HxL zjUy*|5H8@?J{(}^O6%prIgXz^fY)9+4*9E!&af9~vmDVVV zBK+zsO%X*A`u#pQV;BsFD8^&T_>(}agZEoTR-#OdLxQFn>v-jY&mo9|I zdiT{Uc;tzr9c5SEdIPFbp%~S))i>iJ9uF#f1WM!naUifmLvj?KXVV3 z5A|^M;uaow^e`5dGAe-#wNH#w6{H>Z9h7ZZ1Jd~ZeV$0dyo`RkrOcgetv+R2cDEKN zX^r3_2e$dXJ&s7?S=Fe@k}`Z*psr{RZftkig0Y<^1l9mG6i^ly;y2N%QhK6z>x2M_1C|Ix#E-%(jFynh|**GJU1yWi43 zkOnw%{rU(OK3Ky84t}ma~ox)hBk-n5xj*fS&9Cc17uJn=|M zWLbt@-a{|zA&z4xtx%L@=+{FT?}B}jW8Mbc=Gw_K7x+p6B?E6oLmbD*dp$QcqP1Dm zaaL^}n{k)v1&L4i>4DeO_W)%3>VEde@5krA^ZLgUEs1splLh_^^I2TRNS08+m9 z_NCB2FC56Qe2CO?pMLJ%5cEoGy!OM3`0~#_5~`6Cr4h5C$_dk3HryoCx`%WK%wr)7dJb!=@JFzoaAzcB^ zIgB>oj6*|F)^_igu@;=!;F9Byfp!~jKknXr7t^IZWqRgDj@s-8{;Vu71Va)h6zsh` zjMK&=8o3ok8=y1Y&&1C7oF<7-cFyN%09Dl}-2FKi1+f&!dpQ^wHa9n&f4!xQXqw3k zcesF%#OF64Hyh<7u)NP*`&QKo#u^w6*s?@bDV#miFxZ~`u?I04kC4PM{`$qY!}pKf zvxubw35+&4dEWut```*bc#rt#uf22;U;3Gc0$}&RqlaclGTgC9}|LDst@Q;P^TpQM@a^O4=NWVak(hgW4Kl#4h zQ+EA1%qJ>)9z5vV&N%j#An|)8i216f5gxG}v6!i#Z~y0hrk`KZGe_4=GaAFuYAP-6 zlvRoG*!S&~1K8#ZWZum4sOvg>ZUB&F8KNjcp6B5b7>`FVhE~}8G7E#N5*%`GOf#Bm zKmNSia8Tkq-+T`roVn(*e2y>u^b;5ihNxqOAN}Axy0|3A7r*=jjAeN5%@1+r&8xV0 zw$X`GWsO%~x`?MfeWIy84JNr?+JI{B@4UvftG9=Tth|@f{_5H(VCWUT298H@Um=%gIzn=*lm=fwvXYt zwpMUuqBeJVPe0?O3n7qXDe``wB&In>T@y$*ZjIk25qUdL_iB=#ze^-Y8^GAAAz?Tj zxhQrbmhe6P2qcz6QO`kSBrnKev_|ceV~v@;QmiVCv+rEPJFi~G*>|pCI3T&P2Om0$ zfA817jJmEc*wT3Qy))QaZx&R({;$60R!(P&3cUKg^LYHJ<6+}$@j!+z|NLY4@FMxK zU%xtllpH4?SjO>t4?srz#!hE9s`Nm-|II=$q91eODOOdDT5EFtac&-j^ECp5tmX2- z9FE{6u($oF_EPrmG3i=kruz9w{rgVPw?T-Y$&OnnCUGYP`J82tC=!Iu_xs2kgK}Ky z001BWNklWh%Z6G9X zW%FH>#m0LHxE|YOeEK_c8-xr}CP?B0OmJvNh|+Z(eCDk&fqg?uLX3hO9{+P@DK7AD zE9&jd^z^iIZ0}fyn_HgYr3lQrB#xn!LRtE9z6kU7T|chf!~f5kAZVbrmAA!gc=2(J ze%^<*z+fOSDr;zEVTC0gzgtPw+Mre%Wz{V3%t|yXM;CDH+y z`rwo{9upvZVOQ6m>%Cc{nPxPyUlJ~QLr>}{_@04`eS{TwUsnKax+*l>Sj=c`011=5t(U!yo8bbg|o|0sI* z-Ja^&099SVQc{A2Mb5~}Z($*K2J|IH{p@%jgPKS>oac*Kp~BwSY7H>aYJhc=(C?aP0UBz!-+ZA+BA!ip}*gKKqlW zaN^WK96Pz#nbmJs)$Sx+;QMv!fx5PmE(|!ANV6XDULG{<%CbULRnWDDVH2IP!vc&y zP+TOEEtv=NOvw1SP5SzI!M-k^Gyg&blM(`(O;r<(I^tG>?WISr8JaQ zxcI?_6Q%@?9ACt#hYo@Zjm^z1;xA+w4zC=Be#GG5p&X;pH~?&&49~iUrt%kVvMpX=)i7)*&(}o)ZRHHQF%|SJnmL$+kd~cNc>HR zXzb7qZBNeed7j-xK|eW4<3NCU-`ZH% zs&tP54^;yT-1>$>(b!u1B`xE6dI7d~`s^*QP+eQjZvef& z>qd670?@6)CUG1rr##`Nsw#4ry_vU(?eTu|iZAzlt!)R@2V-Ch5=ojO%X(nkEz;B^ z!dX`ps>*55+3lm=JK@kOvV~P-mRS}R?z!&(p8x8@IC^{mTyhMDLujWQ(ilf_^s)?g z`5*w``t|F9K{)GUU^`^J$-_ZA;uFaUO4q+T@_jOw zFK5%qd)MXt-M(4pFCrlXq_eB8$_iCk&E1H*-EKZGYE=VcKys4HHbw_SNMjkaCONCB zRM5Knnv7~%7gZaV**G|t5Ih1bhpIKIg4!IvV(R_jt+lA?3WLFbn105P?X=Nht@prz z<&fD1gJGa3w<{MjaV`3Pw*RES1EMHKp7*e@uz(~y}$q(zS6_qd-}Tyznjpv_YJ)UQ!6WGmDoL3qlF|{1nnNRBO7ZxE zD>(h=5ga+O)XDV1jr_FMD9Vypex44*2+uZ7e7CAAuu-e^HU`LmIF67c5f&F0V2py% z3gdABtzE{pyFHv~%{Yz|^!qvb{XQb6{8N<`hNB_221AU8qtI@I=VEQg_rSWtgLMD{ z|7Nz(GEnnxT}8||3;35Y>=Q}|o;YMWoSR8W`?=&CV?O;dSu^`&+gL|QDc#AbNzuj` zMX()6Gat+JhVB0QT3eJ=4WIyL0+Ean#pIo5p^^0xEG{j;G8-hWEr4JBjptf!GcMCJ z>-_ULm;kiZsOpjsV`j-oOSfA>>&!LEu8f%59*Ujl=F-xV%iPy79v7WbenNULeBW1N zUZ^C`bM!KjA*<>dqtO_H!2qMt$N`2Hf=^(7Zq7*nqgsc6IZTW!C)|e)@Eu8kaPFG2p$9_+EQAqB`ed|O}B%!#9*uC z?&?m^D2k9K84fNx%{sP$;c(FTS^szcJiI)&UuDj+3~>}e8-uOE0K?%BqtPgAH0FGyGwFTbAjBYt91;{a3Tg{ zEQnoLSfoixjxkE1uJz6o+uNaf@qM1Lkd9=+y>vC_7!@N(A&?|74jx<%rQpWK2F?9D z0f1nG&AEWqI+$bF7WnIu(MZ)(qJs(!l?&EoXjs2jPh|t^7*R~?Ci(-Qi`7|haOZezCy#}j zLgGKF+m1cGy~}90(v^#G9HXvP*goT&BTY$@jwrXPW0tTTl74$kBZ#GDoJl-$!kk4> zfC0fHZ)Ii0QFAr6T*ePp*-nOAx{U`3_Yh?kYyPyJ28&Z@g@daTNn<9qyXfC-M0agqbpCX zwXS8ERoc(I8S*;B#vnL+>VY=3XaeUNohh;decuz}EG4LRJ)FIQf*N5QyX0Wqcb{gBKST z(C;sx*UJ#c35+!;ivnAtQRv%?vP50go%60c=5xu14~QD z^Bf144+bfzwY9a5$DNnO_PPOWz;NCL*DkTW%ywPVrlOQ&lId?z6cKGVOT%+et~wYF zhZwZ__KsO6>kebMW5zPDPFPd_Zo?fIqt?D@>p8XQW_~X8upkEu#GTn@7v^I=>u-X4 zZ|^2B&t)p^`b_D1SL@telv2SA!f0ABF?NogmAyR6f)j$ky(n^=dtJ9A(oF-3O@bW$`_}ELw~&7B%6Y;FICQO0 zS%-id>f?nF(9kHxV{C415lA;0qpmBoS68_;{Jj0sboo2ir;_AY_VI=*Ta#+c55I%7`ng#zr&*BW=&&1k0xt2DH5g}ZZk zscItUl;Z+bSwU5bK%L3!!rn$e-o&BigN!>y9soxvHqaU<%d(ZN>CZgRk>`B~A(7`f zx!ekY%8`}mnrSK2xOrw6vAK9-3=l5Z$%;Eg-pi5o915SNU;wtZ2B;iX03;!OTlZYa zGoYMWWA04gTE@7r4Uk1Kz$m#h3uYbru7k`o*Q%SjJz5j+oOlWDe#TJjpu^L@4Z&*c z-#Uk0Q4|fp#JH-YDJrzI;3$ zqpm8bx~6Q>>EnH=ODK693q&$P6jQIB=Q;8|5owYnMI1YfpeTciaKjTxf|Yih#BQoW zwqNtm>q&5$k{I{(4lU7u)7*ZJkcn~Ye$#xF)&zhz|F)cg8B3E6&N_*5FG&1e(R=I2 zOr+p@13_u2_E3Z20A*E% zK1gc=tyNIRA^N8b)q&Qk!ydcc$c$bL#k|<*D+~rh_u4g-(pc#C zk)$a&=MX|7PEtfsjJl$U2F=-{u3=}MBaIWtNQT~BIq=YLEe-|)jEgbKq9pYnV~GOI z8eq@^eZ4Fro&K60Ln**JTeWowttAlF2I{ag_0!a@`o7${GT*WZuRlB8xch^VcY6C~ zTahyUH1Pd#Mvm^xD%ngRRkqRksTxNs7^`9LBH?>ufl5`V%c`@a;Ef$UFCWYVsxF5N z2!ET*w3iNmZDWINCvCLY_V?-BH}(J?Wi8`YVkhs{u6m47FlN|HF90yk!&q(k;4;7% zM#CY55QyW1B*h$Y#`pi$&}Lmxl&Go#!{I25+Pqx2(ly#n*Tz=B$a%{cS`q??x!3FU z+yQK9k;qP?S&YwqFF2s`n z$T@!h+B>Bf+=Yub?lUCE)*1bt(O`yw2?ow-x7=Fe*lQ;6(PvFRc035|{HHaA7fx0d zbAHyiUlhA=3)d5;^C<;u3mU4^>&h0`4%7 zjus1Ot%$WZ8e?3H-MDRl@z^sOO`!U6-rY>IhSr%0VATODh+^Uj^m@6o^M=#*pU8OH zWpdwlTRYXl`oL&JF?-4WNZXz*DJY&c5-rCzo=_Ie3oq9)5#^2y|o0pxqs8AI$YWTdCX<{TGdc3R-u#v z3{E7Yr5GfogmB~}!UPQJT0u&pEa!P14!f$Vu(7cj=IO)H2z6CaHg{b34qMHS@@6{2 z098@K8h-(^knN=u$n#zYXbq~>tdY86e!RjgtYIBj*Y-BGZp+_V0_FU8GnDeKC$QnC zn&-_NK6*P~Jl6S?`-;Vn?0f|vyIJ0ZlZi5b>wotB>8FCp7z4vC8BQ1rDJcWdN-jqf z#UVQxquoJ3XgCQ&n1FH<-Pz3jU2UwOUH<#;w--a&-}CJW&7uVu7Xag~bf@vs!omU= z+`%PfU>^DsK9VvJaio-BU{JNfa5MyC3~8E@Yp&Z!EXxwBtJko$wuaGY45c-RXXpmm zo0MJ8R%}>+RHlpS%5; zE^=>SIiHg9+Kue>o(_VWK<_=k%#DHNyOhB0lsfxrxZ8f1)b~=B6OL#iWkmCE!NZ8l z_^dw_>^f8f{y^w%$90uT+Wk}K#vCHO+ zb3`uag=lnOv@xj4l0ZO4<{BFt8?e?Q%Q9GN(d+dB=%%#^%SuW$4wFpG=Bv!wm+u?` z#-Kt)uhZ=gM4;!K#0mNfeblPP*p9;}&zHCUaPv0P#>rbTSTJi~ErXrfi*qC%N3?0g zDQxHOW=<>hi6^B_W!WV3Dc9QeH*H8G8qAozvxDyNY`zmf*1X9Yb)}&>hgJ$o)KCs> zZhysb#rr4Z=lIqCGdbzx)B(gSEtZ6DAUt z(m+v6?}$r@UX}&yq^jyLsO( z;M=x6|M(=ZjUUzB=$4&nvGMjnyVm9w+uiJavPx)X_${es(FA#C*L^bR{piKJ(zyE> zx8%~UG_3;!Z7V(c%A=nzU}0$iaTJ4bhPtY;xwYwpDD`~gpSz8>IEIvx=*W(vPh1~{ zs;aQHMb(2x=<_^Bnk4AwIpp!1q-jc(haQovx5Z4Jy&G&b&!OeiOf+0)R>^3G z9!~Ufvh%f;ksB~)p_14MiT^0&@i~}NGrA$O3$KLY%r5rJ`<9Ws1_aJSsV9GSvYqh3JL&AgwwZH#nP|pYFpE@LLmLA=#m%06Tn|D9 z9r>!-cFRy}i}8p|AxKScWGgP%gS=G*~pj(=?_u%38<~f644AwAkVf_Hh#gcWNcf@Ywtz>9{ z&S-C5z@ruHAImkkdxx7An(AKItP|{R2lbepA85ASm(CdQcym}|x5uxh9>aEjzFjTM zDvLu>5-k+m0d}gcp&ZVzT}8sZG#KYlN;}YQhAsERFRrSZP<^eSjX|vx78d$Ql9ZHp zmk%Iz!N0M&fzfCLr6|env{T^!?I#XpSp|^OGxwy70!N>`@+LnZUzWE{)Zk2OVXbhp z_%>bF19yasGbgUeEDNJQBDC4S3uyQGY(g5_ZsT>k*UfF?F*(~DpMDhV@eet3L}&b5 zb3fF#>!tVl|2O)(>k4&Ub*`0J6^joP zr8LZF45Phlc;!Snazrx1;?feCOlB!IHa0LA3{lVY3AA$$01A8s;tn;h(T_-zB%wpj z8I?@;zX;_#sqau}$99NzP{yc9T0dQFvpz7jS*>F zm$;I>bmos{?kPixRIH=XW;IY*1+53Ds~UB!P*f%Q{XWt(bIUXRz*<~iU#F~J>kj&D zClAsI@=j$dH>gI~$>)qiiU?W8pfwSRYF!84KCg(&*#z?5a%=7|RcuqL8<)MkUp>i$ zJ2MSyn?9_K-nP|tjNKJ?e@|t;F|gLm9NWq1JKLb&tsMbmAHCmu;BNP#b=9W?7qFc>49Jfk(V9tGx~ zs%!M}3cX$raU7x7%R)(>Wt$ib24oFhnoe-DId6(F7PYD&Y7ur11gFVEnkEk9;~0+% zXL~h-(S{5+TLEv{0)K4w=g55T&V5d|FxvI#j(KPTv8s92S~n70e9m^^b|Bo2N4wsc zU$d`~cbg*oJNIkdpYMziCs26Kc}I!ev^?h6Ha&!Qv-PrJv_PY#wB=3fLiN;CJMkL1 z1G$V7;Ph1GvMiyL3gVb)N}73DmLbbBY`R{*EK3;O)!St=-V?1&DDwdZD=3@hd5)z6 zOGu&^MOEVZ+8X$Ej=|P|1UJm|taZYbdJ4DTq^A}1^el5ac@wheZ9^3HF>v;cKZH#4 zPPJ$CospfNWmqq)V4AP}+ih4$*cqk%1c8XGohT=3hu~@_J>8b1a-ttp&MBeWc!k?xXYz;6R4MTM>4}$W0260RR9|sOB z;oyN~FU>SpUnbulM#tbtq3sSRbkb7-3`NY+ASjy_&-%kL#G?Y&59~xl* zrd#CtRbHhO_4=wtukImDNq95MQYW^VARVL_4h9&tSAR|Wup({$EKQL2bM*T;78e(h zw8lnvsq!O&OYWVXG&+yK>4Pe@Ruecl2d6j*u{rhYiDsOB5-Uq(t1AHWh zf5)K1&Wzk?vkQMePA9d-K9G0Emi!jMmYF%FNINOmF(ci393V*=PrtG#oX`8jzJQ$o zB-^r6j=$ap3ui6Z0Dx8oT9;7H=4v<`A%Z?7C2BYB4 zlQ7FNq-hG_TAHeI8voilhazfKLJ#hpuG|ylp&v#dK$$K8-&t&7?L{YRS^?kCZ$FM| zZ?ekrpSM?c?vQhWjBg7B;J9lHZa!6k&sbM!CnR21S6f)rnp9!iKw#*t!j@EJKtz@XM?pTjtVmB!)iuhpK$a#@bxa1AMu)9DqiOTVC=H_&?IMJA@>X!N>4@SXs2jE& zYZ-bmc%z91q4#3a+CR`o7*G*+m`RJ3$2r?AdQT=7)>yE88txrg<6BGcGlM6Nn6O`O z_52D!IJ@XLCPy0|fLfa=zP}HCW+$&@%AQ8IBAd_bh^JZ-A7T}3gcpo!C>IPNoR)9ae4L?jcq_SW6e zgL4`dnzOL5;dw2L#m}LUe6lt3h{FbUPP? z-+~i@tfY(5t-#u;7Q#D3HQ5aT)T2ta5yotGK-i={_Y}vV{c9%1z=%5U%Od0!}b+wJJ{zTLE+qBGqwX; zHq%q!A{w7PrBpDw^gegKX9wW?_f(M1@?$;j%r%+2=B-;!Va#WHpSj&DFtiD0t?S?Y z@{Ki(sRp)d-PtE_z*`t&my9tRGb_0!;9KjG6#Ps3@ZFu+&rb_>T7UXCz6LE*i1yD4 zE|4T~Sh8uvGR-c8D;XHK6M>KJVZnC)ymva>e9vE1RY!P~aDzsfIJ7qIIgZMc4nR6Mp0(qwVb9+OMv-ygbn7!A((}it={+&X*YMsO%+6N%R zOV7tD4lw+;KZV1f&qqiJhiL`7~Qx|w*g4jIvki&&6zj}+3iGPw|1!=wQZLh**+DG z+y7;p??=q1>}IT)%1)D^$rwi*MTjB^#z3=dM|EXv8f_1;-&&_NGj`vBuIJm0=wQxw zy_p^SJEL51J--F#mR4A8_pk^8m|<_2b$X$u1@Htm_kGsR^q)|5?9_XVu}j3G-$4!6 zzj1B>|32%82m8JKom16MYUTNjH?%Uaw#I>bT@g;sITA;CHHMsGs;VLe8+Ojfv*K%8 zk%(PJ{&pITH*#e%=G1MiA7K(Q-+nEevqteYtP*zN#xB>NebUwZj$Pi&^4_DJp*LX` zjPY}3vXtAu-PXa*Ccnp8Ag#reZML-<#xlT?lPs;%Mvy`}Z}}0bvJC6A?Z=(WtY)Ir z-zh5XCwNVTU(H$?0PcT`H{!5eYWn;Ns=5D8ZOzB>x}2p|``_WDa#CWl>E~!Efroy@ z+$WO*s0UZ}bNw9<^_I;C@<``i1IEB;)k;;2lw9Gcw^8i)?F>a(5og_tW}vG=J2TUV zGI)o8zEO>Pm~AkN`ThSSRk*=5od8B_C#Zv8xp7=L1T4Glcg{QNyTQSeHSWD=coAV_ z*ZyhWmqghLO3vKw^M2Uhwl_9Ev-;9bo0h$nqmYnLm7*rEKyc9YOOlU zB$#9JG1aRx1b+HQ_OjXR9)D8Rm#Xy%`tXeFnF%@s!;9d%W72(cAh*Y87>prWHPb*; zwhGk)-(I+}7Fv`0j8>Ygt=u8r($_!~ z5o%BR_M{bG*VW9dzTIfeTReS|eeSLquM-?%3%?8BYL+Z+n=J1)1FTsZ%q;J4Hbdc6g0N&25UdIFKaEdqSj1%lTcF!@n4 z9{E`eFTV^mUWL)LR%Hx#luHI}Sa1np``P~!?(Syvn}#McwKm|=jq5@xrpT0126dXc zu4z5BEITFqu4uAzI>4I_cw_hcewZ1OQM0a7CfICD1T!3H1^XzX++{K>iu9$uwHAgk2;oEpBZ*RoSMsF; zFP{8~fB5|QAN~tq>m5|JCY>?s`X0leIR}il17acj?;ipmFP1mY{KB~L9F^-`2#a%s zZ8a+GOB7BTYaTkjZML8E)B2bXy`2u2_BBb;*DbEXqz8cMRtXIDmMYj9kE|=@{O=sU z-`Z|ASM{_^F8GJI>r^PIx!hCk|Yp9I)Tc<*-CAXj^9-Iaf7et*0crz25UuK zi-Oyl-PzUw(Dt?W-nwF5OSPLo*RJXE=CDCykAgY`z4B;m9kRKBbynOd;zUC9jw4xq z6o*fJ0V^vCaT31}%Lq{vL(0bHYs$cqa|Y#pkq`_bijY_ftTY9Ku^@D1C8`9s8{P+pVkjeJ^hu5T}g> zV}O(bNs=H*QUE|P9%DQj1xe^VqvCrg&F4A%?)ulX9>LRMgCWJ7N42n_I-RUyf*Y;( zs1F4E8_o7jZ|)U#I)UzY^ZlQ&q-xX(bSVU6FGZHdQ1J=y{{2`y@)`7cIr@t^@*epG zBx!c8m-T)t&9V(HBUf?r&i3I{PtX0Hu@w-)0&#@Y^ZcM5m@;$`j3SvR)j#?R5&0(BDAajR+c9lR-3Ei&(KC=Fv`F_zT7$Y14 zPZyvN9B~wbfuSlZY;6rN9F9;|$}OPWn#65){Qp@NpS#BcCTH&LfBV3nHJ9h!gO1O5 zvToPjwoBu`Le%RM2Z{!32kN{}m+$ zU^zG!|3panVjRc+IE|C%d)XL8F+#6jqAL3+mKITzr%)9Y#-mjj^FDHR0ZCLk)502t zF>uXb&>)KKL!d2Bw12zF9>2w&BTFg`&NY>|hWzEY;E+-Viz$+mR=0>yV`m2B?tXIj zKeJaw8a}61oKt z`_WrGN=(U=DzYd}kY)+8G((&w=wE; zta}RjTX2AEtLMOWej1ZHen7KP+i26zejsg|VD=A0*4^$Uc7mLIB3R4HyA$L-`&-)X zv)m$0Go)#RiX8^aPa$47jjX?fG)V|=N#h^{8fOV&86(M3#BuUUlBWM8j^h_dGK@S5 zqBuq*CAc^6>_~`h6Z9eQje#*5O4FZOYt#5N0Fp41$dSsO?!wUNe4obLPikF?{7w3`UGGb{^m&$pj(-eTUM}V#hV3svn z(Jv=(A-cTh840-Dmlk z=h<$8K5Xjvg$>*IoNJ?C6xkSSqoJsOzfT$Uyi)4gsRB4sIDs% zBa$kv1|I_DC1f~{ETRgau4@M_x>2Ab0C{<0#(5)7xQ_!&rrK_nb`+P4#2KJPWmXf31^ZN1v5?9QzN{U*zH+o0`jq#aIZ)Zd?5^2tk+ z2(p)e^Bi@0Kcf6WWJ`w-$0?FHL6Rj%q8Pn2gG>^ny##5JA)@~MYl6!cWfZ><#qyjK zk?YerWp!uJ$ryv+42%o+S#dX-qwP9AM+}GUs7f)$RbO zplZET>-v{eRsT{|6~9(hHQ5!7OH_4%aY^NWS(GTp1;%9wU9Q25FCo^Kun=!Sl?qi| z!!kfv4#qf)6J2NRN`U!n*4iV!TZ4TfnEVCdBU!1BCg|Ixz4bjYyNQ4gCCCmX{dNR` z*0*IO=N=G~y*a#Hdpn!A0^PcJ@Peahk|F6y)X`y>=mgTmhYfYzE&pCU;S;r2#3kEz51Dvt2*1%W?&6eQDmgq?94s>mxm4ea=nus&H zl$Yl1)BJtn!luesyyZ<3zr>n%GXP9qvnWF;yr9z>?`*eMAa|(d(4tjwcZ|BegV;^rMl*v_ckrQ+jl~z72Vr< zb1{=}4d{FCQ`xRm16c<}grXmy4G&@N@4_waW8nrEYv6`~?;5OyGyIx$4x}}Vbw^~) zq0#108x5@pN(yLAkXk`WH4}0YfKcm;X2=reK`m5mI3;^@@rF3hZsTJThAeYRG z2qhz?+=-)bkW1Q6J{*LYkURUIVnT=`{EB&ikOJc9;YW{r@dI@E4g;R^K7fzBlMD_3 zef_7~m%bSUKGoG=sbpWBeiQUpd-$vO=)Wf0zc0|gEzsRm@LZbRU&-dRb~b&pH%A}2 zwNBbKKz12vw;Yg#LNgB`-QQvV{4JbaV6X5FHWG zITLUiS}I7%nH^oaOesB+utJFLOK|ykM*ND%{Hs8JTLo~b5-3~-@!i1G0uiC$5P#22YMj{a>;n{(+QLmx2nzlFByLZ{Y`&Zdv|%Q>HpzZkNh@E z_O_AD^JdB3$8DJY9d2cf)3DYdNsD6s1-kb)(DDHWXEE3T+8GSp8rvERB70{ES16@LCf>s;ZT*`jDwr1Y1W^(Zxw5`7h=-(v(u>5XA&h=6NK&>pZ zTq|m38=_j%eu$k1$ZO<*x7=)obB zKcfxbKrJ7_EIs(eB}6L-F<(w1Qb0)s+)xRuf%1`nev`-pv-c-wr!(=nnSAde=xggj zez^m^vVOpu1l-1^T+jAgwo8!Fkk+Eg2WZ3JA@6;I#qb&2U@$lfYlprOXJG9BO$6sG zj2SRkb1scJG-M8qF~>^j?yuJ~y4E}{?AcswWb&(Ee;+{q-9Z1g0B{-n>lC zd+_1jU)~f1T3-^9;!4K6gP`ww4>Rav#LKhu-Xq>Ezzd*{(B7WS+f=rf#;s;!7aM^J zr3KuuK!rjve?xP-a61oS$zm8BjNvlf4!k5ogMl*^MBJ-8>z)~B4vEa66zZw9_7VX% zdFx3np&ggZkkH{ z5E0^tueRSFm{Jj(bS6n}sf|HVB@$SEPD(iKA`@1z5O(9jB(If1s;WV&nj z0kQ|Qd1RLoUY?w-#Ut(t=-&b4?V4&Gs7Q@29ISV%| z;q0{QZkUBP4u*wB&aJag$e2T^^ixX)QZvBUV3!a=aX`HW>mMxOJE8V2*}Ro$ zTdrHw^v{)Z3S9&1HMWc0Bi zd#nvF$mo8>rj&xx5`Y9L#V6%gZrJ~5pnq_nzl{joXjeX;dR%#un^&W~p#NGz zz&Zkm(DYwX^k1Ow{}aRFKJT#i`8l)gto5%4hk+cA*)#*4tbL-DdTPi%)x?=xYYn9p zCxTAGO}+Yu4D=5g^lz&Gra&NCLq4*s7J`&yt0>@75NJyLVa^CjuY3AS zp#K9$l_jsORX@5V2nW!7R`PQ>2_h3f8*Qp!NOU`S8K+=xS^k@T3&s% z7S0e1*+VksP?J6;W6qgz*U*}JkKV1IHnRCuGVVhM`JDy*bwS|jHsEC8lsE1HS}n-A z>jUJ81dJ%9Jc=Pa&N=VJ;2(t$8R&jQj2j42|lR`4+(UYvo__ZY-;Ea?I< z6{N@(-x$DZ(i5>`jeCt zYC}^Eju_}Gu>+W|&=wD27hhoE79dAh4g;*^Og^}2e$HSg<6w*ikv%llKG9k|HDu4H zvs9%ulmKMER@0)7*shtMUuE9!)FkJwg8p5IKn?^Ish{hzif==Xi8lcYR{$mFM=8aF z=;J}oVK=0N7(Alqk)V$rF^uruV;p^dEx@mSh6>+d5HDcG&k!xH0{~bfVCwxYRRT={ z>di{vy}r>>PS%W&N+70$)6+AqR^I1(!ymHsPJ6-HKw|^s^DI3BP1M=JMM#0c5+DiL ze1)RFgk1g;Zn%fVFz~gSb8u#2-W`nLahtIN_v?nvjiDpb=1?0t(o(}vUzX`wa+(xc z2&)le@)*Ye<^K;3&*5+iB{E9PtT*3HL?Gon=a(I9?J6-S`;PT* z48@y3|6bU;PQ*=O5;M?er`!(owGGZ};vjN`G7?5>6y?zD7s&KA=-$6rO~x547fTRP zAF(a?n8mq%&1RUabM{z~KGsqnTWgP$)=*lrs!ZRAlS)E&St)TvQtGDfKZfU{1O3$i zAo}HBYil>YoY}dxZ0M8KTKgVAM6Lxj6{M7QVhoQ{PWw5hJ>CH1E5P7Ad>Ro$g1;Ey zgJ-AL@il^vDB%Sb?K_xujzN3G$W?_9at;9NOF(gHG602HLHM@{0!_-<*Gwvb5F$=a z&wjIggF0E;*0+GXn{2dF`M;@bz+tU|afB=uDD)*N{R8g)*Kh-8Yr9~{s9_jj$-+4c zvOGI?JXV7-^o+2CZJ_^h!_Jg2+(T^+#HfaN_Rv2T1_xyW#bqZU5gp)6E zU%f_%nR$ka^|-I!LtknIgqRuQi4Wk+^D8c^gq*XwfJDrk>HindzpXE?t<44zvy$v2 z8`T;NX^_!~`cEkO0kV0B#qtXb1ItO-VZhMkqpac8SGzE<#=*IPW!jB7CNhV{nnR`3 zIgthFezB$$gz9s2spg#u7N3ywTJ|N;$WK6r;gbOUP5u8S4Be<$LLq^i7x|VNVs@C!p9L|dv#~{YJ@-xAo@Trn;g3JWGYv5=0VG z5(;tI-rPeh7k^^L-7R39#n2_A77Lb1jAn#@Sl+h<)iOD?UHlP!6f8Nx9Y(7U(4dN8HyxL5hSN*ov4*xXCS;wF2cv5SZGP$u(-9f!8J%y?l~T~8fF>^KyWf<_#a2Xh3;JKu2DA-N^4d56h{pPFrIgwK zJ?Dg+`#Nw=C@JlwlJ{bY2XPFKYRT|^g%J1(FvX0~Um$wlMM46`(PQ)@l0OIK?{Qzg zz`{fX9}#n6rXK=zk_Mj$z#A%oDF`UiP#al2gp9LS9rPO@U;EKxCgHHbv^T7QE?PtB zl2VowtRqCRz^J~4G!J3#eK{}541;BGy9EX}G3+cl;fw_tg0}YD=&t-~%#rSFyHFZN zYbY%tq`qX{aMKL^Q!LxJpnuOi09u=gKz^;D6e0qx9smFaNl8RORGtKsQcw%u1mu+1 z=P%~nl;S~3;c<#-H^hh>`VK%07*``728{u$u!0{0ydM!_gui$V%HLrjPI2G;j5J21 zm>7Ul*2j7k7@L&%jcC4RcUA?A(iTarvQ|M6ta6CZu|2s=s(~9FnO7kX;xj^IsoLv)j-OKHSMIB_H&2_ zF{k|)JYtIQE0zeK{NjBN1gmk{6Bw}y9`)iUEadmNr_MksBdj8Fsa)bq$)pw-^g^lG z3x)D=P-#pA zrd&`;LP}{Tr@WVPJP1DRmlSq<@O%>xMx+?wFIEUCz^?+vF!D<9IKqdBv^s;SKjJg` z309AYA;ZT62`-JLCY}gL1@Apxo&MY{ncG~pqgI%Og*6JPEpee90QMW0#TN|pfzMB! zU7x1f!NRyDU$mL&sHI=6kvX)^9x5rJ4M8dDTXA6Ky#pOL0DW7wZ$W=2fIn?@T@3_v zlLP3oVC)pc6+kNmxpqP@W~7| z&(5{h&`LvV1tBj>M=>e4F>bt))we+3g8rip0Gk}ZJQe5xpqA3T<#`#Xl!}xBaw(5e zhzB8s$0^30Ss=8VgnA#4x+0Jdo|lMXL{1sGaD{9ya zOLgR6oCR5eAzqfTWS=OaW8H~3Juk{g$Ua)T4&+ybC$>P}g8q}~{Wp(+=GUk7-z)Oq zlUPV988x#@P^}puL^cXd@gRrzC?pmKO_3FVl4rFbRu|4|ZGnbfTJv7M)(WI83scxx z?UjWgjRhI=Of%bl=!lLbX-s}=b2gWPuhvxG4cHi~-9*4`fxZR(CmjSfe|=pQFj=U)5?IXh9LuO2!`B| z*6Jx4`$Q@AjEJB#fpkA+=|?R}uv(B1-9+&gpl?CG1^xE9B>-GE3M^MV0w%A(c@?;@ zSZFF~C#JMtOWiFw@8uHrbIR-)Us<36m3Q`~)_?%Crl-cxk$`$?EFEd3&y~`%J@Vwv zGWF)_hKzm{+*_b;LBD-|(*V#(!JPYUJez~$T2XRBtNeSp<(*pUE^6DUt?e`+&P8iG zQi^j3`AiD=OldYv1(<`t raise (AtomError s) -;; + let to_string ~units a = [ Element.to_string a.element ; Charge.to_string a.charge ; Point3d.to_string ~units a.coord ] |> String.concat ~sep:" " -;; + + +let to_xyz a = + Printf.sprintf "%-3s %s" + (Element.to_string a.element) + (Point3d.to_string ~units:Units.Angstrom a.coord) + diff --git a/ocaml/Atom.mli b/ocaml/Atom.mli index 28915993..4b1963d5 100644 --- a/ocaml/Atom.mli +++ b/ocaml/Atom.mli @@ -7,3 +7,4 @@ val sexp_of_t : t -> Sexplib.Sexp.t val of_string : units:Units.units -> string -> t val to_string : units:Units.units -> t -> string +val to_xyz : t -> string diff --git a/ocaml/Basis.ml b/ocaml/Basis.ml index 237e5547..869fb132 100644 --- a/ocaml/Basis.ml +++ b/ocaml/Basis.ml @@ -35,11 +35,11 @@ let read_element in_channel at_number element = read in_channel at_number -let to_string b = + +let to_string_general ~fmt ~atom_sep b = let new_nucleus n = Printf.sprintf "Atom %d" n in - let rec do_work accu current_nucleus = function | [] -> List.rev accu | (g,n)::tail -> @@ -47,15 +47,27 @@ let to_string b = in let accu = if (n <> current_nucleus) then - (new_nucleus n)::""::accu + (new_nucleus n)::atom_sep::accu else accu in - do_work ((Gto.to_string g)::accu) n tail + do_work ((Gto.to_string ~fmt g)::accu) n tail in do_work [new_nucleus 1] 1 b |> String.concat ~sep:"\n" +let to_string_gamess = + to_string_general ~fmt:Gto.Gamess ~atom_sep:"" + +let to_string_gaussian b = + String.concat ~sep:"\n" + [ to_string_general ~fmt:Gto.Gaussian ~atom_sep:"****" b ; "****" ] + +let to_string ?(fmt=Gto.Gamess) = + match fmt with + | Gto.Gamess -> to_string_gamess + | Gto.Gaussian -> to_string_gaussian + include To_md5 let to_md5 = to_md5 sexp_of_t diff --git a/ocaml/Basis.mli b/ocaml/Basis.mli index 4da99266..249c14f9 100644 --- a/ocaml/Basis.mli +++ b/ocaml/Basis.mli @@ -14,7 +14,7 @@ val read_element : in_channel -> Nucl_number.t -> Element.t -> (Gto.t * Nucl_number.t) list (** Convert the basis to a string *) -val to_string : (Gto.t * Nucl_number.t) list -> string +val to_string : ?fmt:Gto.fmt -> (Gto.t * Nucl_number.t) list -> string (** Convert the basis to an MD5 hash *) val to_md5 : (Gto.t * Nucl_number.t) list -> MD5.t diff --git a/ocaml/Gto.ml b/ocaml/Gto.ml index 69aeba37..fb576ee7 100644 --- a/ocaml/Gto.ml +++ b/ocaml/Gto.ml @@ -4,6 +4,10 @@ open Qptypes exception GTO_Read_Failure of string exception End_Of_Basis +type fmt = +| Gamess +| Gaussian + type t = { sym : Symmetry.t ; lc : ((Primitive.t * AO_coef.t) list) @@ -68,8 +72,8 @@ let read_one in_channel = -(** Transform the gto to a string *) -let to_string { sym = sym ; lc = lc } = +(** Write the GTO in Gamess format *) +let to_string_gamess { sym = sym ; lc = lc } = let result = Printf.sprintf "%s %3d" (Symmetry.to_string sym) (List.length lc) in @@ -88,3 +92,30 @@ let to_string { sym = sym ; lc = lc } = |> String.concat ~sep:"\n" +(** Write the GTO in Gaussian format *) +let to_string_gaussian { sym = sym ; lc = lc } = + let result = + Printf.sprintf "%s %3d 1.00" (Symmetry.to_string sym) (List.length lc) + in + let rec do_work accu i = function + | [] -> List.rev accu + | (p,c)::tail -> + let p = AO_expo.to_float p.Primitive.expo + and c = AO_coef.to_float c + in + let result = + Printf.sprintf "%15.7f %15.7f" p c + in + do_work (result::accu) (i+1) tail + in + (do_work [result] 1 lc) + |> String.concat ~sep:"\n" + + +(** Transform the gto to a string *) +let to_string ?(fmt=Gamess) = + match fmt with + | Gamess -> to_string_gamess + | Gaussian -> to_string_gaussian + + diff --git a/ocaml/Gto.mli b/ocaml/Gto.mli index fad133a3..753cd81a 100644 --- a/ocaml/Gto.mli +++ b/ocaml/Gto.mli @@ -1,5 +1,9 @@ exception GTO_Read_Failure of string exception End_Of_Basis +type fmt = +| Gamess +| Gaussian + type t = { sym : Symmetry.t ; lc : (Primitive.t * Qptypes.AO_coef.t) list; @@ -13,4 +17,4 @@ val of_prim_coef_list : val read_one : in_channel -> t (** Convert to string for printing *) -val to_string : t -> string +val to_string : ?fmt:fmt -> t -> string diff --git a/ocaml/Input_ao_basis.ml b/ocaml/Input_ao_basis.ml index 82bc4964..88e277ee 100644 --- a/ocaml/Input_ao_basis.ml +++ b/ocaml/Input_ao_basis.ml @@ -17,6 +17,7 @@ module Ao_basis : sig ;; val read : unit -> t option val to_string : t -> string + val to_basis : t -> Basis.t val write : t -> unit val to_md5 : t -> MD5.t val to_rst : t -> Rst_string.t diff --git a/ocaml/Input_nuclei.ml b/ocaml/Input_nuclei.ml index d050ded9..ca81629e 100644 --- a/ocaml/Input_nuclei.ml +++ b/ocaml/Input_nuclei.ml @@ -13,6 +13,7 @@ module Nuclei : sig val read : unit -> t option val write : t -> unit val to_string : t -> string + val to_atom_list : t -> Atom.t list val to_rst : t -> Rst_string.t val of_rst : Rst_string.t -> t option end = struct @@ -134,6 +135,22 @@ end = struct ;; + let to_atom_list b = + let rec loop accu (coord, charge, label) = function + | -1 -> accu + | i -> + let atom = + { Atom.element = label.(i) ; + Atom.charge = charge.(i) ; + Atom.coord = coord.(i) ; + } + in + loop (atom::accu) (coord, charge, label) (i-1) + in + loop [] (b.nucl_coord, b.nucl_charge, b.nucl_label) + ( (Nucl_number.to_int b.nucl_num) - 1) + ;; + let to_string b = Printf.sprintf " nucl_num = %s diff --git a/ocaml/Molecule.ml b/ocaml/Molecule.ml index f0800f7f..a9d73432 100644 --- a/ocaml/Molecule.ml +++ b/ocaml/Molecule.ml @@ -85,7 +85,7 @@ let name m = String.concat (result) -let to_string m = +let to_string_general ~f m = let { nuclei ; elec_alpha ; elec_beta } = m in let n = @@ -94,10 +94,15 @@ let to_string m = let title = name m in - [ Int.to_string n ; title ] @ - (List.map ~f:(fun x -> Atom.to_string Units.Angstrom x) nuclei) + [ Int.to_string n ; title ] @ (List.map ~f nuclei) |> String.concat ~sep:"\n" +let to_string = + to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x) + +let to_xyz = + to_string_general ~f:Atom.to_xyz + let of_xyz_string ?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1)) diff --git a/ocaml/Molecule.mli b/ocaml/Molecule.mli index 1a3d9715..f81f28a3 100644 --- a/ocaml/Molecule.mli +++ b/ocaml/Molecule.mli @@ -20,6 +20,7 @@ val name : t -> string (** Conversion for printing *) val to_string : t -> string +val to_xyz : t -> string (** Creates a molecule from an xyz file *) diff --git a/ocaml/TaskServer.mli b/ocaml/TaskServer.mli new file mode 100644 index 00000000..f16ddaab --- /dev/null +++ b/ocaml/TaskServer.mli @@ -0,0 +1,84 @@ +type t = +{ + queue : Queuing_system.t ; + state : Message.State.t option ; + address_tcp : Address.Tcp.t option ; + address_inproc : Address.Inproc.t option ; + psi : Message.Psi.t option; + progress_bar : Progress_bar.t option ; + running : bool; +} + + +(** {1} Debugging *) + +(** Fetch the QP_TASK_DEBUG environment variable *) +val debug_env : bool + +(** Print a debug message *) +val debug : string -> unit + +(** {1} ZMQ *) + +(** ZeroMQ context *) +val zmq_context : ZMQ.Context.t + +(** Bind a ZMQ socket *) +val bind_socket : + socket_type:string -> socket:'a ZMQ.Socket.t -> address:string -> unit + +(** Name of the host on which the server runs *) +val hostname : string lazy_t + +(** IP address of the current host *) +val ip_address : string lazy_t + +(** Standard messages *) +val reply_ok : [> `Req ] ZMQ.Socket.t -> unit +val reply_wrong_state : [> `Req ] ZMQ.Socket.t -> unit + +(** Stop server *) +val stop : port:int -> unit + +(** {1} Server functions *) + +(** Create a new job *) +val new_job : Message.Newjob_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Finish a running job *) +val end_job : Message.Endjob_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Connect a client *) +val connect: Message.Connect_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Disconnect a client *) +val disconnect: Message.Disconnect_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Add a task to the pool *) +val add_task: Message.AddTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Mark the task as done by the client *) +val task_done: Message.TaskDone_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Delete a task when it has been pulled by the collector *) +val del_task: Message.DelTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** The client get a new task to execute *) +val get_task: Message.GetTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Terminate server *) +val terminate : t -> [> `Req ] ZMQ.Socket.t -> t + +(** Put a wave function in the task server *) +val put_psi : + Message.PutPsi_msg.t -> string list -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Get the wave function stored in the task server *) +val get_psi : Message.GetPsi_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Reply an Error message *) +val error : string -> t -> [> `Req ] ZMQ.Socket.t -> t + +(** Run server *) +val run : port:int -> unit + diff --git a/ocaml/_tags b/ocaml/_tags index fd4c4804..3f5cd9b6 100644 --- a/ocaml/_tags +++ b/ocaml/_tags @@ -1,3 +1,3 @@ -true: package(core,sexplib.syntax,cryptokit,ZMQ) +true: package(core,cryptokit,ZMQ,sexplib.syntax) true: thread false: profile diff --git a/plugins/All_singles/H_apply.irp.f b/plugins/All_singles/H_apply.irp.f index d0a41f90..f34f003c 100644 --- a/plugins/All_singles/H_apply.irp.f +++ b/plugins/All_singles/H_apply.irp.f @@ -8,10 +8,9 @@ s.unset_skip() s.filter_only_1h1p() print s -s = H_apply("just_mono") +s = H_apply("just_mono",do_double_exc=False) s.set_selection_pt2("epstein_nesbet_2x2") s.unset_skip() -s.unset_double_excitations() print s END_SHELL diff --git a/plugins/All_singles/all_singles.irp.f b/plugins/All_singles/all_singles.irp.f index 3b5c5cce..ad8648c7 100644 --- a/plugins/All_singles/all_singles.irp.f +++ b/plugins/All_singles/all_singles.irp.f @@ -15,7 +15,7 @@ subroutine routine integer :: N_st, degree double precision,allocatable :: E_before(:) integer :: n_det_before - N_st = N_states + N_st = N_states_diag allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) i = 0 print*,'N_det = ',N_det diff --git a/plugins/CAS_SD/H_apply.irp.f b/plugins/CAS_SD/H_apply.irp.f index aa393bc7..35c45fb6 100644 --- a/plugins/CAS_SD/H_apply.irp.f +++ b/plugins/CAS_SD/H_apply.irp.f @@ -20,22 +20,18 @@ print s s = H_apply("CAS_S",do_double_exc=False) -s.unset_double_excitations() print s s = H_apply("CAS_S_selected_no_skip",do_double_exc=False) -s.unset_double_excitations() s.set_selection_pt2("epstein_nesbet_2x2") s.unset_skip() print s s = H_apply("CAS_S_selected",do_double_exc=False) -s.unset_double_excitations() s.set_selection_pt2("epstein_nesbet_2x2") print s s = H_apply("CAS_S_PT2",do_double_exc=False) -s.unset_double_excitations() s.set_perturbation("epstein_nesbet_2x2") print s diff --git a/plugins/DDCI_selected/ddci.irp.f b/plugins/DDCI_selected/ddci.irp.f index 248671b1..0bfb324f 100644 --- a/plugins/DDCI_selected/ddci.irp.f +++ b/plugins/DDCI_selected/ddci.irp.f @@ -3,10 +3,10 @@ program ddci integer :: i,k - double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:),E_before(:) integer :: N_st, degree - N_st = N_states - allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st)) + N_st = N_states_diag + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) character*(64) :: perturbation pt2 = 1.d0 @@ -27,6 +27,8 @@ program ddci print *, 'E+PT2 = ', CI_energy+pt2 print *, '-----' endif + call set_bitmask_particl_as_input(reunion_of_bitmask) + call set_bitmask_hole_as_input(reunion_of_bitmask) do while (N_det < N_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) call H_apply_DDCI_selection(pt2, norm_pert, H_pert_diag, N_st) @@ -47,8 +49,21 @@ program ddci print *, 'N_states = ', N_states print *, 'PT2 = ', pt2 print *, 'E = ', CI_energy - print *, 'E+PT2 = ', CI_energy+pt2 + print *, 'E+PT2 = ', E_before+pt2 print *, '-----' + if(N_states_diag.gt.1)then + print*,'Variational Energy difference' + do i = 2, N_st + print*,'Delta E = ',CI_energy(i) - CI_energy(1) + enddo + endif + if(N_states.gt.1)then + print*,'Variational + perturbative Energy difference' + do i = 2, N_st + print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1)) + enddo + endif + E_before = CI_energy call ezfio_set_ddci_selected_energy(CI_energy) enddo if(do_pt2_end)then diff --git a/plugins/FOBOCI/EZFIO.cfg b/plugins/FOBOCI/EZFIO.cfg index d4a10add..88189608 100644 --- a/plugins/FOBOCI/EZFIO.cfg +++ b/plugins/FOBOCI/EZFIO.cfg @@ -1,6 +1,13 @@ -[threshold_singles] +[threshold_lmct] type: double precision -doc: threshold to select the pertinent single excitations at second order +doc: threshold to select the pertinent LMCT excitations at second order +interface: ezfio,provider,ocaml +default: 0.01 + + +[threshold_mlct] +type: double precision +doc: threshold to select the pertinent MLCT excitations at second order interface: ezfio,provider,ocaml default: 0.01 @@ -16,6 +23,20 @@ doc: if true, you do the FOBOCI calculation perturbatively interface: ezfio,provider,ocaml default: .False. + +[speed_up_convergence_foboscf] +type: logical +doc: if true, the threshold of the FOBO-SCF algorithms are increased with the iterations +interface: ezfio,provider,ocaml +default: .True. + + +[dressing_2h2p] +type: logical +doc: if true, you do dress with 2h2p excitations each FOBOCI matrix +interface: ezfio,provider,ocaml +default: .False. + [second_order_h] type: logical doc: if true, you do the FOBOCI calculation using second order intermediate Hamiltonian diff --git a/plugins/FOBOCI/H_apply.irp.f b/plugins/FOBOCI/H_apply.irp.f index 0a488753..d8ab02f1 100644 --- a/plugins/FOBOCI/H_apply.irp.f +++ b/plugins/FOBOCI/H_apply.irp.f @@ -18,8 +18,22 @@ print s -s = H_apply("standard") +s = H_apply("only_1h2p") s.set_selection_pt2("epstein_nesbet") +s.filter_only_1h2p() +s.unset_skip() +print s + +s = H_apply("only_2h2p") +s.set_selection_pt2("epstein_nesbet") +s.filter_only_2h2p() +s.unset_skip() +print s + + +s = H_apply("only_2p") +s.set_selection_pt2("epstein_nesbet") +s.filter_only_2p() s.unset_skip() print s diff --git a/plugins/FOBOCI/NEEDED_CHILDREN_MODULES b/plugins/FOBOCI/NEEDED_CHILDREN_MODULES index adeefe99..f6c0c1c4 100644 --- a/plugins/FOBOCI/NEEDED_CHILDREN_MODULES +++ b/plugins/FOBOCI/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Generators_restart Selectors_no_sorted +Perturbation Selectors_no_sorted Hartree_Fock diff --git a/plugins/FOBOCI/all_singles.irp.f b/plugins/FOBOCI/all_singles.irp.f index e2c4c01e..0594e56e 100644 --- a/plugins/FOBOCI/all_singles.irp.f +++ b/plugins/FOBOCI/all_singles.irp.f @@ -6,9 +6,9 @@ subroutine all_single double precision,allocatable :: E_before(:) N_st = N_states allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) - selection_criterion = 1.d-8 + selection_criterion = 0.d0 soft_touch selection_criterion - threshold_davidson = 1.d-5 + threshold_davidson = 1.d-9 soft_touch threshold_davidson davidson_criterion i = 0 print*,'Doing all the mono excitations !' @@ -52,10 +52,173 @@ subroutine all_single enddo endif E_before = CI_energy + !!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO + exit enddo - threshold_davidson = 1.d-10 +! threshold_davidson = 1.d-8 +! soft_touch threshold_davidson davidson_criterion +! call diagonalize_CI + print*,'Final Step ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + do i = 1, max(2,N_det_generators) + print*,'psi_coef = ',psi_coef(i,1) + enddo + deallocate(pt2,norm_pert,E_before) +end + +subroutine all_1h2p + implicit none + integer :: i,k + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + integer :: N_st, degree + double precision,allocatable :: E_before(:) + N_st = N_states + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) + selection_criterion = 0.d0 + soft_touch selection_criterion + threshold_davidson = 1.d-5 soft_touch threshold_davidson davidson_criterion - call diagonalize_CI + i = 0 + print*,'' + print*,'' + print*,'' + print*,'' + print*,'' + print*,'*****************************' + print*,'Doing all the 1h2P excitations' + print*,'*****************************' + print*,'' + print*,'' + print*,'N_det = ',N_det + print*,'n_det_max = ',n_det_max + print*,'pt2_max = ',pt2_max + print*,'N_det_generators = ',N_det_generators + pt2=-1.d0 + E_before = ref_bitmask_energy + + print*,'Initial Step ' + print*,'Inital determinants ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + n_det_max = 100000 + i = 0 + do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) + i += 1 + print*,'-----------------------' + print*,'i = ',i + call H_apply_only_1h2p(pt2, norm_pert, H_pert_diag, N_st) + call diagonalize_CI + print*,'N_det = ',N_det + print*,'E = ',CI_energy(1) + print*,'pt2 = ',pt2(1) + print*,'E+PT2 = ',E_before + pt2(1) + if(N_states_diag.gt.1)then + print*,'Variational Energy difference' + do i = 2, N_st + print*,'Delta E = ',CI_energy(i) - CI_energy(1) + enddo + endif + if(N_states.gt.1)then + print*,'Variational + perturbative Energy difference' + do i = 2, N_st + print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1)) + enddo + endif + E_before = CI_energy + + enddo + print*,'Final Step ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + + do i = 1, 2 + print*,'psi_coef = ',psi_coef(i,1) + enddo + deallocate(pt2,norm_pert,E_before) +end + +subroutine all_2h2p + implicit none + integer :: i,k + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + integer :: N_st, degree + double precision,allocatable :: E_before(:) + N_st = N_states + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) + selection_criterion = 0.d0 + soft_touch selection_criterion + threshold_davidson = 1.d-5 + soft_touch threshold_davidson davidson_criterion + i = 0 + print*,'' + print*,'' + print*,'' + print*,'' + print*,'' + print*,'*****************************' + print*,'Doing all the 2h2P excitations' + print*,'*****************************' + print*,'' + print*,'' + print*,'N_det = ',N_det + print*,'n_det_max = ',n_det_max + print*,'pt2_max = ',pt2_max + print*,'N_det_generators = ',N_det_generators + pt2=-1.d0 + E_before = ref_bitmask_energy + + print*,'Initial Step ' + print*,'Inital determinants ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + n_det_max = 100000 + i = 0 + do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) + i += 1 + print*,'-----------------------' + print*,'i = ',i + call H_apply_only_2h2p(pt2, norm_pert, H_pert_diag, N_st) + call diagonalize_CI + print*,'N_det = ',N_det + print*,'E = ',CI_energy(1) + print*,'pt2 = ',pt2(1) + print*,'E+PT2 = ',E_before + pt2(1) + if(N_states_diag.gt.1)then + print*,'Variational Energy difference' + do i = 2, N_st + print*,'Delta E = ',CI_energy(i) - CI_energy(1) + enddo + endif + if(N_states.gt.1)then + print*,'Variational + perturbative Energy difference' + do i = 2, N_st + print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1)) + enddo + endif + E_before = CI_energy + + enddo print*,'Final Step ' print*,'N_det = ',N_det do i = 1, N_states_diag @@ -67,10 +230,89 @@ subroutine all_single do i = 1, 2 print*,'psi_coef = ',psi_coef(i,1) enddo -! call save_wavefunction deallocate(pt2,norm_pert,E_before) end +subroutine all_2p + implicit none + integer :: i,k + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + integer :: N_st, degree + double precision,allocatable :: E_before(:) + N_st = N_states + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) + selection_criterion = 0.d0 + soft_touch selection_criterion + threshold_davidson = 1.d-5 + soft_touch threshold_davidson davidson_criterion + i = 0 + print*,'' + print*,'' + print*,'' + print*,'' + print*,'' + print*,'*****************************' + print*,'Doing all the 2P excitations' + print*,'*****************************' + print*,'' + print*,'' + print*,'N_det = ',N_det + print*,'n_det_max = ',n_det_max + print*,'pt2_max = ',pt2_max + print*,'N_det_generators = ',N_det_generators + pt2=-1.d0 + E_before = ref_bitmask_energy + + print*,'Initial Step ' + print*,'Inital determinants ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + n_det_max = 100000 + i = 0 + do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) + i += 1 + print*,'-----------------------' + print*,'i = ',i + call H_apply_only_2p(pt2, norm_pert, H_pert_diag, N_st) + call diagonalize_CI + print*,'N_det = ',N_det + print*,'E = ',CI_energy(1) + print*,'pt2 = ',pt2(1) + print*,'E+PT2 = ',E_before + pt2(1) + if(N_states_diag.gt.1)then + print*,'Variational Energy difference' + do i = 2, N_st + print*,'Delta E = ',CI_energy(i) - CI_energy(1) + enddo + endif + if(N_states.gt.1)then + print*,'Variational + perturbative Energy difference' + do i = 2, N_st + print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1)) + enddo + endif + E_before = CI_energy + + enddo + print*,'Final Step ' + print*,'N_det = ',N_det + do i = 1, N_states_diag + print*,'' + print*,'i = ',i + print*,'E = ',CI_energy(i) + print*,'S^2 = ',CI_eigenvectors_s2(i) + enddo + deallocate(pt2,norm_pert,E_before) + do i = 1, 2 + print*,'psi_coef = ',psi_coef(i,1) + enddo +end + subroutine all_single_no_1h_or_1p implicit none integer :: i,k @@ -79,6 +321,8 @@ subroutine all_single_no_1h_or_1p double precision,allocatable :: E_before(:) N_st = N_states allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) + selection_criterion = 0.d0 + soft_touch selection_criterion threshold_davidson = 1.d-5 soft_touch threshold_davidson davidson_criterion i = 0 @@ -124,7 +368,7 @@ subroutine all_single_no_1h_or_1p endif E_before = CI_energy enddo - threshold_davidson = 1.d-10 + threshold_davidson = 1.d-16 soft_touch threshold_davidson davidson_criterion call diagonalize_CI print*,'Final Step ' @@ -215,85 +459,6 @@ subroutine all_single_no_1h_or_1p_or_2p deallocate(pt2,norm_pert,E_before) end - -subroutine all_2p - implicit none - integer :: i,k - double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) - integer :: N_st, degree - double precision,allocatable :: E_before(:) - N_st = N_states - allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st)) - selection_criterion = 0.d0 - soft_touch selection_criterion - threshold_davidson = 1.d-5 - soft_touch threshold_davidson davidson_criterion - i = 0 - print*,'' - print*,'' - print*,'' - print*,'' - print*,'' - print*,'*****************************' - print*,'Doing all the 2P excitations' - print*,'*****************************' - print*,'' - print*,'' - print*,'N_det = ',N_det - print*,'n_det_max = ',n_det_max - print*,'pt2_max = ',pt2_max - print*,'N_det_generators = ',N_det_generators - pt2=-1.d0 - E_before = ref_bitmask_energy - - print*,'Initial Step ' - print*,'Inital determinants ' - print*,'N_det = ',N_det - do i = 1, N_states_diag - print*,'' - print*,'i = ',i - print*,'E = ',CI_energy(i) - print*,'S^2 = ',CI_eigenvectors_s2(i) - enddo - n_det_max = 100000 - i = 0 - do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) - i += 1 - print*,'-----------------------' - print*,'i = ',i - call H_apply_standard(pt2, norm_pert, H_pert_diag, N_st) - call diagonalize_CI - print*,'N_det = ',N_det - print*,'E = ',CI_energy(1) - print*,'pt2 = ',pt2(1) - print*,'E+PT2 = ',E_before + pt2(1) - if(N_states_diag.gt.1)then - print*,'Variational Energy difference' - do i = 2, N_st - print*,'Delta E = ',CI_energy(i) - CI_energy(1) - enddo - endif - if(N_states.gt.1)then - print*,'Variational + perturbative Energy difference' - do i = 2, N_st - print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1)) - enddo - endif - E_before = CI_energy - - enddo - print*,'Final Step ' - print*,'N_det = ',N_det - do i = 1, N_states_diag - print*,'' - print*,'i = ',i - print*,'E = ',CI_energy(i) - print*,'S^2 = ',CI_eigenvectors_s2(i) - enddo -! call save_wavefunction - deallocate(pt2,norm_pert,E_before) -end - subroutine all_1h_1p_routine implicit none integer :: i,k diff --git a/plugins/FOBOCI/all_singles_split.irp.f b/plugins/FOBOCI/all_singles_split.irp.f index e7b0943f..9ddf369a 100644 --- a/plugins/FOBOCI/all_singles_split.irp.f +++ b/plugins/FOBOCI/all_singles_split.irp.f @@ -5,7 +5,7 @@ subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,N integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators_input) double precision, intent(inout) :: dressing_matrix(Ndet_generators_input,Ndet_generators_input) double precision, intent(in) :: psi_coef_generators_input(ndet_generators_input,n_states) - integer :: i,i_hole + integer :: i,i_hole,j n_det_max_jacobi = 50 soft_touch n_det_max_jacobi do i = 1, n_inact_orb @@ -22,56 +22,339 @@ subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,N call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) call all_single - threshold_davidson = 1.d-10 - soft_touch threshold_davidson davidson_criterion - call diagonalize_CI +! call diagonalize_CI_SC2 +! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2) call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input) enddo + + do i = 1, n_act_orb + i_hole = list_act(i) + print*,'' + print*,'Doing all the single excitations from the orbital ' + print*,i_hole + print*,'' + print*,'' + threshold_davidson = 1.d-4 + soft_touch threshold_davidson davidson_criterion + call modify_bitmasks_for_hole(i_hole) + call set_bitmask_particl_as_input(reunion_of_bitmask) + call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) + call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) + call all_single +! call diagonalize_CI_SC2 +! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2) + call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input) + enddo + + do i = 1, n_virt_orb + i_hole = list_virt(i) + print*,'' + print*,'Doing all the single excitations from the orbital ' + print*,i_hole + print*,'' + print*,'' + threshold_davidson = 1.d-4 + soft_touch threshold_davidson davidson_criterion + call modify_bitmasks_for_hole(i_hole) + call set_bitmask_particl_as_input(reunion_of_bitmask) + call set_generators_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) + call set_psi_det_as_input_psi(ndet_generators_input,psi_det_generators_input,psi_coef_generators_input) + call all_single +! call diagonalize_CI_SC2 +! call update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,Diag_H_elements_SC2) + call provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det_generators_input) + enddo + n_det_max_jacobi = 1000 soft_touch n_det_max_jacobi end -subroutine all_single_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) + +subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p) implicit none use bitmasks + integer, intent(in) :: i_particl double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) - double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators) - integer :: i,i_hole + double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators) + double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators) + integer :: i,j n_det_max_jacobi = 50 soft_touch n_det_max_jacobi - integer :: n_det_1h1p,n_det_2h1p - integer(bit_kind), allocatable :: psi_ref_out(:,:,:) - integer(bit_kind), allocatable :: psi_1h1p(:,:,:) - integer(bit_kind), allocatable :: psi_2h1p(:,:,:) - double precision, allocatable :: psi_ref_coef_out(:,:) - double precision, allocatable :: psi_coef_1h1p(:,:) - double precision, allocatable :: psi_coef_2h1p(:,:) - call all_single_no_1h_or_1p + call all_single threshold_davidson = 1.d-12 soft_touch threshold_davidson davidson_criterion call diagonalize_CI - call give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p) - allocate(psi_ref_out(N_int,2,N_det_generators)) - allocate(psi_1h1p(N_int,2,n_det_1h1p)) - allocate(psi_2h1p(N_int,2,n_det_2h1p)) - allocate(psi_ref_coef_out(N_det_generators,N_states)) - allocate(psi_coef_1h1p(n_det_1h1p,N_states)) - allocate(psi_coef_2h1p(n_det_2h1p,N_states)) - call split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p) - call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & - psi_1h1p,psi_coef_1h1p,n_det_1h1p) - call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & - psi_2h1p,psi_coef_2h1p,n_det_2h1p) - deallocate(psi_ref_out) - deallocate(psi_1h1p) - deallocate(psi_2h1p) - deallocate(psi_ref_coef_out) - deallocate(psi_coef_1h1p) - deallocate(psi_coef_2h1p) + + + double precision, allocatable :: matrix_ref_1h_1p(:,:) + double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:) + double precision, allocatable :: matrix_ref_1h_1p_dressing_1h2p(:,:) + double precision, allocatable :: psi_coef_ref_1h_1p(:,:) + double precision, allocatable :: psi_coef_1h1p(:,:) + double precision, allocatable :: psi_coef_1h2p(:,:) + integer(bit_kind), allocatable :: psi_det_1h2p(:,:,:) + integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:) + integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:) + integer :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p + double precision :: hka + double precision,allocatable :: eigenvectors(:,:), eigenvalues(:) + + + call give_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p) + + allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(matrix_ref_1h_1p_dressing_1h2p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states)) + allocate(psi_det_1h2p(N_int,2,n_det_1h2p), psi_coef_1h2p(n_det_1h2p,N_states)) + allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states)) + + call give_wf_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,& + psi_det_1h2p,psi_coef_1h2p,psi_det_1h1p,psi_coef_1h1p) + + do i = 1, n_det_ref_1h_1p + do j = 1, n_det_ref_1h_1p + call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka) + matrix_ref_1h_1p(i,j) = hka + enddo + enddo + matrix_ref_1h_1p_dressing_1h1p = 0.d0 + matrix_ref_1h_1p_dressing_1h2p = 0.d0 + call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h2p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, & + psi_det_1h2p,psi_coef_1h2p,n_det_1h2p) + call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, & + psi_det_1h1p,psi_coef_1h1p,n_det_1h1p) + do i = 1, n_det_ref_1h_1p + do j = 1, n_det_ref_1h_1p + matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_1h2p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j) + enddo + enddo + + allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p)) + call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p) +!do j = 1, n_det_ref_1h_1p +! print*,'coef = ',eigenvectors(j,1) +!enddo + print*,'' + print*,'-----------------------' + print*,'-----------------------' + print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion + print*,'-----------------------' + ! Extract the + integer, allocatable :: index_generator(:) + integer :: n_det_generators_tmp,degree + n_det_generators_tmp = 0 + allocate(index_generator(n_det_ref_1h_1p)) + do i = 1, n_det_ref_1h_1p + do j = 1, N_det_generators + call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int) + if(degree == 0)then + n_det_generators_tmp +=1 + index_generator(n_det_generators_tmp) = i + endif + enddo + enddo + if(n_det_generators_tmp .ne. n_det_generators)then + print*,'PB !!!' + print*,'if(n_det_generators_tmp .ne. n_det_genrators)then' + stop + endif + do i = 1, N_det_generators + print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1) + do j = 1, N_det_generators + dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j)) + dressing_matrix_1h2p(i,j) += matrix_ref_1h_1p_dressing_1h2p(index_generator(i),index_generator(j)) + enddo + enddo + print*,'-----------------------' + print*,'-----------------------' + + + deallocate(matrix_ref_1h_1p) + deallocate(matrix_ref_1h_1p_dressing_1h1p) + deallocate(matrix_ref_1h_1p_dressing_1h2p) + deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p) + deallocate(psi_det_1h2p, psi_coef_1h2p) + deallocate(psi_det_1h1p, psi_coef_1h1p) + deallocate(eigenvectors,eigenvalues) + deallocate(index_generator) + + +end + +subroutine all_single_for_1h(i_hole,dressing_matrix_1h1p,dressing_matrix_2h1p,dressing_matrix_extra_1h_or_1p) + implicit none + use bitmasks + integer, intent(in) :: i_hole + double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) + double precision, intent(inout) :: dressing_matrix_2h1p(N_det_generators,N_det_generators) + double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators) + integer :: i,j + n_det_max_jacobi = 50 + soft_touch n_det_max_jacobi + + call all_single + + threshold_davidson = 1.d-12 + soft_touch threshold_davidson davidson_criterion + call diagonalize_CI + + + + double precision, allocatable :: matrix_ref_1h_1p(:,:) + double precision, allocatable :: matrix_ref_1h_1p_dressing_1h1p(:,:) + double precision, allocatable :: matrix_ref_1h_1p_dressing_2h1p(:,:) + double precision, allocatable :: psi_coef_ref_1h_1p(:,:) + double precision, allocatable :: psi_coef_1h1p(:,:) + double precision, allocatable :: psi_coef_2h1p(:,:) + integer(bit_kind), allocatable :: psi_det_2h1p(:,:,:) + integer(bit_kind), allocatable :: psi_det_ref_1h_1p(:,:,:) + integer(bit_kind), allocatable :: psi_det_1h1p(:,:,:) + integer :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p + double precision :: hka + double precision,allocatable :: eigenvectors(:,:), eigenvalues(:) + + + call give_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p) + + allocate(matrix_ref_1h_1p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(matrix_ref_1h_1p_dressing_1h1p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(matrix_ref_1h_1p_dressing_2h1p(n_det_ref_1h_1p,n_det_ref_1h_1p)) + allocate(psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p), psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states)) + allocate(psi_det_2h1p(N_int,2,n_det_2h1p), psi_coef_2h1p(n_det_2h1p,N_states)) + allocate(psi_det_1h1p(N_int,2,n_det_1h1p), psi_coef_1h1p(n_det_1h1p,N_states)) + + call give_wf_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,& + psi_det_2h1p,psi_coef_2h1p,psi_det_1h1p,psi_coef_1h1p) + + do i = 1, n_det_ref_1h_1p + do j = 1, n_det_ref_1h_1p + call i_h_j(psi_det_ref_1h_1p(1,1,i),psi_det_ref_1h_1p(1,1,j),N_int,hka) + matrix_ref_1h_1p(i,j) = hka + enddo + enddo + matrix_ref_1h_1p_dressing_1h1p = 0.d0 + matrix_ref_1h_1p_dressing_2h1p = 0.d0 + call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_2h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, & + psi_det_2h1p,psi_coef_2h1p,n_det_2h1p) + call provide_matrix_dressing_general(matrix_ref_1h_1p_dressing_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,n_det_ref_1h_1p, & + psi_det_1h1p,psi_coef_1h1p,n_det_1h1p) + do i = 1, n_det_ref_1h_1p + do j = 1, n_det_ref_1h_1p + matrix_ref_1h_1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(i,j) + matrix_ref_1h_1p_dressing_1h1p(i,j) + enddo + enddo + + allocate(eigenvectors(n_det_ref_1h_1p,n_det_ref_1h_1p), eigenvalues(n_det_ref_1h_1p)) + call lapack_diag(eigenvalues,eigenvectors,matrix_ref_1h_1p,n_det_ref_1h_1p,n_det_ref_1h_1p) +!do j = 1, n_det_ref_1h_1p +! print*,'coef = ',eigenvectors(j,1) +!enddo + print*,'' + print*,'-----------------------' + print*,'-----------------------' + print*,'e_dressed = ',eigenvalues(1)+nuclear_repulsion + print*,'-----------------------' + ! Extract the + integer, allocatable :: index_generator(:) + integer :: n_det_generators_tmp,degree + n_det_generators_tmp = 0 + allocate(index_generator(n_det_ref_1h_1p)) + do i = 1, n_det_ref_1h_1p + do j = 1, N_det_generators + call get_excitation_degree(psi_det_generators(1,1,j),psi_det_ref_1h_1p(1,1,i), degree, N_int) + if(degree == 0)then + n_det_generators_tmp +=1 + index_generator(n_det_generators_tmp) = i + endif + enddo + enddo + if(n_det_generators_tmp .ne. n_det_generators)then + print*,'PB !!!' + print*,'if(n_det_generators_tmp .ne. n_det_genrators)then' + stop + endif + do i = 1, N_det_generators + print*,'psi_coef_dressed = ',eigenvectors(index_generator(i),1) + do j = 1, N_det_generators + dressing_matrix_1h1p(i,j) += matrix_ref_1h_1p_dressing_1h1p(index_generator(i),index_generator(j)) + dressing_matrix_2h1p(i,j) += matrix_ref_1h_1p_dressing_2h1p(index_generator(i),index_generator(j)) + enddo + enddo + print*,'-----------------------' + print*,'-----------------------' + + + deallocate(matrix_ref_1h_1p) + deallocate(matrix_ref_1h_1p_dressing_1h1p) + deallocate(matrix_ref_1h_1p_dressing_2h1p) + deallocate(psi_det_ref_1h_1p, psi_coef_ref_1h_1p) + deallocate(psi_det_2h1p, psi_coef_2h1p) + deallocate(psi_det_1h1p, psi_coef_1h1p) + deallocate(eigenvectors,eigenvalues) + deallocate(index_generator) +!return +! + +!integer(bit_kind), allocatable :: psi_ref_out(:,:,:) +!integer(bit_kind), allocatable :: psi_1h1p(:,:,:) +!integer(bit_kind), allocatable :: psi_2h1p(:,:,:) +!integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:) +!double precision, allocatable :: psi_ref_coef_out(:,:) +!double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:) + +!call all_single_no_1h_or_1p + +!call give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p) +!allocate(psi_ref_out(N_int,2,N_det_generators)) +!allocate(psi_1h1p(N_int,2,n_det_1h1p)) +!allocate(psi_2h1p(N_int,2,n_det_2h1p)) +!allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p)) +!allocate(psi_ref_coef_out(N_det_generators,N_states)) +!allocate(psi_coef_1h1p(n_det_1h1p,N_states)) +!allocate(psi_coef_2h1p(n_det_2h1p,N_states)) +!allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states)) +!call split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p) +!do i = 1, n_det_extra_1h_or_1p +! print*,'----' +! print*,'c = ',psi_coef_extra_1h_or_1p(i,1) +! call debug_det(psi_extra_1h_or_1p(1,1,i),N_int) +! print*,'----' +!enddo +!call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_1h1p,psi_coef_1h1p,n_det_1h1p) +!print*,'Dressing 1h1p ' +!do j =1, N_det_generators +! print*,' dressing ',dressing_matrix_1h1p(j,:) +!enddo + +!call provide_matrix_dressing_general(dressing_matrix_2h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_2h1p,psi_coef_2h1p,n_det_2h1p) +!print*,'Dressing 2h1p ' +!do j =1, N_det_generators +! print*,' dressing ',dressing_matrix_2h1p(j,:) +!enddo + +!call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p) +!print*,',dressing_matrix_extra_1h_or_1p' +!do j =1, N_det_generators +! print*,' dressing ',dressing_matrix_extra_1h_or_1p(j,:) +!enddo + + +!deallocate(psi_ref_out) +!deallocate(psi_1h1p) +!deallocate(psi_2h1p) +!deallocate(psi_extra_1h_or_1p) +!deallocate(psi_ref_coef_out) +!deallocate(psi_coef_1h1p) +!deallocate(psi_coef_2h1p) +!deallocate(psi_coef_extra_1h_or_1p) end @@ -197,47 +480,56 @@ subroutine all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) soft_touch n_det_max_jacobi end -subroutine all_single_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) - implicit none - use bitmasks - double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) - double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators) - integer :: i,i_hole - n_det_max_jacobi = 50 - soft_touch n_det_max_jacobi - - integer :: n_det_1h1p,n_det_1h2p - integer(bit_kind), allocatable :: psi_ref_out(:,:,:) - integer(bit_kind), allocatable :: psi_1h1p(:,:,:) - integer(bit_kind), allocatable :: psi_1h2p(:,:,:) - double precision, allocatable :: psi_ref_coef_out(:,:) - double precision, allocatable :: psi_coef_1h1p(:,:) - double precision, allocatable :: psi_coef_1h2p(:,:) - call all_single_no_1h_or_1p_or_2p - - threshold_davidson = 1.d-12 - soft_touch threshold_davidson davidson_criterion - call diagonalize_CI - call give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p) - allocate(psi_ref_out(N_int,2,N_det_generators)) - allocate(psi_1h1p(N_int,2,n_det_1h1p)) - allocate(psi_1h2p(N_int,2,n_det_1h2p)) - allocate(psi_ref_coef_out(N_det_generators,N_states)) - allocate(psi_coef_1h1p(n_det_1h1p,N_states)) - allocate(psi_coef_1h2p(n_det_1h2p,N_states)) - call split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p) - call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & - psi_1h1p,psi_coef_1h1p,n_det_1h1p) - call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, & - psi_1h2p,psi_coef_1h2p,n_det_1h2p) - - deallocate(psi_ref_out) - deallocate(psi_1h1p) - deallocate(psi_1h2p) - deallocate(psi_ref_coef_out) - deallocate(psi_coef_1h1p) - deallocate(psi_coef_1h2p) - -end +! subroutine all_single_for_1p(i_particl,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p) +! implicit none +! use bitmasks +! integer, intent(in ) :: i_particl +! double precision, intent(inout) :: dressing_matrix_1h1p(N_det_generators,N_det_generators) +! double precision, intent(inout) :: dressing_matrix_1h2p(N_det_generators,N_det_generators) +! double precision, intent(inout) :: dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators) +! integer :: i +! n_det_max_jacobi = 50 +! soft_touch n_det_max_jacobi +! +! integer :: n_det_1h1p,n_det_1h2p,n_det_extra_1h_or_1p +! integer(bit_kind), allocatable :: psi_ref_out(:,:,:) +! integer(bit_kind), allocatable :: psi_1h1p(:,:,:) +! integer(bit_kind), allocatable :: psi_1h2p(:,:,:) +! integer(bit_kind), allocatable :: psi_extra_1h_or_1p(:,:,:) +! double precision, allocatable :: psi_ref_coef_out(:,:) +! double precision, allocatable :: psi_coef_1h1p(:,:) +! double precision, allocatable :: psi_coef_1h2p(:,:) +! double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:) +!!!!call all_single_no_1h_or_1p_or_2p +! call all_single +! +! threshold_davidson = 1.d-12 +! soft_touch threshold_davidson davidson_criterion +! call diagonalize_CI +! call give_n_1h1p_and_n_1h2p_in_psi_det(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p) +! allocate(psi_ref_out(N_int,2,N_det_generators)) +! allocate(psi_1h1p(N_int,2,n_det_1h1p)) +! allocate(psi_1h2p(N_int,2,n_det_1h2p)) +! allocate(psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p)) +! allocate(psi_ref_coef_out(N_det_generators,N_states)) +! allocate(psi_coef_1h1p(n_det_1h1p,N_states)) +! allocate(psi_coef_1h2p(n_det_1h2p,N_states)) +! allocate(psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p,N_states)) +! call split_wf_generators_and_1h1p_and_1h2p(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p) +! call provide_matrix_dressing_general(dressing_matrix_1h1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_1h1p,psi_coef_1h1p,n_det_1h1p) +! call provide_matrix_dressing_general(dressing_matrix_1h2p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_1h2p,psi_coef_1h2p,n_det_1h2p) +! call provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix_extra_1h_or_1p,psi_ref_out,psi_ref_coef_out,N_det_generators, & +! psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p,n_det_extra_1h_or_1p) +! +! deallocate(psi_ref_out) +! deallocate(psi_1h1p) +! deallocate(psi_1h2p) +! deallocate(psi_ref_coef_out) +! deallocate(psi_coef_1h1p) +! deallocate(psi_coef_1h2p) +! +! end diff --git a/plugins/FOBOCI/collect_all_lmct.irp.f b/plugins/FOBOCI/collect_all_lmct.irp.f new file mode 100644 index 00000000..96eb2858 --- /dev/null +++ b/plugins/FOBOCI/collect_all_lmct.irp.f @@ -0,0 +1,436 @@ +use bitmasks + +subroutine collect_lmct(hole_particle,n_couples) + implicit none + integer, intent(out) :: hole_particle(1000,2), n_couples + BEGIN_DOC + ! Collect all the couple holes/particles of the important LMCT + ! hole_particle(i,1) = ith hole + ! hole_particle(i,2) = ith particle + ! n_couples is the number of important excitations + END_DOC + print*,'COLLECTING THE PERTINENT LMCT (1h)' + double precision, allocatable :: tmp(:,:) + allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) + tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci + integer :: i,j,iorb,jorb + n_couples = 0 + do i = 1,n_act_orb + iorb = list_act(i) + do j = 1, n_inact_orb + jorb = list_inact(j) + if(dabs(tmp(iorb,jorb)).gt.1.d-2)then + n_couples +=1 + hole_particle(n_couples,1) = jorb + hole_particle(n_couples,2) = iorb + print*,'DM' + print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) + endif + enddo + enddo + deallocate(tmp) + print*,'number of meaning full couples of holes/particles ' + print*,'n_couples = ',n_couples + + +end + + +subroutine collect_mlct(hole_particle,n_couples) + implicit none + integer, intent(out) :: hole_particle(1000,2), n_couples + BEGIN_DOC + ! Collect all the couple holes/particles of the important LMCT + ! hole_particle(i,1) = ith hole + ! hole_particle(i,2) = ith particle + ! n_couples is the number of important excitations + END_DOC + print*,'COLLECTING THE PERTINENT MLCT (1p)' + double precision, allocatable :: tmp(:,:) + allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) + tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci + integer :: i,j,iorb,jorb + n_couples = 0 + do i = 1,n_act_orb + iorb = list_act(i) + do j = 1, n_virt_orb + jorb = list_virt(j) + if(dabs(tmp(iorb,jorb)).gt.1.d-3)then + n_couples +=1 + hole_particle(n_couples,1) = iorb + hole_particle(n_couples,2) = jorb + print*,'DM' + print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) + endif + enddo + enddo + deallocate(tmp) + print*,'number of meaning full couples of holes/particles ' + print*,'n_couples = ',n_couples + + +end + + +subroutine collect_lmct_mlct(hole_particle,n_couples) + implicit none + integer, intent(out) :: hole_particle(1000,2), n_couples + BEGIN_DOC + ! Collect all the couple holes/particles of the important LMCT + ! hole_particle(i,1) = ith hole + ! hole_particle(i,2) = ith particle + ! n_couples is the number of important excitations + END_DOC + double precision, allocatable :: tmp(:,:) + print*,'COLLECTING THE PERTINENT LMCT (1h)' + print*,'AND THE PERTINENT MLCT (1p)' + allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) + tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci + integer :: i,j,iorb,jorb + n_couples = 0 + do i = 1,n_act_orb + iorb = list_act(i) + do j = 1, n_inact_orb + jorb = list_inact(j) + if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then + n_couples +=1 + hole_particle(n_couples,1) = jorb + hole_particle(n_couples,2) = iorb + print*,'DM' + print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) + endif + enddo + do j = 1, n_virt_orb + jorb = list_virt(j) + if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then + n_couples +=1 + hole_particle(n_couples,1) = iorb + hole_particle(n_couples,2) = jorb + print*,'DM' + print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) + endif + enddo + enddo + deallocate(tmp) + print*,'number of meaning full couples of holes/particles ' + print*,'n_couples = ',n_couples + + +end + + +subroutine collect_1h1p(hole_particle,n_couples) + implicit none + integer, intent(out) :: hole_particle(1000,2), n_couples + BEGIN_DOC + ! Collect all the couple holes/particles of the important LMCT + ! hole_particle(i,1) = ith hole + ! hole_particle(i,2) = ith particle + ! n_couples is the number of important excitations + END_DOC + double precision, allocatable :: tmp(:,:) + print*,'COLLECTING THE PERTINENT 1h1p' + allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) + tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci + integer :: i,j,iorb,jorb + n_couples = 0 + do i = 1,n_virt_orb + iorb = list_virt(i) + do j = 1, n_inact_orb + jorb = list_inact(j) + if(dabs(tmp(iorb,jorb)).gt.1.d-2)then + n_couples +=1 + hole_particle(n_couples,1) = jorb + hole_particle(n_couples,2) = iorb + print*,'DM' + print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) + endif + enddo + enddo + deallocate(tmp) + print*,'number of meaning full couples of holes/particles ' + print*,'n_couples = ',n_couples + + +end + + + +subroutine set_lmct_to_generators_restart + implicit none + integer :: i,j,m,n,i_hole,i_particle + integer :: hole_particle(1000,2), n_couples + integer(bit_kind) :: key_tmp(N_int,2) + integer :: N_det_total,i_ok + + call collect_lmct(hole_particle,n_couples) + call set_generators_to_generators_restart + N_det_total = N_det_generators_restart + do i = 1, n_couples + i_hole = hole_particle(i,1) + i_particle = hole_particle(i,2) + do m = 1, N_det_cas + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + ! You excite the beta electron from i_hole to i_particle + print*,'i_hole,i_particle 2 = ',i_hole,i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) + print*,'i_ok = ',i_ok + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + + ! You excite the alpha electron from i_hole to i_particle + print*,'i_hole,i_particle 1 = ',i_hole,i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) + print*,'i_ok = ',i_ok + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + enddo + enddo + N_det_generators = N_det_total + do i = 1, N_det_generators + psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) + enddo + print*,'number of generators in total = ',N_det_generators + touch N_det_generators psi_coef_generators psi_det_generators +end + +subroutine set_mlct_to_generators_restart + implicit none + integer :: i,j,m,n,i_hole,i_particle + integer :: hole_particle(1000,2), n_couples + integer(bit_kind) :: key_tmp(N_int,2) + integer :: N_det_total,i_ok + + call collect_mlct(hole_particle,n_couples) + call set_generators_to_generators_restart + N_det_total = N_det_generators_restart + do i = 1, n_couples + i_hole = hole_particle(i,1) + i_particle = hole_particle(i,2) + do m = 1, N_det_cas + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + ! You excite the beta electron from i_hole to i_particle + print*,'i_hole,i_particle 2 = ',i_hole,i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) + print*,'i_ok = ',i_ok + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + + ! You excite the alpha electron from i_hole to i_particle + print*,'i_hole,i_particle 1 = ',i_hole,i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) + print*,'i_ok = ',i_ok + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + enddo + enddo + N_det_generators = N_det_total + do i = 1, N_det_generators + psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) + enddo + print*,'number of generators in total = ',N_det_generators + touch N_det_generators psi_coef_generators psi_det_generators +end + +subroutine set_lmct_mlct_to_generators_restart + implicit none + integer :: i,j,m,n,i_hole,i_particle + integer :: hole_particle(1000,2), n_couples + integer(bit_kind) :: key_tmp(N_int,2) + integer :: N_det_total,i_ok + + call collect_lmct_mlct(hole_particle,n_couples) + call set_generators_to_generators_restart + N_det_total = N_det_generators_restart + do i = 1, n_couples + i_hole = hole_particle(i,1) + i_particle = hole_particle(i,2) + do m = 1, N_det_cas + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + ! You excite the beta electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + + do n = 1, N_int + key_tmp(n,1) = psi_cas(n,1,m) + key_tmp(n,2) = psi_cas(n,2,m) + enddo + + ! You excite the alpha electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det_generators(n,1,N_det_total) = key_tmp(n,1) + psi_det_generators(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + enddo + enddo + N_det_generators = N_det_total + do i = 1, N_det_generators + psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) + enddo + print*,'number of generators in total = ',N_det_generators + touch N_det_generators psi_coef_generators psi_det_generators +end + +subroutine set_lmct_mlct_to_psi_det + implicit none + integer :: i,j,m,n,i_hole,i_particle + integer :: hole_particle(1000,2), n_couples + integer(bit_kind) :: key_tmp(N_int,2) + integer :: N_det_total,i_ok + + call collect_lmct_mlct(hole_particle,n_couples) + call set_psi_det_to_generators_restart + N_det_total = N_det_generators_restart + do i = 1, n_couples + i_hole = hole_particle(i,1) + i_particle = hole_particle(i,2) + do m = 1, N_det_generators_restart + do n = 1, N_int + key_tmp(n,1) = psi_det_generators_restart(n,1,m) + key_tmp(n,2) = psi_det_generators_restart(n,2,m) + enddo + ! You excite the beta electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det(n,1,N_det_total) = key_tmp(n,1) + psi_det(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + + do n = 1, N_int + key_tmp(n,1) = psi_det_generators_restart(n,1,m) + key_tmp(n,2) = psi_det_generators_restart(n,2,m) + enddo + + ! You excite the alpha electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det(n,1,N_det_total) = key_tmp(n,1) + psi_det(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + enddo + enddo + + N_det = N_det_total + integer :: k + do k = 1, N_states + do i = 1, N_det + psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total)) + enddo + enddo + SOFT_TOUCH N_det psi_det psi_coef + logical :: found_duplicates + call remove_duplicates_in_psi_det(found_duplicates) +end + +subroutine set_1h1p_to_psi_det + implicit none + integer :: i,j,m,n,i_hole,i_particle + integer :: hole_particle(1000,2), n_couples + integer(bit_kind) :: key_tmp(N_int,2) + integer :: N_det_total,i_ok + + call collect_1h1p(hole_particle,n_couples) + call set_psi_det_to_generators_restart + N_det_total = N_det_generators_restart + do i = 1, n_couples + i_hole = hole_particle(i,1) + i_particle = hole_particle(i,2) + do m = 1, N_det_generators_restart + do n = 1, N_int + key_tmp(n,1) = psi_det_generators_restart(n,1,m) + key_tmp(n,2) = psi_det_generators_restart(n,2,m) + enddo + ! You excite the beta electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det(n,1,N_det_total) = key_tmp(n,1) + psi_det(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + + do n = 1, N_int + key_tmp(n,1) = psi_det_generators_restart(n,1,m) + key_tmp(n,2) = psi_det_generators_restart(n,2,m) + enddo + + ! You excite the alpha electron from i_hole to i_particle + call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) + if(i_ok==1)then + N_det_total +=1 + do n = 1, N_int + psi_det(n,1,N_det_total) = key_tmp(n,1) + psi_det(n,2,N_det_total) = key_tmp(n,2) + enddo + endif + enddo + enddo + + N_det = N_det_total + integer :: k + do k = 1, N_states + do i = 1, N_det + psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total)) + enddo + enddo + SOFT_TOUCH N_det psi_det psi_coef + logical :: found_duplicates + call remove_duplicates_in_psi_det(found_duplicates) +end + diff --git a/plugins/FOBOCI/corr_energy_2h2p.irp.f b/plugins/FOBOCI/corr_energy_2h2p.irp.f new file mode 100644 index 00000000..ada46bf2 --- /dev/null +++ b/plugins/FOBOCI/corr_energy_2h2p.irp.f @@ -0,0 +1,425 @@ + BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_ab, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_ab_2_orb, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_bb_2_orb, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_a, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_b, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_for_1h1p_double, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_aa, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_bb, (mo_tot_num)] +&BEGIN_PROVIDER [ double precision, total_corr_e_2h2p] + use bitmasks + print*,'' + print*,'Providing the 2h2p correlation energy' + print*,'' + implicit none + integer(bit_kind) :: key_tmp(N_int,2) + integer :: i,j,k,l + integer :: i_hole,j_hole,k_part,l_part + double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib + double precision :: diag_H_mat_elem + integer :: i_ok,ispin + ! Alpha - Beta correlation energy + total_corr_e_2h2p = 0.d0 + corr_energy_2h2p_ab_2_orb = 0.d0 + corr_energy_2h2p_bb_2_orb = 0.d0 + corr_energy_2h2p_per_orb_ab = 0.d0 + corr_energy_2h2p_per_orb_aa = 0.d0 + corr_energy_2h2p_per_orb_bb = 0.d0 + corr_energy_2h2p_for_1h1p_a = 0.d0 + corr_energy_2h2p_for_1h1p_b = 0.d0 + corr_energy_2h2p_for_1h1p_double = 0.d0 + do i = 1, n_inact_orb ! beta + i_hole = list_inact(i) + do k = 1, n_virt_orb ! beta + k_part = list_virt(k) + do j = 1, n_inact_orb ! alpha + j_hole = list_inact(j) + do l = 1, n_virt_orb ! alpha + l_part = list_virt(l) + + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = (ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + contrib = hij*hij/delta_e + total_corr_e_2h2p += contrib + ! Single orbital contribution + corr_energy_2h2p_per_orb_ab(i_hole) += contrib + corr_energy_2h2p_per_orb_ab(k_part) += contrib + ! Couple of orbital contribution for the single 1h1p + corr_energy_2h2p_for_1h1p_a(j_hole,l_part) += contrib + corr_energy_2h2p_for_1h1p_a(l_part,j_hole) += contrib + corr_energy_2h2p_for_1h1p_b(j_hole,l_part) += contrib + corr_energy_2h2p_for_1h1p_b(l_part,j_hole) += contrib + ! Couple of orbital contribution for the double 1h1p + corr_energy_2h2p_for_1h1p_double(i_hole,l_part) += contrib + corr_energy_2h2p_for_1h1p_double(l_part,i_hole) += contrib + + corr_energy_2h2p_ab_2_orb(i_hole,j_hole) += contrib + corr_energy_2h2p_ab_2_orb(j_hole,i_hole) += contrib + corr_energy_2h2p_ab_2_orb(i_hole,k_part) += contrib + corr_energy_2h2p_ab_2_orb(k_part,i_hole) += contrib + corr_energy_2h2p_ab_2_orb(k_part,l_part) += contrib + corr_energy_2h2p_ab_2_orb(l_part,k_part) += contrib + enddo + enddo + enddo + enddo + + ! alpha alpha correlation energy + do i = 1, n_inact_orb + i_hole = list_inact(i) + do j = i+1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_virt_orb + k_part = list_virt(k) + do l = k+1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + key_tmp = ref_bitmask + ispin = 1 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + total_corr_e_2h2p += contrib + ! Single orbital contribution + corr_energy_2h2p_per_orb_aa(i_hole) += contrib + corr_energy_2h2p_per_orb_aa(k_part) += contrib + ! Couple of orbital contribution for the single 1h1p + corr_energy_2h2p_for_1h1p_a(i_hole,k_part) += contrib + corr_energy_2h2p_for_1h1p_a(k_part,i_hole) += contrib + enddo + enddo + enddo + enddo + + ! beta beta correlation energy + do i = 1, n_inact_orb + i_hole = list_inact(i) + do j = i+1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_virt_orb + k_part = list_virt(k) + do l = k+1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 2 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + total_corr_e_2h2p += contrib + ! Single orbital contribution + corr_energy_2h2p_per_orb_bb(i_hole) += contrib + corr_energy_2h2p_per_orb_bb(k_part) += contrib + corr_energy_2h2p_for_1h1p_b(i_hole,k_part) += contrib + corr_energy_2h2p_for_1h1p_b(k_part,i_hole) += contrib + + ! Two particle correlation energy + corr_energy_2h2p_bb_2_orb(i_hole,j_hole) += contrib + corr_energy_2h2p_bb_2_orb(j_hole,i_hole) += contrib + corr_energy_2h2p_bb_2_orb(i_hole,k_part) += contrib + corr_energy_2h2p_bb_2_orb(k_part,i_hole) += contrib + corr_energy_2h2p_bb_2_orb(k_part,l_part) += contrib + corr_energy_2h2p_bb_2_orb(l_part,k_part) += contrib + + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [double precision, corr_energy_2h1p_ab_bb_per_2_orb, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_a, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_b, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_for_1h1p_double, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_ab, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_aa, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_bb, (mo_tot_num)] +&BEGIN_PROVIDER [ double precision, total_corr_e_2h1p] + use bitmasks + implicit none + integer(bit_kind) :: key_tmp(N_int,2) + integer :: i,j,k,l + integer :: i_hole,j_hole,k_part,l_part + double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib + double precision :: diag_H_mat_elem + integer :: i_ok,ispin + ! Alpha - Beta correlation energy + total_corr_e_2h1p = 0.d0 + corr_energy_2h1p_per_orb_ab = 0.d0 + corr_energy_2h1p_per_orb_aa = 0.d0 + corr_energy_2h1p_per_orb_bb = 0.d0 + corr_energy_2h1p_ab_bb_per_2_orb = 0.d0 + corr_energy_2h1p_for_1h1p_a = 0.d0 + corr_energy_2h1p_for_1h1p_b = 0.d0 + corr_energy_2h1p_for_1h1p_double = 0.d0 + do i = 1, n_inact_orb + i_hole = list_inact(i) + do k = 1, n_act_orb + k_part = list_act(k) + do j = 1, n_inact_orb + j_hole = list_inact(j) + do l = 1, n_virt_orb + l_part = list_virt(l) + + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + total_corr_e_2h1p += contrib + corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib + corr_energy_2h1p_per_orb_ab(i_hole) += contrib + corr_energy_2h1p_per_orb_ab(l_part) += contrib + enddo + enddo + enddo + enddo + + ! Alpha Alpha spin correlation energy + do i = 1, n_inact_orb + i_hole = list_inact(i) + do j = i+1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_act_orb + k_part = list_act(k) + do l = 1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + key_tmp = ref_bitmask + ispin = 1 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + + total_corr_e_2h1p += contrib + corr_energy_2h1p_per_orb_aa(i_hole) += contrib + corr_energy_2h1p_per_orb_aa(l_part) += contrib + enddo + enddo + enddo + enddo + + ! Beta Beta correlation energy + do i = 1, n_inact_orb + i_hole = list_inact(i) + do j = i+1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_act_orb + k_part = list_act(k) + do l = 1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 2 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + corr_energy_2h1p_ab_bb_per_2_orb(i_hole,j_hole) += contrib + + total_corr_e_2h1p += contrib + corr_energy_2h1p_per_orb_bb(i_hole) += contrib + corr_energy_2h1p_per_orb_aa(l_part) += contrib + enddo + enddo + enddo + enddo + +END_PROVIDER + + + BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_ab, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_1h2p_two_orb, (mo_tot_num,mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_aa, (mo_tot_num)] +&BEGIN_PROVIDER [double precision, corr_energy_1h2p_per_orb_bb, (mo_tot_num)] +&BEGIN_PROVIDER [ double precision, total_corr_e_1h2p] + use bitmasks + implicit none + integer(bit_kind) :: key_tmp(N_int,2) + integer :: i,j,k,l + integer :: i_hole,j_hole,k_part,l_part + double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib + double precision :: diag_H_mat_elem + integer :: i_ok,ispin + ! Alpha - Beta correlation energy + total_corr_e_1h2p = 0.d0 + corr_energy_1h2p_per_orb_ab = 0.d0 + corr_energy_1h2p_per_orb_aa = 0.d0 + corr_energy_1h2p_per_orb_bb = 0.d0 + do i = 1, n_virt_orb + i_hole = list_virt(i) + do k = 1, n_act_orb + k_part = list_act(k) + do j = 1, n_inact_orb + j_hole = list_inact(j) + do l = 1, n_virt_orb + l_part = list_virt(l) + + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + + total_corr_e_1h2p += contrib + corr_energy_1h2p_per_orb_ab(i_hole) += contrib + corr_energy_1h2p_per_orb_ab(j_hole) += contrib + corr_energy_1h2p_two_orb(k_part,l_part) += contrib + corr_energy_1h2p_two_orb(l_part,k_part) += contrib + enddo + enddo + enddo + enddo + + ! Alpha Alpha correlation energy + do i = 1, n_virt_orb + i_hole = list_virt(i) + do j = 1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_act_orb + k_part = list_act(k) + do l = i+1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + + key_tmp = ref_bitmask + ispin = 1 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + total_corr_e_1h2p += contrib + corr_energy_1h2p_per_orb_aa(i_hole) += contrib + corr_energy_1h2p_per_orb_ab(j_hole) += contrib + corr_energy_1h2p_two_orb(k_part,l_part) += contrib + corr_energy_1h2p_two_orb(l_part,k_part) += contrib + enddo + enddo + enddo + enddo + + ! Beta Beta correlation energy + do i = 1, n_virt_orb + i_hole = list_virt(i) + do j = 1, n_inact_orb + j_hole = list_inact(j) + do k = 1, n_act_orb + k_part = list_act(k) + do l = i+1,n_virt_orb + l_part = list_virt(l) + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + exc = get_mo_bielec_integral_schwartz(i_hole,j_hole,l_part,k_part,mo_integrals_map) + + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 2 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + hij = hij - exc + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + total_corr_e_1h2p += contrib + corr_energy_1h2p_per_orb_bb(i_hole) += contrib + corr_energy_1h2p_per_orb_ab(j_hole) += contrib + corr_energy_1h2p_two_orb(k_part,l_part) += contrib + corr_energy_1h2p_two_orb(l_part,k_part) += contrib + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [double precision, corr_energy_1h1p_spin_flip_per_orb, (mo_tot_num)] +&BEGIN_PROVIDER [ double precision, total_corr_e_1h1p_spin_flip] + use bitmasks + implicit none + integer(bit_kind) :: key_tmp(N_int,2) + integer :: i,j,k,l + integer :: i_hole,j_hole,k_part,l_part + double precision :: get_mo_bielec_integral_schwartz,hij,delta_e,exc,contrib + double precision :: diag_H_mat_elem + integer :: i_ok,ispin + ! Alpha - Beta correlation energy + total_corr_e_1h1p_spin_flip = 0.d0 + corr_energy_1h1p_spin_flip_per_orb = 0.d0 + do i = 1, n_inact_orb + i_hole = list_inact(i) + do k = 1, n_act_orb + k_part = list_act(k) + do j = 1, n_act_orb + j_hole = list_act(j) + do l = 1, n_virt_orb + l_part = list_virt(l) + + key_tmp = ref_bitmask + ispin = 2 + call do_mono_excitation(key_tmp,i_hole,k_part,ispin,i_ok) + if(i_ok .ne.1)cycle + ispin = 1 + call do_mono_excitation(key_tmp,j_hole,l_part,ispin,i_ok) + if(i_ok .ne.1)cycle + delta_e = -(ref_bitmask_energy - diag_H_mat_elem(key_tmp,N_int)) + + hij = get_mo_bielec_integral_schwartz(i_hole,j_hole,k_part,l_part,mo_integrals_map) + contrib = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * hij*hij)) + + total_corr_e_1h1p_spin_flip += contrib + corr_energy_1h1p_spin_flip_per_orb(i_hole) += contrib + enddo + enddo + enddo + enddo + +END_PROVIDER diff --git a/plugins/FOBOCI/diag_fock_inactiv_virt.irp.f b/plugins/FOBOCI/diag_fock_inactiv_virt.irp.f index a4c6b652..83955e61 100644 --- a/plugins/FOBOCI/diag_fock_inactiv_virt.irp.f +++ b/plugins/FOBOCI/diag_fock_inactiv_virt.irp.f @@ -3,6 +3,7 @@ subroutine diag_inactive_virt_and_update_mos integer :: i,j,i_inact,j_inact,i_virt,j_virt double precision :: tmp(mo_tot_num_align,mo_tot_num) character*(64) :: label + print*,'Diagonalizing the occ and virt Fock operator' tmp = 0.d0 do i = 1, mo_tot_num tmp(i,i) = Fock_matrix_mo(i,i) @@ -33,3 +34,50 @@ subroutine diag_inactive_virt_and_update_mos end + +subroutine diag_inactive_virt_new_and_update_mos + implicit none + integer :: i,j,i_inact,j_inact,i_virt,j_virt,k,k_act + double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral_schwartz + character*(64) :: label + tmp = 0.d0 + do i = 1, mo_tot_num + tmp(i,i) = Fock_matrix_mo(i,i) + enddo + + do i = 1, n_inact_orb + i_inact = list_inact(i) + do j = i+1, n_inact_orb + j_inact = list_inact(j) + accu =0.d0 + do k = 1, n_act_orb + k_act = list_act(k) + accu += get_mo_bielec_integral_schwartz(i_inact,k_act,j_inact,k_act,mo_integrals_map) + accu -= get_mo_bielec_integral_schwartz(i_inact,k_act,k_act,j_inact,mo_integrals_map) + enddo + tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact) + accu + tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact) + accu + enddo + enddo + + do i = 1, n_virt_orb + i_virt = list_virt(i) + do j = i+1, n_virt_orb + j_virt = list_virt(j) + accu =0.d0 + do k = 1, n_act_orb + k_act = list_act(k) + accu += get_mo_bielec_integral_schwartz(i_virt,k_act,j_virt,k_act,mo_integrals_map) + enddo + tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt) - accu + tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt) - accu + enddo + enddo + + + label = "Canonical" + call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1) + soft_touch mo_coef + + +end diff --git a/plugins/FOBOCI/dress_simple.irp.f b/plugins/FOBOCI/dress_simple.irp.f index 2f662f4d..99566a8e 100644 --- a/plugins/FOBOCI/dress_simple.irp.f +++ b/plugins/FOBOCI/dress_simple.irp.f @@ -58,24 +58,24 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa) f = 1.d0/(E_ref-haa) - if(second_order_h)then +! if(second_order_h)then lambda_i = f - else - ! You write the new Hamiltonian matrix - do k = 1, Ndet_generators - H_matrix_tmp(k,Ndet_generators+1) = H_array(k) - H_matrix_tmp(Ndet_generators+1,k) = H_array(k) - enddo - H_matrix_tmp(Ndet_generators+1,Ndet_generators+1) = haa - ! Then diagonalize it - call lapack_diag(eigenvalues,eigenvectors,H_matrix_tmp,Ndet_generators+1,Ndet_generators+1) - ! Then you extract the effective denominator - accu = 0.d0 - do k = 1, Ndet_generators - accu += eigenvectors(k,1) * H_array(k) - enddo - lambda_i = eigenvectors(Ndet_generators+1,1)/accu - endif +! else +! ! You write the new Hamiltonian matrix +! do k = 1, Ndet_generators +! H_matrix_tmp(k,Ndet_generators+1) = H_array(k) +! H_matrix_tmp(Ndet_generators+1,k) = H_array(k) +! enddo +! H_matrix_tmp(Ndet_generators+1,Ndet_generators+1) = haa +! ! Then diagonalize it +! call lapack_diag(eigenvalues,eigenvectors,H_matrix_tmp,Ndet_generators+1,Ndet_generators+1) +! ! Then you extract the effective denominator +! accu = 0.d0 +! do k = 1, Ndet_generators +! accu += eigenvectors(k,1) * H_array(k) +! enddo +! lambda_i = eigenvectors(Ndet_generators+1,1)/accu +! endif do k=1,idx(0) contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i delta_ij_generators_(idx(k), idx(k)) += contrib @@ -85,33 +85,6 @@ subroutine standard_dress(delta_ij_generators_,size_buffer,Ndet_generators,i_gen delta_ij_generators_(idx(j), idx(k)) += contrib enddo enddo -! H_matrix_tmp_bis(idx(k),idx(k)) += contrib -! H_matrix_tmp_bis(idx(k),idx(j)) += contrib -! H_matrix_tmp_bis(idx(j),idx(k)) += contrib -! do k = 1, Ndet_generators -! do j = 1, Ndet_generators -! H_matrix_tmp_bis(k,j) = H_matrix_tmp(k,j) -! enddo -! enddo -! double precision :: H_matrix_tmp_bis(Ndet_generators,Ndet_generators) -! double precision :: eigenvectors_bis(Ndet_generators,Ndet_generators), eigenvalues_bis(Ndet_generators) -! call lapack_diag(eigenvalues_bis,eigenvectors_bis,H_matrix_tmp_bis,Ndet_generators,Ndet_generators) -! print*,'f,lambda_i = ',f,lambda_i -! print*,'eigenvalues_bi(1)',eigenvalues_bis(1) -! print*,'eigenvalues ',eigenvalues(1) -! do k = 1, Ndet_generators -! print*,'coef,coef_dres = ', eigenvectors(k,1), eigenvectors_bis(k,1) -! enddo -! pause -! accu = 0.d0 -! do k = 1, Ndet_generators -! do j = 1, Ndet_generators -! accu += eigenvectors(k,1) * eigenvectors(j,1) * (H_matrix_tmp(k,j) + delta_ij_generators_(k,j)) -! enddo -! enddo -! print*,'accu,eigv = ',accu,eigenvalues(1) -! pause - enddo end diff --git a/plugins/FOBOCI/fobo_scf.irp.f b/plugins/FOBOCI/fobo_scf.irp.f new file mode 100644 index 00000000..8656b633 --- /dev/null +++ b/plugins/FOBOCI/fobo_scf.irp.f @@ -0,0 +1,59 @@ +program foboscf + implicit none + call run_prepare + no_oa_or_av_opt = .True. + touch no_oa_or_av_opt + call routine_fobo_scf + call save_mos + +end + +subroutine run_prepare + implicit none + no_oa_or_av_opt = .False. + touch no_oa_or_av_opt + call damping_SCF + call diag_inactive_virt_and_update_mos +end + +subroutine routine_fobo_scf + implicit none + integer :: i,j + print*,'' + print*,'' + character*(64) :: label + label = "Natural" + do i = 1, 5 + print*,'*******************************************************************************' + print*,'*******************************************************************************' + print*,'FOBO-SCF Iteration ',i + print*,'*******************************************************************************' + print*,'*******************************************************************************' + if(speed_up_convergence_foboscf)then + if(i==3)then + threshold_lmct = max(threshold_lmct,0.001) + threshold_mlct = max(threshold_mlct,0.05) + soft_touch threshold_lmct threshold_mlct + endif + if(i==4)then + threshold_lmct = max(threshold_lmct,0.005) + threshold_mlct = max(threshold_mlct,0.07) + soft_touch threshold_lmct threshold_mlct + endif + if(i==5)then + threshold_lmct = max(threshold_lmct,0.01) + threshold_mlct = max(threshold_mlct,0.1) + soft_touch threshold_lmct threshold_mlct + endif + endif + call FOBOCI_lmct_mlct_old_thr + call save_osoci_natural_mos + call damping_SCF + call diag_inactive_virt_and_update_mos + call clear_mo_map + call provide_properties + enddo + + + +end diff --git a/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f b/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f index 087f791b..dc6519b8 100644 --- a/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f +++ b/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f @@ -9,12 +9,9 @@ subroutine FOBOCI_lmct_mlct_old_thr double precision :: norm_tmp(N_states),norm_total(N_states) logical :: test_sym double precision :: thr,hij - double precision :: threshold double precision, allocatable :: dressing_matrix(:,:) logical :: verbose,is_ok verbose = .True. - threshold = threshold_singles - print*,'threshold = ',threshold thr = 1.d-12 allocate(unpaired_bitmask(N_int,2)) allocate (occ(N_int*bit_kind_size,2)) @@ -36,7 +33,14 @@ subroutine FOBOCI_lmct_mlct_old_thr print*,'' print*,'' print*,'DOING FIRST LMCT !!' + print*,'Threshold_lmct = ',threshold_lmct + integer(bit_kind) , allocatable :: zero_bitmask(:,:) + integer(bit_kind) , allocatable :: psi_singles(:,:,:) + logical :: lmct + double precision, allocatable :: psi_singles_coef(:,:) + allocate( zero_bitmask(N_int,2) ) do i = 1, n_inact_orb + lmct = .True. integer :: i_hole_osoci i_hole_osoci = list_inact(i) print*,'--------------------------' @@ -51,27 +55,91 @@ subroutine FOBOCI_lmct_mlct_old_thr print*,'Passed set generators' call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask) - call is_a_good_candidate(threshold,is_ok,verbose) + call is_a_good_candidate(threshold_lmct,is_ok,verbose) print*,'is_ok = ',is_ok if(.not.is_ok)cycle - ! so all the mono excitation on the new generators allocate(dressing_matrix(N_det_generators,N_det_generators)) + dressing_matrix = 0.d0 if(.not.do_it_perturbative)then -! call all_single - dressing_matrix = 0.d0 + do k = 1, N_det_generators do l = 1, N_det_generators call i_h_j(psi_det_generators(1,1,k),psi_det_generators(1,1,l),N_int,hkl) dressing_matrix(k,l) = hkl enddo enddo - double precision :: hkl -! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix) -! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) - call debug_det(reunion_of_bitmask,N_int) + hkl = dressing_matrix(1,1) + do k = 1, N_det_generators + dressing_matrix(k,k) = dressing_matrix(k,k) - hkl + enddo + print*,'Naked matrix' + do k = 1, N_det_generators + write(*,'(100(F12.5,X))')dressing_matrix(k,:) + enddo + + ! Do all the single excitations on top of the CAS and 1h determinants + call set_bitmask_particl_as_input(reunion_of_bitmask) + call set_bitmask_hole_as_input(reunion_of_bitmask) call all_single +! if(dressing_2h2p)then +! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole_osoci,lmct) +! endif + +! ! Change the mask of the holes and particles to perform all the +! ! double excitations that starts from the active space in order +! ! to introduce the Coulomb hole in the active space +! ! These are the 1h2p excitations that have the i_hole_osoci hole in common +! ! and the 2p if there is more than one electron in the active space +! do k = 1, N_int +! zero_bitmask(k,1) = 0_bit_kind +! zero_bitmask(k,2) = 0_bit_kind +! enddo +! ! hole is possible only in the orbital i_hole_osoci +! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int) +! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int) +! ! and in the active space +! do k = 1, n_act_orb +! call set_bit_to_integer(list_act(k),zero_bitmask(1,1),N_int) +! call set_bit_to_integer(list_act(k),zero_bitmask(1,2),N_int) +! enddo +! call set_bitmask_hole_as_input(zero_bitmask) + +! call set_bitmask_particl_as_input(reunion_of_bitmask) + +! call all_1h2p +! call diagonalize_CI_SC2 +! call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators) + +! ! Change the mask of the holes and particles to perform all the +! ! double excitations that from the orbital i_hole_osoci +! do k = 1, N_int +! zero_bitmask(k,1) = 0_bit_kind +! zero_bitmask(k,2) = 0_bit_kind +! enddo +! ! hole is possible only in the orbital i_hole_osoci +! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,1),N_int) +! call set_bit_to_integer(i_hole_osoci,zero_bitmask(1,2),N_int) +! call set_bitmask_hole_as_input(zero_bitmask) + +! call set_bitmask_particl_as_input(reunion_of_bitmask) + +! call set_psi_det_to_generators +! call all_2h2p +! call diagonalize_CI_SC2 + double precision :: hkl + call provide_matrix_dressing(dressing_matrix,n_det_generators,psi_det_generators) + hkl = dressing_matrix(1,1) + do k = 1, N_det_generators + dressing_matrix(k,k) = dressing_matrix(k,k) - hkl + enddo + print*,'Dressed matrix' + do k = 1, N_det_generators + write(*,'(100(F12.5,X))')dressing_matrix(k,:) + enddo +! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) endif call set_intermediate_normalization_lmct_old(norm_tmp,i_hole_osoci) + do k = 1, N_states print*,'norm_tmp = ',norm_tmp(k) norm_total(k) += norm_tmp(k) @@ -83,9 +151,12 @@ subroutine FOBOCI_lmct_mlct_old_thr if(.True.)then print*,'' print*,'DOING THEN THE MLCT !!' + print*,'Threshold_mlct = ',threshold_mlct + lmct = .False. do i = 1, n_virt_orb integer :: i_particl_osoci i_particl_osoci = list_virt(i) + print*,'--------------------------' ! First set the current generators to the one of restart call set_generators_to_generators_restart @@ -107,7 +178,7 @@ subroutine FOBOCI_lmct_mlct_old_thr call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask) !! ! so all the mono excitation on the new generators - call is_a_good_candidate(threshold,is_ok,verbose) + call is_a_good_candidate(threshold_mlct,is_ok,verbose) print*,'is_ok = ',is_ok if(.not.is_ok)cycle allocate(dressing_matrix(N_det_generators,N_det_generators)) @@ -122,6 +193,9 @@ subroutine FOBOCI_lmct_mlct_old_thr ! call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix) ! call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) call all_single +! if(dressing_2h2p)then +! call diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_particl_osoci,lmct) +! endif endif call set_intermediate_normalization_mlct_old(norm_tmp,i_particl_osoci) do k = 1, N_states @@ -132,24 +206,6 @@ subroutine FOBOCI_lmct_mlct_old_thr deallocate(dressing_matrix) enddo endif - if(.False.)then - print*,'LAST loop for all the 1h-1p' - print*,'--------------------------' - ! First set the current generators to the one of restart - call set_generators_to_generators_restart - call set_psi_det_to_generators - call initialize_bitmask_to_restart_ones - ! Impose that only the hole i_hole_osoci can be done - call set_bitmask_particl_as_input(inact_virt_bitmask) - call set_bitmask_hole_as_input(inact_virt_bitmask) -! call set_bitmask_particl_as_input(reunion_of_bitmask) -! call set_bitmask_hole_as_input(reunion_of_bitmask) - call all_single - call set_intermediate_normalization_1h1p(norm_tmp) - norm_total += norm_tmp - call update_density_matrix_osoci - endif - print*,'norm_total = ',norm_total norm_total = norm_generators_restart @@ -174,10 +230,8 @@ subroutine FOBOCI_mlct_old double precision :: norm_tmp,norm_total logical :: test_sym double precision :: thr - double precision :: threshold logical :: verbose,is_ok verbose = .False. - threshold = 1.d-2 thr = 1.d-12 allocate(unpaired_bitmask(N_int,2)) allocate (occ(N_int*bit_kind_size,2)) @@ -216,7 +270,7 @@ subroutine FOBOCI_mlct_old call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask) ! ! so all the mono excitation on the new generators - call is_a_good_candidate(threshold,is_ok,verbose) + call is_a_good_candidate(threshold_mlct,is_ok,verbose) print*,'is_ok = ',is_ok is_ok =.True. if(.not.is_ok)cycle @@ -250,10 +304,8 @@ subroutine FOBOCI_lmct_old double precision :: norm_tmp,norm_total logical :: test_sym double precision :: thr - double precision :: threshold logical :: verbose,is_ok verbose = .False. - threshold = 1.d-2 thr = 1.d-12 allocate(unpaired_bitmask(N_int,2)) allocate (occ(N_int*bit_kind_size,2)) @@ -290,7 +342,7 @@ subroutine FOBOCI_lmct_old call set_generators_to_psi_det call set_bitmask_particl_as_input(reunion_of_bitmask) call set_bitmask_hole_as_input(reunion_of_bitmask) - call is_a_good_candidate(threshold,is_ok,verbose) + call is_a_good_candidate(threshold_lmct,is_ok,verbose) print*,'is_ok = ',is_ok if(.not.is_ok)cycle ! ! so all the mono excitation on the new generators diff --git a/plugins/FOBOCI/foboci_reunion.irp.f b/plugins/FOBOCI/foboci_reunion.irp.f new file mode 100644 index 00000000..fcfaff58 --- /dev/null +++ b/plugins/FOBOCI/foboci_reunion.irp.f @@ -0,0 +1,18 @@ +program osoci_program +implicit none + do_it_perturbative = .True. + touch do_it_perturbative + call FOBOCI_lmct_mlct_old_thr + call provide_all_the_rest +end +subroutine provide_all_the_rest +implicit none +integer :: i + call update_one_body_dm_mo + call set_lmct_mlct_to_psi_det + call diagonalize_CI + call save_wavefunction + + +end + diff --git a/plugins/FOBOCI/generators_restart_save.irp.f b/plugins/FOBOCI/generators_restart_save.irp.f index dca4c901..09d4aa2b 100644 --- a/plugins/FOBOCI/generators_restart_save.irp.f +++ b/plugins/FOBOCI/generators_restart_save.irp.f @@ -1,126 +1,74 @@ -use bitmasks +use bitmasks + BEGIN_PROVIDER [ integer, N_det_generators_restart ] implicit none BEGIN_DOC - ! Number of determinants in the wave function + ! Read the wave function END_DOC - logical :: exists - character*64 :: label + integer :: i integer, save :: ifirst = 0 -!if(ifirst == 0)then - PROVIDE ezfio_filename - call ezfio_has_determinants_n_det(exists) - print*,'exists = ',exists - if(.not.exists)then - print*,'The OSOCI needs a restart WF' - print*,'There are none in the EZFIO file ...' - print*,'Stopping ...' - stop - endif - print*,'passed N_det_generators_restart' - call ezfio_get_determinants_n_det(N_det_generators_restart) - ASSERT (N_det_generators_restart > 0) + double precision :: norm + if(ifirst == 0)then + call ezfio_get_determinants_n_det(N_det_generators_restart) ifirst = 1 -!endif + else + print*,'PB in generators_restart restart !!!' + endif + call write_int(output_determinants,N_det_generators_restart,'Number of generators_restart') END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators_restart, (N_int,2,psi_det_size) ] + BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators_restart, (N_int,2,N_det_generators_restart) ] &BEGIN_PROVIDER [ integer(bit_kind), ref_generators_restart, (N_int,2) ] +&BEGIN_PROVIDER [ double precision, psi_coef_generators_restart, (N_det_generators_restart,N_states) ] implicit none BEGIN_DOC - ! The wave function determinants. Initialized with Hartree-Fock if the EZFIO file - ! is empty + ! read wf + ! END_DOC - integer :: i - logical :: exists - character*64 :: label - + integer :: i, k integer, save :: ifirst = 0 -!if(ifirst == 0)then - provide N_det_generators_restart - if(.True.)then - call ezfio_has_determinants_N_int(exists) - if (exists) then - call ezfio_has_determinants_bit_kind(exists) - if (exists) then - call ezfio_has_determinants_N_det(exists) - if (exists) then - call ezfio_has_determinants_N_states(exists) - if (exists) then - call ezfio_has_determinants_psi_det(exists) - endif - endif - endif - endif - - if(.not.exists)then - print*,'The OSOCI needs a restart WF' - print*,'There are none in the EZFIO file ...' - print*,'Stopping ...' - stop - endif - print*,'passed psi_det_generators_restart' - - call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart) - do i = 1, N_int - ref_generators_restart(i,1) = psi_det_generators_restart(i,1,1) - ref_generators_restart(i,2) = psi_det_generators_restart(i,2,1) - enddo - endif + double precision, allocatable :: psi_coef_read(:,:) + if(ifirst == 0)then + call read_dets(psi_det_generators_restart,N_int,N_det_generators_restart) + do k = 1, N_int + ref_generators_restart(k,1) = psi_det_generators_restart(k,1,1) + ref_generators_restart(k,2) = psi_det_generators_restart(k,2,1) + enddo + allocate (psi_coef_read(N_det_generators_restart,N_states)) + call ezfio_get_determinants_psi_coef(psi_coef_read) + do k = 1, N_states + do i = 1, N_det_generators_restart + psi_coef_generators_restart(i,k) = psi_coef_read(i,k) + enddo + enddo ifirst = 1 -!endif + deallocate(psi_coef_read) + else + print*,'PB in generators_restart restart !!!' + endif END_PROVIDER - - -BEGIN_PROVIDER [ double precision, psi_coef_generators_restart, (psi_det_size,N_states_diag) ] - implicit none - BEGIN_DOC - ! The wave function coefficients. Initialized with Hartree-Fock if the EZFIO file - ! is empty - END_DOC - - integer :: i,k, N_int2 - logical :: exists - double precision, allocatable :: psi_coef_read(:,:) - character*(64) :: label - - integer, save :: ifirst = 0 -!if(ifirst == 0)then - psi_coef_generators_restart = 0.d0 - do i=1,N_states_diag - psi_coef_generators_restart(i,i) = 1.d0 - enddo - - call ezfio_has_determinants_psi_coef(exists) - - if(.not.exists)then - print*,'The OSOCI needs a restart WF' - print*,'There are none in the EZFIO file ...' - print*,'Stopping ...' - stop - endif - print*,'passed psi_coef_generators_restart' - - if (exists) then - - allocate (psi_coef_read(N_det_generators_restart,N_states)) - call ezfio_get_determinants_psi_coef(psi_coef_read) - do k=1,N_states - do i=1,N_det_generators_restart - psi_coef_generators_restart(i,k) = psi_coef_read(i,k) - enddo - enddo - deallocate(psi_coef_read) - - endif - ifirst = 1 -!endif - - - +BEGIN_PROVIDER [ integer, size_select_max] + implicit none + BEGIN_DOC + ! Size of the select_max array + END_DOC + size_select_max = 10000 END_PROVIDER +BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ] + implicit none + BEGIN_DOC + ! Memo to skip useless selectors + END_DOC + select_max = huge(1.d0) +END_PROVIDER + + BEGIN_PROVIDER [ integer, N_det_generators ] +&BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,10000) ] +&BEGIN_PROVIDER [ double precision, psi_coef_generators, (10000,N_states) ] + +END_PROVIDER diff --git a/plugins/FOBOCI/hcc_1h1p.irp.f b/plugins/FOBOCI/hcc_1h1p.irp.f new file mode 100644 index 00000000..66cf2fd4 --- /dev/null +++ b/plugins/FOBOCI/hcc_1h1p.irp.f @@ -0,0 +1,83 @@ +program test_sc2 + implicit none + read_wf = .True. + touch read_wf + call routine + + +end + +subroutine routine + implicit none + double precision, allocatable :: energies(:),diag_H_elements(:) + double precision, allocatable :: H_matrix(:,:) + allocate(energies(N_states),diag_H_elements(N_det)) + call diagonalize_CI + call test_hcc + call test_mulliken +! call SC2_1h1p(psi_det,psi_coef,energies, & +! diag_H_elements,size(psi_coef,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) + allocate(H_matrix(N_det,N_det)) + call SC2_1h1p_full(psi_det,psi_coef,energies, & + H_matrix,size(psi_coef,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) + deallocate(H_matrix) + integer :: i,j + double precision :: accu,coef_hf +! coef_hf = 1.d0/psi_coef(1,1) +! do i = 1, N_det +! psi_coef(i,1) *= coef_hf +! enddo + touch psi_coef + call pouet +end + +subroutine pouet + implicit none + double precision :: accu,coef_hf +! provide one_body_dm_mo_alpha one_body_dm_mo_beta +! call density_matrix_1h1p(psi_det,psi_coef,one_body_dm_mo_alpha,one_body_dm_mo_beta,accu,size(psi_coef,1),N_det,N_states_diag,N_int) +! touch one_body_dm_mo_alpha one_body_dm_mo_beta + call test_hcc + call test_mulliken +! call save_wavefunction + +end + +subroutine test_hcc + implicit none + double precision :: accu + integer :: i,j + print*,'Z AU GAUSS MHZ cm^-1' + do i = 1, nucl_num + write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i) + enddo + +end + +subroutine test_mulliken + double precision :: accu + integer :: i + integer :: j + accu= 0.d0 + do i = 1, nucl_num + print*,i,nucl_charge(i),mulliken_spin_densities(i) + accu += mulliken_spin_densities(i) + enddo + print*,'Sum of Mulliken SD = ',accu +!print*,'AO SPIN POPULATIONS' + accu = 0.d0 +!do i = 1, ao_num +! accu += spin_gross_orbital_product(i) +! write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i) +!enddo +!print*,'sum = ',accu +!accu = 0.d0 +!print*,'Angular momentum analysis' +!do i = 0, ao_l_max +! accu += spin_population_angular_momentum(i) +! print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i) +!print*,'sum = ',accu +!enddo + +end + diff --git a/plugins/FOBOCI/modify_generators.irp.f b/plugins/FOBOCI/modify_generators.irp.f index c756f0c2..359b6405 100644 --- a/plugins/FOBOCI/modify_generators.irp.f +++ b/plugins/FOBOCI/modify_generators.irp.f @@ -6,6 +6,7 @@ subroutine set_generators_to_psi_det END_DOC N_det_generators = N_det integer :: i,k + print*,'N_det = ',N_det do i=1,N_det_generators do k=1,N_int psi_det_generators(k,1,i) = psi_det(k,1,i) diff --git a/plugins/FOBOCI/new_approach.irp.f b/plugins/FOBOCI/new_approach.irp.f index 49dcafc3..8e2f2e53 100644 --- a/plugins/FOBOCI/new_approach.irp.f +++ b/plugins/FOBOCI/new_approach.irp.f @@ -24,6 +24,7 @@ subroutine new_approach double precision, allocatable :: dressing_matrix_1h1p(:,:) double precision, allocatable :: dressing_matrix_2h1p(:,:) double precision, allocatable :: dressing_matrix_1h2p(:,:) + double precision, allocatable :: dressing_matrix_extra_1h_or_1p(:,:) double precision, allocatable :: H_matrix_tmp(:,:) logical :: verbose,is_ok @@ -45,7 +46,7 @@ subroutine new_approach verbose = .True. - threshold = threshold_singles + threshold = threshold_lmct print*,'threshold = ',threshold thr = 1.d-12 print*,'' @@ -81,12 +82,14 @@ subroutine new_approach ! so all the mono excitation on the new generators allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators)) allocate(dressing_matrix_2h1p(N_det_generators,N_det_generators)) + allocate(dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)) dressing_matrix_1h1p = 0.d0 dressing_matrix_2h1p = 0.d0 + dressing_matrix_extra_1h_or_1p = 0.d0 if(.not.do_it_perturbative)then n_good_hole +=1 ! call all_single_split_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) - call all_single_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) + call all_single_for_1h(i_hole_foboci,dressing_matrix_1h1p,dressing_matrix_2h1p,dressing_matrix_extra_1h_or_1p) allocate(H_matrix_tmp(N_det_generators,N_det_generators)) do j = 1,N_det_generators do k = 1, N_det_generators @@ -96,7 +99,7 @@ subroutine new_approach enddo do j = 1, N_det_generators do k = 1, N_det_generators - H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_2h1p(j,k) + H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_2h1p(j,k) + dressing_matrix_extra_1h_or_1p(j,k) enddo enddo hjk = H_matrix_tmp(1,1) @@ -130,6 +133,7 @@ subroutine new_approach endif deallocate(dressing_matrix_1h1p) deallocate(dressing_matrix_2h1p) + deallocate(dressing_matrix_extra_1h_or_1p) enddo print*,'' @@ -155,12 +159,14 @@ subroutine new_approach ! so all the mono excitation on the new generators allocate(dressing_matrix_1h1p(N_det_generators,N_det_generators)) allocate(dressing_matrix_1h2p(N_det_generators,N_det_generators)) + allocate(dressing_matrix_extra_1h_or_1p(N_det_generators,N_det_generators)) dressing_matrix_1h1p = 0.d0 dressing_matrix_1h2p = 0.d0 + dressing_matrix_extra_1h_or_1p = 0.d0 if(.not.do_it_perturbative)then n_good_hole +=1 ! call all_single_split_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) - call all_single_for_1p(dressing_matrix_1h1p,dressing_matrix_1h2p) + call all_single_for_1p(i_particl_osoci,dressing_matrix_1h1p,dressing_matrix_1h2p,dressing_matrix_extra_1h_or_1p) allocate(H_matrix_tmp(N_det_generators,N_det_generators)) do j = 1,N_det_generators do k = 1, N_det_generators @@ -170,7 +176,7 @@ subroutine new_approach enddo do j = 1, N_det_generators do k = 1, N_det_generators - H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_1h2p(j,k) + H_matrix_tmp(j,k) += dressing_matrix_1h1p(j,k) + dressing_matrix_1h2p(j,k) + dressing_matrix_extra_1h_or_1p(j,k) enddo enddo hjk = H_matrix_tmp(1,1) @@ -205,7 +211,10 @@ subroutine new_approach endif deallocate(dressing_matrix_1h1p) deallocate(dressing_matrix_1h2p) + deallocate(dressing_matrix_extra_1h_or_1p) enddo + + double precision, allocatable :: H_matrix_total(:,:) integer :: n_det_total n_det_total = N_det_generators_restart + n_good_det @@ -221,7 +230,7 @@ subroutine new_approach !!! Adding the averaged dressing coming from the 1h1p that are redundant for each of the "n_good_hole" 1h H_matrix_total(i,j) += dressing_matrix_restart_1h1p(i,j)/dble(n_good_hole+n_good_particl) !!! Adding the dressing coming from the 2h1p that are not redundant for the any of CI calculations - H_matrix_total(i,j) += dressing_matrix_restart_2h1p(i,j) + H_matrix_total(i,j) += dressing_matrix_restart_2h1p(i,j) + dressing_matrix_restart_1h2p(i,j) enddo enddo do i = 1, n_good_det @@ -244,25 +253,79 @@ subroutine new_approach H_matrix_total(n_det_generators_restart+j,n_det_generators_restart+i) = hij enddo enddo - print*,'H matrix to diagonalize' - double precision :: href - href = H_matrix_total(1,1) - do i = 1, n_det_total - H_matrix_total(i,i) -= href + + ! Adding the correlation energy + logical :: orb_taken_good_det(mo_tot_num) + double precision :: phase + integer :: n_h,n_p,number_of_holes,number_of_particles + integer :: exc(0:2,2,2) + integer :: degree + integer :: h1,h2,p1,p2,s1,s2 + logical, allocatable :: one_hole_or_one_p(:) + integer, allocatable :: holes_or_particle(:) + allocate(one_hole_or_one_p(n_good_det), holes_or_particle(n_good_det)) + orb_taken_good_det = .False. + do i = 1, n_good_det + n_h = number_of_holes(psi_good_det(1,1,i)) + n_p = number_of_particles(psi_good_det(1,1,i)) + call get_excitation(ref_bitmask,psi_good_det(1,1,i),exc,degree,phase,N_int) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + if(n_h == 0 .and. n_p == 1)then + orb_taken_good_det(h1) = .True. + one_hole_or_one_p(i) = .True. + holes_or_particle(i) = h1 + endif + if(n_h == 1 .and. n_p == 0)then + orb_taken_good_det(p1) = .True. + one_hole_or_one_p(i) = .False. + holes_or_particle(i) = p1 + endif enddo - do i = 1, n_det_total - write(*,'(100(X,F16.8))')H_matrix_total(i,:) - enddo - double precision, allocatable :: eigvalues(:),eigvectors(:,:) - allocate(eigvalues(n_det_total),eigvectors(n_det_total,n_det_total)) - call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total) - print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion + href - do i = 1, n_det_total - print*,'coef = ',eigvectors(i,1) - enddo - integer(bit_kind), allocatable :: psi_det_final(:,:,:) - double precision, allocatable :: psi_coef_final(:,:) - double precision :: norm + + do i = 1, N_det_generators_restart + ! Add the 2h2p, 2h1p and 1h2p correlation energy + H_matrix_total(i,i) += total_corr_e_2h2p + total_corr_e_2h1p + total_corr_e_1h2p + total_corr_e_1h1p_spin_flip + ! Substract the 2h1p part that have already been taken into account + do j = 1, n_inact_orb + iorb = list_inact(j) + if(.not.orb_taken_good_det(iorb))cycle + H_matrix_total(i,i) -= corr_energy_2h1p_per_orb_ab(iorb) - corr_energy_2h1p_per_orb_bb(iorb) - corr_energy_1h1p_spin_flip_per_orb(iorb) + enddo + ! Substract the 1h2p part that have already been taken into account + do j = 1, n_virt_orb + iorb = list_virt(j) + if(.not.orb_taken_good_det(iorb))cycle + H_matrix_total(i,i) -= corr_energy_1h2p_per_orb_ab(iorb) - corr_energy_1h2p_per_orb_aa(iorb) + enddo + enddo + + do i = 1, N_good_det + ! Repeat the 2h2p correlation energy + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += total_corr_e_2h2p + ! Substract the part that can not be repeated + ! If it is a 1h + if(one_hole_or_one_p(i))then + ! 2h2p + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h2p_per_orb_ab(holes_or_particle(i)) & + -corr_energy_2h2p_per_orb_bb(holes_or_particle(i)) + ! You can repeat a certain part of the 1h2p correlation energy + ! that is everything except the part that involves the hole of the 1h + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += total_corr_e_1h2p + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_1h2p_per_orb_ab(holes_or_particle(i)) & + -corr_energy_1h2p_per_orb_bb(holes_or_particle(i)) + + else + ! 2h2p + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h2p_per_orb_ab(holes_or_particle(i)) & + -corr_energy_2h2p_per_orb_aa(holes_or_particle(i)) + ! You can repeat a certain part of the 2h1p correlation energy + ! that is everything except the part that involves the hole of the 1p + ! 2h1p + H_matrix_total(N_det_generators_restart+i,N_det_generators_restart+i) += -corr_energy_2h1p_per_orb_ab(holes_or_particle(i)) & + -corr_energy_2h1p_per_orb_aa(holes_or_particle(i)) + endif + enddo + allocate(psi_coef_final(n_det_total, N_states)) allocate(psi_det_final(N_int,2,n_det_total)) do i = 1, N_det_generators_restart @@ -277,22 +340,222 @@ subroutine new_approach psi_det_final(j,2,n_det_generators_restart+i) = psi_good_det(j,2,i) enddo enddo - norm = 0.d0 + + + double precision :: href + double precision, allocatable :: eigvalues(:),eigvectors(:,:) + integer(bit_kind), allocatable :: psi_det_final(:,:,:) + double precision, allocatable :: psi_coef_final(:,:) + double precision :: norm + allocate(eigvalues(n_det_total),eigvectors(n_det_total,n_det_total)) + + call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total) + print*,'' + print*,'' + print*,'H_matrix_total(1,1) = ',H_matrix_total(1,1) + print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion do i = 1, n_det_total - do j = 1, N_states - psi_coef_final(i,j) = eigvectors(i,j) - enddo - norm += psi_coef_final(i,1)**2 -! call debug_det(psi_det_final(1, 1, i), N_int) + print*,'coef = ',eigvectors(i,1),H_matrix_total(i,i) - H_matrix_total(1,1) enddo - print*,'norm = ',norm + + integer(bit_kind), allocatable :: psi_det_remaining_1h_or_1p(:,:,:) + integer(bit_kind), allocatable :: key_tmp(:,:) + integer :: n_det_remaining_1h_or_1p + integer :: ispin,i_ok + allocate(key_tmp(N_int,2),psi_det_remaining_1h_or_1p(N_int,2,n_inact_orb*n_act_orb+n_virt_orb*n_act_orb)) + logical :: is_already_present + logical, allocatable :: one_hole_or_one_p_bis(:) + integer, allocatable :: holes_or_particle_bis(:) + double precision,allocatable :: H_array(:) + allocate(one_hole_or_one_p_bis(n_inact_orb*n_act_orb+n_virt_orb*n_act_orb), holes_or_particle_bis(n_inact_orb*n_act_orb+n_virt_orb*n_act_orb)) + allocate(H_array(n_det_total)) + ! Dressing with the remaining 1h determinants + print*,'' + print*,'' + print*,'Dressing with the remaining 1h determinants' + n_det_remaining_1h_or_1p = 0 + do i = 1, n_inact_orb + iorb = list_inact(i) + if(orb_taken_good_det(iorb))cycle + do j = 1, n_act_orb + jorb = list_act(j) + ispin = 2 + key_tmp = ref_bitmask + call do_mono_excitation(key_tmp,iorb,jorb,ispin,i_ok) + if(i_ok .ne.1)cycle + is_already_present = .False. + H_array = 0.d0 + call i_h_j(key_tmp,key_tmp,N_int,hij) + href = ref_bitmask_energy - hij + href = 1.d0/href + do k = 1, n_det_total + call get_excitation_degree(psi_det_final(1,1,k),key_tmp,degree,N_int) + if(degree == 0)then + is_already_present = .True. + exit + endif + enddo + if(is_already_present)cycle + n_det_remaining_1h_or_1p +=1 + one_hole_or_one_p_bis(n_det_remaining_1h_or_1p) = .True. + holes_or_particle_bis(n_det_remaining_1h_or_1p) = iorb + do k = 1, N_int + psi_det_remaining_1h_or_1p(k,1,n_det_remaining_1h_or_1p) = key_tmp(k,1) + psi_det_remaining_1h_or_1p(k,2,n_det_remaining_1h_or_1p) = key_tmp(k,2) + enddo + ! do k = 1, n_det_total + ! call i_h_j(psi_det_final(1,1,k),key_tmp,N_int,hij) + ! H_array(k) = hij + ! enddo + ! do k = 1, n_det_total + ! do l = 1, n_det_total + ! H_matrix_total(k,l) += H_array(k) * H_array(l) * href + ! enddo + ! enddo + enddo + enddo + ! Dressing with the remaining 1p determinants + print*,'n_det_remaining_1h_or_1p = ',n_det_remaining_1h_or_1p + print*,'Dressing with the remaining 1p determinants' + do i = 1, n_virt_orb + iorb = list_virt(i) + if(orb_taken_good_det(iorb))cycle + do j = 1, n_act_orb + jorb = list_act(j) + ispin = 1 + key_tmp = ref_bitmask + call do_mono_excitation(key_tmp,jorb,iorb,ispin,i_ok) + if(i_ok .ne.1)cycle + is_already_present = .False. + H_array = 0.d0 + call i_h_j(key_tmp,key_tmp,N_int,hij) + href = ref_bitmask_energy - hij + href = 1.d0/href + do k = 1, n_det_total + call get_excitation_degree(psi_det_final(1,1,k),key_tmp,degree,N_int) + if(degree == 0)then + is_already_present = .True. + exit + endif + enddo + if(is_already_present)cycle + n_det_remaining_1h_or_1p +=1 + one_hole_or_one_p_bis(n_det_remaining_1h_or_1p) = .False. + holes_or_particle_bis(n_det_remaining_1h_or_1p) = iorb + do k = 1, N_int + psi_det_remaining_1h_or_1p(k,1,n_det_remaining_1h_or_1p) = key_tmp(k,1) + psi_det_remaining_1h_or_1p(k,2,n_det_remaining_1h_or_1p) = key_tmp(k,2) + enddo +! do k = 1, n_det_total +! call i_h_j(psi_det_final(1,1,k),key_tmp,N_int,hij) +! H_array(k) = hij +! enddo +! do k = 1, n_det_total +! do l = 1, n_det_total +! H_matrix_total(k,l) += H_array(k) * H_array(l) * href +! enddo +! enddo + enddo + enddo + print*,'n_det_remaining_1h_or_1p = ',n_det_remaining_1h_or_1p + deallocate(key_tmp,H_array) + + double precision, allocatable :: eigvalues_bis(:),eigvectors_bis(:,:),H_matrix_total_bis(:,:) + integer :: n_det_final + n_det_final = n_det_total + n_det_remaining_1h_or_1p + allocate(eigvalues_bis(n_det_final),eigvectors_bis(n_det_final,n_det_final),H_matrix_total_bis(n_det_final,n_det_final)) + print*,'passed the allocate, building the big matrix' + do i = 1, n_det_total + do j = 1, n_det_total + H_matrix_total_bis(i,j) = H_matrix_total(i,j) + enddo + enddo + do i = 1, n_det_remaining_1h_or_1p + do j = 1, n_det_remaining_1h_or_1p + call i_h_j(psi_det_remaining_1h_or_1p(1,1,i),psi_det_remaining_1h_or_1p(1,1,j),N_int,hij) + H_matrix_total_bis(n_det_total+i,n_det_total+j) = hij + enddo + enddo + do i = 1, n_det_total + do j = 1, n_det_remaining_1h_or_1p + call i_h_j(psi_det_final(1,1,i),psi_det_remaining_1h_or_1p(1,1,j),N_int,hij) + H_matrix_total_bis(i,n_det_total+j) = hij + H_matrix_total_bis(n_det_total+j,i) = hij + enddo + enddo + print*,'passed the matrix' + do i = 1, n_det_remaining_1h_or_1p + if(one_hole_or_one_p_bis(i))then + H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_2h2p -corr_energy_2h2p_per_orb_ab(holes_or_particle_bis(i)) & + -corr_energy_2h2p_per_orb_bb(holes_or_particle_bis(i)) + H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_1h2p -corr_energy_1h2p_per_orb_ab(holes_or_particle_bis(i)) & + -corr_energy_1h2p_per_orb_bb(holes_or_particle_bis(i)) + else + H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_2h2p -corr_energy_2h2p_per_orb_ab(holes_or_particle_bis(i)) & + -corr_energy_2h2p_per_orb_aa(holes_or_particle_bis(i)) + H_matrix_total_bis(n_det_total+i,n_det_total+i) += total_corr_e_1h2p -corr_energy_2h1p_per_orb_ab(holes_or_particle_bis(i)) & + -corr_energy_2h1p_per_orb_aa(holes_or_particle_bis(i)) + + endif + enddo + do i = 2, n_det_final + do j = i+1, n_det_final + H_matrix_total_bis(i,j) = 0.d0 + H_matrix_total_bis(j,i) = 0.d0 + enddo + enddo + do i = 1, n_det_final + write(*,'(500(F10.5,X))')H_matrix_total_bis(i,:) + enddo + call lapack_diag(eigvalues_bis,eigvectors_bis,H_matrix_total_bis,n_det_final,n_det_final) + print*,'e_dressed = ',eigvalues_bis(1) + nuclear_repulsion + do i = 1, n_det_final + print*,'coef = ',eigvectors_bis(i,1),H_matrix_total_bis(i,i) - H_matrix_total_bis(1,1) + enddo + do j = 1, N_states + do i = 1, n_det_total + psi_coef_final(i,j) = eigvectors_bis(i,j) + norm += psi_coef_final(i,j)**2 + enddo + norm = 1.d0/dsqrt(norm) + do i = 1, n_det_total + psi_coef_final(i,j) = psi_coef_final(i,j) * norm + enddo + enddo + + + deallocate(eigvalues_bis,eigvectors_bis,H_matrix_total_bis) + + +!print*,'H matrix to diagonalize' +!href = H_matrix_total(1,1) +!do i = 1, n_det_total +! H_matrix_total(i,i) -= href +!enddo +!do i = 1, n_det_total +! write(*,'(100(X,F16.8))')H_matrix_total(i,:) +!enddo +!call lapack_diag(eigvalues,eigvectors,H_matrix_total,n_det_total,n_det_total) +!print*,'H_matrix_total(1,1) = ',H_matrix_total(1,1) +!print*,'e_dressed = ',eigvalues(1) + nuclear_repulsion +!do i = 1, n_det_total +! print*,'coef = ',eigvectors(i,1),H_matrix_total(i,i) - H_matrix_total(1,1) +!enddo +!norm = 0.d0 +!do i = 1, n_det_total +! do j = 1, N_states +! psi_coef_final(i,j) = eigvectors(i,j) +! enddo +! norm += psi_coef_final(i,1)**2 +!enddo +!print*,'norm = ',norm call set_psi_det_as_input_psi(n_det_total,psi_det_final,psi_coef_final) - print*,'' -!do i = 1, N_det -! call debug_det(psi_det(1,1,i),N_int) -! print*,'coef = ',psi_coef(i,1) -!enddo + + do i = 1, N_det + call debug_det(psi_det(1,1,i),N_int) + print*,'coef = ',psi_coef(i,1) + enddo provide one_body_dm_mo integer :: i_core,iorb,jorb,i_inact,j_inact,i_virt,j_virt,j_core @@ -360,14 +623,14 @@ subroutine new_approach print*,'ACTIVE ORBITAL ',iorb do j = 1, n_inact_orb jorb = list_inact(j) - if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_singles)then + if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_lmct)then print*,'INACTIVE ' print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb)) endif enddo do j = 1, n_virt_orb jorb = list_virt(j) - if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_singles)then + if(dabs(one_body_dm_mo(iorb,jorb)).gt.threshold_mlct)then print*,'VIRT ' print*,'DM ',iorb,jorb,dabs(one_body_dm_mo(iorb,jorb)) endif diff --git a/plugins/FOBOCI/new_new_approach.irp.f b/plugins/FOBOCI/new_new_approach.irp.f new file mode 100644 index 00000000..b904a5b3 --- /dev/null +++ b/plugins/FOBOCI/new_new_approach.irp.f @@ -0,0 +1,132 @@ +program test_new_new + implicit none + read_wf = .True. + touch read_wf + call test +end + + +subroutine test + implicit none + integer :: i,j,k,l + call diagonalize_CI + call set_generators_to_psi_det + print*,'Initial coefficients' + do i = 1, N_det + print*,'' + call debug_det(psi_det(1,1,i),N_int) + print*,'psi_coef = ',psi_coef(i,1) + print*,'' + enddo + double precision, allocatable :: dressing_matrix(:,:) + double precision :: hij + double precision :: phase + integer :: n_h,n_p,number_of_holes,number_of_particles + integer :: exc(0:2,2,2) + integer :: degree + integer :: h1,h2,p1,p2,s1,s2 + allocate(dressing_matrix(N_det_generators,N_det_generators)) + do i = 1, N_det_generators + do j = 1, N_det_generators + call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij) + dressing_matrix(i,j) = hij + enddo + enddo + href = dressing_matrix(1,1) + print*,'Diagonal part of the dressing' + do i = 1, N_det_generators + print*,'delta e = ',dressing_matrix(i,i) - href + enddo + call all_single_split(psi_det_generators,psi_coef_generators,N_det_generators,dressing_matrix) + double precision :: href + print*,'' + ! One considers that the following excitation classes are not repeatable on the 1h and 1p determinants : + ! + 1h1p spin flip + ! + 2h1p + ! + 1h2p + ! But the 2h2p are correctly taken into account +!dressing_matrix(1,1) += total_corr_e_1h2p + total_corr_e_2h1p + total_corr_e_1h1p_spin_flip +!do i = 1, N_det_generators +! dressing_matrix(i,i) += total_corr_e_2h2p +! n_h = number_of_holes(psi_det(1,1,i)) +! n_p = number_of_particles(psi_det(1,1,i)) +! if(n_h == 1 .and. n_p ==0)then +! +! call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int) +! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) +! print*,'' +! print*,' 1h det ' +! print*,'' +! call debug_det(psi_det_generators(1,1,i),N_int) +! print*,'h1,p1 = ',h1,p1 +! print*,'total_corr_e_2h2p ',total_corr_e_2h2p +! print*,'corr_energy_2h2p_per_orb_ab(h1)',corr_energy_2h2p_per_orb_ab(h1) +! print*,'corr_energy_2h2p_per_orb_bb(h1)',corr_energy_2h2p_per_orb_bb(h1) +! dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(h1) - corr_energy_2h2p_per_orb_bb(h1) +! dressing_matrix(1,1) += -corr_energy_2h1p_per_orb_aa(h1) - corr_energy_2h1p_per_orb_ab(h1) -corr_energy_2h1p_per_orb_bb(h1) & +! -corr_energy_1h1p_spin_flip_per_orb(h1) +! endif +! if(n_h == 0 .and. n_p ==1)then +! call get_excitation(ref_bitmask,psi_det_generators(1,1,i),exc,degree,phase,N_int) +! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) +! print*,'' +! print*,' 1p det ' +! print*,'' +! call debug_det(psi_det_generators(1,1,i),N_int) +! print*,'h1,p1 = ',h1,p1 +! print*,'total_corr_e_2h2p ',total_corr_e_2h2p +! print*,'corr_energy_2h2p_per_orb_ab(p1)',corr_energy_2h2p_per_orb_ab(p1) +! print*,'corr_energy_2h2p_per_orb_aa(p1)',corr_energy_2h2p_per_orb_aa(p1) +! dressing_matrix(i,i) += -corr_energy_2h2p_per_orb_ab(p1) - corr_energy_2h2p_per_orb_aa(p1) +! dressing_matrix(1,1) += -corr_energy_1h2p_per_orb_aa(p1) - corr_energy_1h2p_per_orb_ab(p1) -corr_energy_1h2p_per_orb_bb(p1) +! endif +!enddo +!href = dressing_matrix(1,1) +!print*,'Diagonal part of the dressing' +!do i = 1, N_det_generators +! print*,'delta e = ',dressing_matrix(i,i) - href +!enddo + call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) + print*,'After dressing matrix' + print*,'' + print*,'' + do i = 1, N_det + print*,'psi_coef = ',psi_coef(i,1) + enddo +!print*,'' +!print*,'' +!print*,'Canceling the dressing part of the interaction between 1h and 1p' +!do i = 2, N_det_generators +! do j = i+1, N_det_generators +! call i_h_j(psi_det_generators(1,1,i),psi_det_generators(1,1,j),N_int,hij) +! dressing_matrix(i,j) = hij +! dressing_matrix(j,i) = hij +! enddo +!enddo +!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) +!print*,'' +!print*,'' +!do i = 1, N_det +! print*,'psi_coef = ',psi_coef(i,1) +!enddo +!print*,'' +!print*,'' +!print*,'Canceling the interaction between 1h and 1p' + +!print*,'' +!print*,'' +!do i = 2, N_det_generators +! do j = i+1, N_det_generators +! dressing_matrix(i,j) = 0.d0 +! dressing_matrix(j,i) = 0.d0 +! enddo +!enddo +!call diag_dressed_matrix_and_set_to_psi_det(psi_det_generators,N_det_generators,dressing_matrix) +!do i = 1, N_det +! print*,'psi_coef = ',psi_coef(i,1) +!enddo + call save_natural_mos + deallocate(dressing_matrix) + + +end diff --git a/plugins/FOBOCI/routines_dressing.irp.f b/plugins/FOBOCI/routines_dressing.irp.f index 910f1109..125143da 100644 --- a/plugins/FOBOCI/routines_dressing.irp.f +++ b/plugins/FOBOCI/routines_dressing.irp.f @@ -55,15 +55,11 @@ subroutine provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det i_pert = 0 endif do j = 1, ndet_generators_input - if(dabs(H_array(j)*lambda_i).gt.0.5d0)then + if(dabs(H_array(j)*lambda_i).gt.0.1d0)then i_pert = 1 exit endif enddo -! print*,'' -! print*,'lambda_i,f = ',lambda_i,f -! print*,'i_pert = ',i_pert -! print*,'' if(i_pert==1)then lambda_i = f i_pert_count +=1 @@ -79,9 +75,122 @@ subroutine provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det enddo enddo enddo + href = dressing_matrix(1,1) + print*,'Diagonal part of the dressing' + do i = 1, ndet_generators_input + print*,'delta e = ',dressing_matrix(i,i) - href + enddo !print*,'i_pert_count = ',i_pert_count end +subroutine update_matrix_dressing_sc2(dressing_matrix,ndet_generators_input,psi_det_generators_input,H_jj_in) + use bitmasks + implicit none + integer, intent(in) :: ndet_generators_input + integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,ndet_generators_input) + double precision, intent(in) :: H_jj_in(N_det) + double precision, intent(inout) :: dressing_matrix(ndet_generators_input,ndet_generators_input) + integer :: i,j,n_det_ref_tmp,degree + double precision :: href + n_det_ref_tmp = 0 + do i = 1, N_det + do j = 1, Ndet_generators_input + call get_excitation_degree(psi_det(1,1,i),psi_det_generators_input(1,1,j),degree,N_int) + if(degree == 0)then + dressing_matrix(j,j) += H_jj_in(i) + n_det_ref_tmp +=1 + exit + endif + enddo + enddo + if( ndet_generators_input .ne. n_det_ref_tmp)then + print*,'Problem !!!! ' + print*,' ndet_generators .ne. n_det_ref_tmp !!!' + print*,'ndet_generators,n_det_ref_tmp' + print*,ndet_generators_input,n_det_ref_tmp + stop + endif + + href = dressing_matrix(1,1) + print*,'' + print*,'Update with the SC2 dressing' + print*,'' + print*,'Diagonal part of the dressing' + do i = 1, ndet_generators_input + print*,'delta e = ',dressing_matrix(i,i) - href + enddo +end + +subroutine provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix,psi_det_ref_input,psi_coef_ref_input,n_det_ref_input, & + psi_det_outer_input,psi_coef_outer_input,n_det_outer_input) + use bitmasks + implicit none + integer, intent(in) :: n_det_ref_input + integer(bit_kind), intent(in) :: psi_det_ref_input(N_int,2,n_det_ref_input) + double precision, intent(in) :: psi_coef_ref_input(n_det_ref_input,N_states) + integer, intent(in) :: n_det_outer_input + integer(bit_kind), intent(in) :: psi_det_outer_input(N_int,2,n_det_outer_input) + double precision, intent(in) :: psi_coef_outer_input(n_det_outer_input,N_states) + + double precision, intent(inout) :: dressing_matrix(n_det_ref_input,n_det_ref_input) + + + integer :: i_pert, i_pert_count,i,j,k + double precision :: f,href,hka,lambda_i + double precision :: H_array(n_det_ref_input),accu + integer :: n_h_out,n_p_out,n_p_in,n_h_in,number_of_holes,number_of_particles + call i_h_j(psi_det_ref_input(1,1,1),psi_det_ref_input(1,1,1),N_int,href) + i_pert_count = 0 + do i = 1, n_det_outer_input + call i_h_j(psi_det_outer_input(1,1,i),psi_det_outer_input(1,1,i),N_int,hka) + f = 1.d0/(href - hka) + H_array = 0.d0 + accu = 0.d0 +! n_h_out = number_of_holes(psi_det_outer_input(1,1,i)) +! n_p_out = number_of_particles(psi_det_outer_input(1,1,i)) + do j=1,n_det_ref_input + n_h_in = number_of_holes(psi_det_ref_input(1,1,j)) + n_p_in = number_of_particles(psi_det_ref_input(1,1,j)) +! if(n_h_in == 0 .and. n_h_in == 0)then + call i_h_j(psi_det_outer_input(1,1,i),psi_det_ref_input(1,1,j),N_int,hka) +! else +! hka = 0.d0 +! endif + H_array(j) = hka + accu += psi_coef_ref_input(j,1) * hka + enddo + lambda_i = psi_coef_outer_input(i,1)/accu + i_pert = 1 + if(accu * f / psi_coef_outer_input(i,1) .gt. 0.5d0 .and. accu * f/psi_coef_outer_input(i,1).gt.0.d0)then + i_pert = 0 + endif + do j = 1, n_det_ref_input + if(dabs(H_array(j)*lambda_i).gt.0.5d0)then + i_pert = 1 + exit + endif + enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! i_pert = 0 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if(i_pert==1)then + lambda_i = f + i_pert_count +=1 + endif + do k=1,n_det_ref_input + double precision :: contrib + contrib = H_array(k) * H_array(k) * lambda_i + dressing_matrix(k, k) += contrib + do j=k+1,n_det_ref_input + contrib = H_array(k) * H_array(j) * lambda_i + dressing_matrix(k, j) += contrib + dressing_matrix(j, k) += contrib + enddo + enddo + enddo +end + + subroutine provide_matrix_dressing_general(dressing_matrix,psi_det_ref_input,psi_coef_ref_input,n_det_ref_input, & psi_det_outer_input,psi_coef_outer_input,n_det_outer_input) use bitmasks @@ -112,16 +221,17 @@ subroutine provide_matrix_dressing_general(dressing_matrix,psi_det_ref_input,psi accu += psi_coef_ref_input(j,1) * hka enddo lambda_i = psi_coef_outer_input(i,1)/accu - i_pert = 1 + i_pert = 0 if(accu * f / psi_coef_outer_input(i,1) .gt. 0.5d0 .and. accu * f/psi_coef_outer_input(i,1).gt.0.d0)then i_pert = 0 endif do j = 1, n_det_ref_input - if(dabs(H_array(j)*lambda_i).gt.0.3d0)then + if(dabs(H_array(j)*lambda_i).gt.0.5d0)then i_pert = 1 exit endif enddo +! i_pert = 0 if(i_pert==1)then lambda_i = f i_pert_count +=1 @@ -170,114 +280,379 @@ subroutine diag_dressed_matrix_and_set_to_psi_det(psi_det_generators_input,Ndet_ end -subroutine give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p) +subroutine give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p) use bitmasks implicit none - integer, intent(out) :: n_det_1h1p, n_det_2h1p + integer, intent(in) :: i_hole + integer, intent(out) :: n_det_1h1p, n_det_2h1p,n_det_extra_1h_or_1p integer :: i integer :: n_det_ref_restart_tmp,n_det_1h integer :: number_of_holes,n_h, number_of_particles,n_p + logical :: is_the_hole_in_det n_det_ref_restart_tmp = 0 n_det_1h = 0 n_det_1h1p = 0 n_det_2h1p = 0 + n_det_extra_1h_or_1p = 0 do i = 1, N_det n_h = number_of_holes(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i)) if(n_h == 0 .and. n_p == 0)then n_det_ref_restart_tmp +=1 else if (n_h ==1 .and. n_p==0)then - n_det_1h +=1 + if(is_the_hole_in_det(psi_det(1,1,i),1,i_hole).or.is_the_hole_in_det(psi_det(1,1,i),2,i_hole))then + n_det_1h +=1 + else + n_det_extra_1h_or_1p +=1 + endif + else if (n_h ==0 .and. n_p==1)then + n_det_extra_1h_or_1p +=1 else if (n_h ==1 .and. n_p==1)then n_det_1h1p +=1 else if (n_h ==2 .and. n_p==1)then n_det_2h1p +=1 else print*,'PB !!!!' - print*,'You have something else than a 1h, 1h1p or 2h1p' + print*,'You have something else than a 1h, 1p, 1h1p or 2h1p' + print*,'n_h,n_p = ',n_h,n_p call debug_det(psi_det(1,1,i),N_int) stop endif enddo -! if(n_det_1h.ne.1)then -! print*,'PB !! You have more than one 1h' -! stop -! endif if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then print*,'PB !!!!' print*,'You have forgotten something in your generators ... ' stop endif - + if(n_det_2h1p + n_det_1h1p + n_det_extra_1h_or_1p + n_det_generators .ne. N_det)then + print*,'PB !!!!' + print*,'You have forgotten something in your generators ... ' + stop + endif end -subroutine give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p) +subroutine give_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p) use bitmasks implicit none - integer, intent(out) :: n_det_1h1p, n_det_1h2p + integer, intent(out) :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p integer :: i integer :: n_det_ref_restart_tmp,n_det_1h integer :: number_of_holes,n_h, number_of_particles,n_p - n_det_ref_restart_tmp = 0 - n_det_1h = 0 + logical :: is_the_hole_in_det + n_det_ref_1h_1p = 0 + n_det_2h1p = 0 n_det_1h1p = 0 - n_det_1h2p = 0 do i = 1, N_det n_h = number_of_holes(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i)) if(n_h == 0 .and. n_p == 0)then - n_det_ref_restart_tmp +=1 + n_det_ref_1h_1p +=1 + else if (n_h ==1 .and. n_p==0)then + n_det_ref_1h_1p +=1 else if (n_h ==0 .and. n_p==1)then - n_det_1h +=1 + n_det_ref_1h_1p +=1 + else if (n_h ==1 .and. n_p==1)then + n_det_1h1p +=1 + else if (n_h ==2 .and. n_p==1)then + n_det_2h1p +=1 + else + print*,'PB !!!!' + print*,'You have something else than a 1h, 1p, 1h1p or 2h1p' + print*,'n_h,n_p = ',n_h,n_p + call debug_det(psi_det(1,1,i),N_int) + stop + endif + enddo + +end + +subroutine give_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p) + use bitmasks + implicit none + integer, intent(out) :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p + integer :: i + integer :: n_det_ref_restart_tmp,n_det_1h + integer :: number_of_holes,n_h, number_of_particles,n_p + logical :: is_the_hole_in_det + n_det_ref_1h_1p = 0 + n_det_1h2p = 0 + n_det_1h1p = 0 + do i = 1, N_det + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + if(n_h == 0 .and. n_p == 0)then + n_det_ref_1h_1p +=1 + else if (n_h ==1 .and. n_p==0)then + n_det_ref_1h_1p +=1 + else if (n_h ==0 .and. n_p==1)then + n_det_ref_1h_1p +=1 else if (n_h ==1 .and. n_p==1)then n_det_1h1p +=1 else if (n_h ==1 .and. n_p==2)then n_det_1h2p +=1 else print*,'PB !!!!' - print*,'You have something else than a 1p, 1h1p or 1h2p' + print*,'You have something else than a 1h, 1p, 1h1p or 1h2p' + print*,'n_h,n_p = ',n_h,n_p call debug_det(psi_det(1,1,i),N_int) stop endif enddo - if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then + +end + +subroutine give_wf_n_ref_1h_1p_and_n_2h1p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,& + psi_det_2h1p,psi_coef_2h1p,psi_det_1h1p,psi_coef_1h1p) + use bitmasks + implicit none + integer, intent(in) :: n_det_ref_1h_1p,n_det_2h1p,n_det_1h1p + integer(bit_kind), intent(out) :: psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p) + integer(bit_kind), intent(out) :: psi_det_2h1p(N_int,2,n_det_2h1p) + integer(bit_kind), intent(out) :: psi_det_1h1p(N_int,2,n_det_1h1p) + double precision, intent(out) :: psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states) + double precision, intent(out) :: psi_coef_2h1p(n_det_2h1p,N_states) + double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p,N_states) + integer :: n_det_ref_1h_1p_tmp,n_det_2h1p_tmp,n_det_1h1p_tmp + integer :: i,j + integer :: n_det_ref_restart_tmp,n_det_1h + integer :: number_of_holes,n_h, number_of_particles,n_p + logical :: is_the_hole_in_det + integer, allocatable :: index_ref_1h_1p(:) + integer, allocatable :: index_2h1p(:) + integer, allocatable :: index_1h1p(:) + allocate(index_ref_1h_1p(n_det)) + allocate(index_2h1p(n_det)) + allocate(index_1h1p(n_det)) + n_det_ref_1h_1p_tmp = 0 + n_det_2h1p_tmp = 0 + n_det_1h1p_tmp = 0 + do i = 1, N_det + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + if(n_h == 0 .and. n_p == 0)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==1 .and. n_p==0)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==0 .and. n_p==1)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==1 .and. n_p==1)then + n_det_1h1p_tmp +=1 + index_1h1p(n_det_1h1p_tmp) = i + else if (n_h ==2 .and. n_p==1)then + n_det_2h1p_tmp +=1 + index_2h1p(n_det_2h1p_tmp) = i + else print*,'PB !!!!' - print*,'You have forgotten something in your generators ... ' - stop - endif + print*,'You have something else than a 1h, 1p, 1h1p or 2h1p' + print*,'n_h,n_p = ',n_h,n_p + call debug_det(psi_det(1,1,i),N_int) + stop + endif + enddo + do i = 1, n_det_2h1p + do j = 1, N_int + psi_det_2h1p(j,1,i) = psi_det(j,1,index_2h1p(i)) + psi_det_2h1p(j,2,i) = psi_det(j,2,index_2h1p(i)) + enddo + do j = 1, N_states + psi_coef_2h1p(i,j) = psi_coef(index_2h1p(i),j) + enddo + enddo + + do i = 1, n_det_1h1p + do j = 1, N_int + psi_det_1h1p(j,1,i) = psi_det(j,1,index_1h1p(i)) + psi_det_1h1p(j,2,i) = psi_det(j,2,index_1h1p(i)) + enddo + do j = 1, N_states + psi_coef_1h1p(i,j) = psi_coef(index_1h1p(i),j) + enddo + enddo + + do i = 1, n_det_ref_1h_1p + do j = 1, N_int + psi_det_ref_1h_1p(j,1,i) = psi_det(j,1,index_ref_1h_1p(i)) + psi_det_ref_1h_1p(j,2,i) = psi_det(j,2,index_ref_1h_1p(i)) + enddo + do j = 1, N_states + psi_coef_ref_1h_1p(i,j) = psi_coef(index_ref_1h_1p(i),j) + enddo + enddo + +end + +subroutine give_wf_n_ref_1h_1p_and_n_1h2p_1h1p_in_psi_det(n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p,psi_det_ref_1h_1p,psi_coef_ref_1h_1p,& + psi_det_1h2p,psi_coef_1h2p,psi_det_1h1p,psi_coef_1h1p) + use bitmasks + implicit none + integer, intent(in) :: n_det_ref_1h_1p,n_det_1h2p,n_det_1h1p + integer(bit_kind), intent(out) :: psi_det_ref_1h_1p(N_int,2,n_det_ref_1h_1p) + integer(bit_kind), intent(out) :: psi_det_1h2p(N_int,2,n_det_1h2p) + integer(bit_kind), intent(out) :: psi_det_1h1p(N_int,2,n_det_1h1p) + double precision, intent(out) :: psi_coef_ref_1h_1p(n_det_ref_1h_1p,N_states) + double precision, intent(out) :: psi_coef_1h2p(n_det_1h2p,N_states) + double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p,N_states) + integer :: n_det_ref_1h_1p_tmp,n_det_1h2p_tmp,n_det_1h1p_tmp + integer :: i,j + integer :: n_det_ref_restart_tmp,n_det_1h + integer :: number_of_holes,n_h, number_of_particles,n_p + logical :: is_the_hole_in_det + integer, allocatable :: index_ref_1h_1p(:) + integer, allocatable :: index_1h2p(:) + integer, allocatable :: index_1h1p(:) + allocate(index_ref_1h_1p(n_det)) + allocate(index_1h2p(n_det)) + allocate(index_1h1p(n_det)) + n_det_ref_1h_1p_tmp = 0 + n_det_1h2p_tmp = 0 + n_det_1h1p_tmp = 0 + do i = 1, N_det + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + if(n_h == 0 .and. n_p == 0)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==1 .and. n_p==0)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==0 .and. n_p==1)then + n_det_ref_1h_1p_tmp +=1 + index_ref_1h_1p(n_det_ref_1h_1p_tmp) = i + else if (n_h ==1 .and. n_p==1)then + n_det_1h1p_tmp +=1 + index_1h1p(n_det_1h1p_tmp) = i + else if (n_h ==1 .and. n_p==2)then + n_det_1h2p_tmp +=1 + index_1h2p(n_det_1h2p_tmp) = i + else + print*,'PB !!!!' + print*,'You have something else than a 1h, 1p, 1h1p or 1h2p' + print*,'n_h,n_p = ',n_h,n_p + call debug_det(psi_det(1,1,i),N_int) + stop + endif + enddo + do i = 1, n_det_1h2p + do j = 1, N_int + psi_det_1h2p(j,1,i) = psi_det(j,1,index_1h2p(i)) + psi_det_1h2p(j,2,i) = psi_det(j,2,index_1h2p(i)) + enddo + do j = 1, N_states + psi_coef_1h2p(i,j) = psi_coef(index_1h2p(i),j) + enddo + enddo + + do i = 1, n_det_1h1p + do j = 1, N_int + psi_det_1h1p(j,1,i) = psi_det(j,1,index_1h1p(i)) + psi_det_1h1p(j,2,i) = psi_det(j,2,index_1h1p(i)) + enddo + do j = 1, N_states + psi_coef_1h1p(i,j) = psi_coef(index_1h1p(i),j) + enddo + enddo + + do i = 1, n_det_ref_1h_1p + do j = 1, N_int + psi_det_ref_1h_1p(j,1,i) = psi_det(j,1,index_ref_1h_1p(i)) + psi_det_ref_1h_1p(j,2,i) = psi_det(j,2,index_ref_1h_1p(i)) + enddo + do j = 1, N_states + psi_coef_ref_1h_1p(i,j) = psi_coef(index_ref_1h_1p(i),j) + enddo + enddo + +end + + + +subroutine give_n_1h1p_and_n_1h2p_in_psi_det(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p) + use bitmasks + implicit none + integer, intent(in) ::i_particl + integer, intent(out) :: n_det_1h1p, n_det_1h2p,n_det_extra_1h_or_1p + integer :: i + integer :: n_det_ref_restart_tmp,n_det_1p + integer :: number_of_holes,n_h, number_of_particles,n_p + logical :: is_the_particl_in_det + n_det_ref_restart_tmp = 0 + n_det_1p = 0 + n_det_1h1p = 0 + n_det_1h2p = 0 + n_det_extra_1h_or_1p = 0 + do i = 1, N_det + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + if(n_h == 0 .and. n_p == 0)then + n_det_ref_restart_tmp +=1 + else if (n_h ==0 .and. n_p==1)then + if(is_the_particl_in_det(psi_det(1,1,i),1,i_particl).or.is_the_particl_in_det(psi_det(1,1,i),2,i_particl))then + n_det_1p +=1 + else + n_det_extra_1h_or_1p +=1 + endif + else if (n_h ==1 .and. n_p==0)then + n_det_extra_1h_or_1p +=1 + else if (n_h ==1 .and. n_p==1)then + n_det_1h1p +=1 + else if (n_h ==1 .and. n_p==2)then + n_det_1h2p +=1 + else + print*,'PB !!!!' + print*,'You have something else than a 1h, 1p, 1h1p or 1h2p' + call debug_det(psi_det(1,1,i),N_int) + stop + endif + enddo +!if(n_det_ref_restart_tmp + n_det_1h .ne. n_det_generators)then +! print*,'PB !!!!' +! print*,'You have forgotten something in your generators ... ' +! stop +!endif end -subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p) +subroutine split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_det_1h1p,n_det_2h1p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_2h1p,psi_coef_2h1p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p) use bitmasks implicit none - integer, intent(in) :: n_det_1h1p,n_det_2h1p + integer, intent(in) :: n_det_1h1p,n_det_2h1p,n_det_extra_1h_or_1p,i_hole integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators) integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p) integer(bit_kind), intent(out) :: psi_2h1p(N_int,2,n_det_2h1p) + integer(bit_kind), intent(out) :: psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p) double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states) double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states) double precision, intent(out) :: psi_coef_2h1p(n_det_2h1p, N_states) + double precision, intent(out) :: psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p, N_states) integer :: i,j integer :: degree integer :: number_of_holes,n_h, number_of_particles,n_p - integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_2h1p_tmp + integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_2h1p_tmp,n_det_extra_1h_or_1p_tmp + integer :: n_det_1h_tmp integer, allocatable :: index_generator(:) integer, allocatable :: index_1h1p(:) integer, allocatable :: index_2h1p(:) + integer, allocatable :: index_extra_1h_or_1p(:) + logical :: is_the_hole_in_det allocate(index_1h1p(n_det)) allocate(index_2h1p(n_det)) + allocate(index_extra_1h_or_1p(n_det)) allocate(index_generator(N_det)) n_det_generators_tmp = 0 n_det_1h1p_tmp = 0 n_det_2h1p_tmp = 0 + n_det_extra_1h_or_1p_tmp = 0 + n_det_1h_tmp = 0 do i = 1, n_det n_h = number_of_holes(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i)) @@ -287,6 +662,16 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o else if (n_h ==2 .and. n_p==1)then n_det_2h1p_tmp +=1 index_2h1p(n_det_2h1p_tmp) = i + else if (n_h ==0 .and. n_p==1)then + n_det_extra_1h_or_1p_tmp +=1 + index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i + else if (n_h ==1 .and. n_p==0)then + if(is_the_hole_in_det(psi_det(1,1,i),1,i_hole).or.is_the_hole_in_det(psi_det(1,1,i),2,i_hole))then + n_det_1h_tmp +=1 + else + n_det_extra_1h_or_1p_tmp +=1 + index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i + endif endif do j = 1, N_det_generators call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int) @@ -315,6 +700,12 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o stop endif + if(n_det_extra_1h_or_1p.ne.n_det_extra_1h_or_1p_tmp)then + print*,'PB !!!' + print*,'n_det_extra_1h_or_1p.ne.n_det_extra_1h_or_1p_tmp' + stop + endif + do i = 1,N_det_generators do j = 1, N_int psi_ref_out(j,1,i) = psi_det(j,1,index_generator(i)) @@ -345,41 +736,59 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(n_det_1h1p,n_det_2h1p,psi_ref_o enddo enddo + do i = 1, n_det_extra_1h_or_1p + do j = 1, N_int + psi_extra_1h_or_1p(j,1,i) = psi_det(j,1,index_extra_1h_or_1p(i)) + psi_extra_1h_or_1p(j,2,i) = psi_det(j,2,index_extra_1h_or_1p(i)) + enddo + do j = 1, N_states + psi_coef_extra_1h_or_1p(i,j) = psi_coef(index_extra_1h_or_1p(i),j) + enddo + enddo deallocate(index_generator) deallocate(index_1h1p) deallocate(index_2h1p) + deallocate(index_extra_1h_or_1p) end -subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p) +subroutine split_wf_generators_and_1h1p_and_1h2p(i_particl,n_det_extra_1h_or_1p,n_det_1h1p,n_det_1h2p,psi_ref_out,psi_ref_coef_out,psi_1h1p,psi_coef_1h1p,psi_1h2p,psi_coef_1h2p,psi_extra_1h_or_1p,psi_coef_extra_1h_or_1p) use bitmasks implicit none - integer, intent(in) :: n_det_1h1p,n_det_1h2p + integer, intent(in) :: n_det_1h1p,n_det_1h2p,n_det_extra_1h_or_1p,i_particl integer(bit_kind), intent(out) :: psi_ref_out(N_int,2,N_det_generators) integer(bit_kind), intent(out) :: psi_1h1p(N_int,2,n_det_1h1p) integer(bit_kind), intent(out) :: psi_1h2p(N_int,2,n_det_1h2p) + integer(bit_kind), intent(out) :: psi_extra_1h_or_1p(N_int,2,n_det_extra_1h_or_1p) double precision, intent(out) :: psi_ref_coef_out(N_det_generators,N_states) double precision, intent(out) :: psi_coef_1h1p(n_det_1h1p, N_states) double precision, intent(out) :: psi_coef_1h2p(n_det_1h2p, N_states) + double precision, intent(out) :: psi_coef_extra_1h_or_1p(n_det_extra_1h_or_1p, N_states) integer :: i,j integer :: degree integer :: number_of_holes,n_h, number_of_particles,n_p - integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_1h2p_tmp + integer :: n_det_generators_tmp,n_det_1h1p_tmp,n_det_1h2p_tmp,n_det_extra_1h_or_1p_tmp integer, allocatable :: index_generator(:) integer, allocatable :: index_1h1p(:) integer, allocatable :: index_1h2p(:) + integer, allocatable :: index_extra_1h_or_1p(:) + logical :: is_the_particl_in_det + integer :: n_det_1p_tmp allocate(index_1h1p(n_det)) allocate(index_1h2p(n_det)) + allocate(index_extra_1h_or_1p(n_det)) allocate(index_generator(N_det)) n_det_generators_tmp = 0 n_det_1h1p_tmp = 0 n_det_1h2p_tmp = 0 + n_det_extra_1h_or_1p_tmp = 0 + n_det_1p_tmp = 0 do i = 1, n_det n_h = number_of_holes(psi_det(1,1,i)) n_p = number_of_particles(psi_det(1,1,i)) @@ -389,6 +798,15 @@ subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_o else if (n_h ==1 .and. n_p==2)then n_det_1h2p_tmp +=1 index_1h2p(n_det_1h2p_tmp) = i + else if (n_h ==1 .and. n_p==0)then + n_det_extra_1h_or_1p_tmp +=1 + index_extra_1h_or_1p(n_det_extra_1h_or_1p_tmp) = i + else if (n_h ==0 .and. n_p==1)then + if(is_the_particl_in_det(psi_det(1,1,i),1,i_particl).or.is_the_particl_in_det(psi_det(1,1,i),2,i_particl))then + n_det_1p_tmp +=1 + else + n_det_extra_1h_or_1p_tmp +=1 + endif endif do j = 1, N_det_generators call get_excitation_degree(psi_det_generators(1,1,j),psi_det(1,1,i), degree, N_int) @@ -448,9 +866,20 @@ subroutine split_wf_generators_and_1h1p_and_1h2p(n_det_1h1p,n_det_1h2p,psi_ref_o enddo + do i = 1, n_det_extra_1h_or_1p + do j = 1, N_int + psi_extra_1h_or_1p(j,1,i) = psi_det(j,1,index_extra_1h_or_1p(i)) + psi_extra_1h_or_1p(j,2,i) = psi_det(j,2,index_extra_1h_or_1p(i)) + enddo + do j = 1, N_states + psi_coef_extra_1h_or_1p(i,j) = psi_coef(index_extra_1h_or_1p(i),j) + enddo + enddo + deallocate(index_generator) deallocate(index_1h1p) deallocate(index_1h2p) + deallocate(index_extra_1h_or_1p) end diff --git a/plugins/FOBOCI/routines_foboci.irp.f b/plugins/FOBOCI/routines_foboci.irp.f index 696011a9..4aca60d7 100644 --- a/plugins/FOBOCI/routines_foboci.irp.f +++ b/plugins/FOBOCI/routines_foboci.irp.f @@ -332,20 +332,20 @@ subroutine save_osoci_natural_mos enddo tmp = tmp_bis -!! Symetrization act-virt - do j = 1, n_virt_orb - j_virt= list_virt(j) - accu = 0.d0 - do i = 1, n_act_orb - jorb = list_act(i) - accu += dabs(tmp_bis(j_virt,jorb)) - enddo - do i = 1, n_act_orb - iorb = list_act(i) - tmp(j_virt,iorb) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) - tmp(iorb,j_virt) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) - enddo - enddo +!!! Symetrization act-virt +! do j = 1, n_virt_orb +! j_virt= list_virt(j) +! accu = 0.d0 +! do i = 1, n_act_orb +! jorb = list_act(i) +! accu += dabs(tmp_bis(j_virt,jorb)) +! enddo +! do i = 1, n_act_orb +! iorb = list_act(i) +! tmp(j_virt,iorb) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) +! tmp(iorb,j_virt) = dsign(accu/dble(n_act_orb),tmp_bis(j_virt,iorb)) +! enddo +! enddo !! Symetrization act-inact !do j = 1, n_inact_orb @@ -387,16 +387,16 @@ subroutine save_osoci_natural_mos print*,'ACTIVE ORBITAL ',iorb do j = 1, n_inact_orb jorb = list_inact(j) - if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then + if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then print*,'INACTIVE ' - print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) + print*,'DM ',iorb,jorb,(tmp(iorb,jorb)) endif enddo do j = 1, n_virt_orb jorb = list_virt(j) - if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then + if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then print*,'VIRT ' - print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) + print*,'DM ',iorb,jorb,(tmp(iorb,jorb)) endif enddo enddo @@ -410,8 +410,9 @@ subroutine save_osoci_natural_mos enddo label = "Natural" + call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1) - soft_touch mo_coef +!soft_touch mo_coef deallocate(tmp,occ) @@ -518,16 +519,16 @@ subroutine set_osoci_natural_mos print*,'ACTIVE ORBITAL ',iorb do j = 1, n_inact_orb jorb = list_inact(j) - if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then + if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then print*,'INACTIVE ' - print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) + print*,'DM ',iorb,jorb,(tmp(iorb,jorb)) endif enddo do j = 1, n_virt_orb jorb = list_virt(j) - if(dabs(tmp(iorb,jorb)).gt.threshold_singles)then + if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then print*,'VIRT ' - print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) + print*,'DM ',iorb,jorb,(tmp(iorb,jorb)) endif enddo enddo @@ -602,15 +603,210 @@ end subroutine provide_properties implicit none - integer :: i - double precision :: accu - if(.True.)then - accu= 0.d0 - do i = 1, nucl_num - accu += mulliken_spin_densities(i) - print*,i,nucl_charge(i),mulliken_spin_densities(i) - enddo - print*,'Sum of Mulliken SD = ',accu - endif + call print_mulliken_sd + call print_hcc end + + + subroutine dress_diag_elem_2h1p(dressing_H_mat_elem,ndet,lmct,i_hole) + use bitmasks + double precision, intent(inout) :: dressing_H_mat_elem(Ndet) + integer, intent(in) :: ndet,i_hole + logical, intent(in) :: lmct + ! if lmct = .True. ===> LMCT + ! else ===> MLCT + implicit none + integer :: i + integer :: n_p,n_h,number_of_holes,number_of_particles + integer :: exc(0:2,2,2) + integer :: degree + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2 + do i = 1, N_det + + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + if (n_h == 0.and.n_p==0)then ! CAS + dressing_H_mat_elem(i)+= total_corr_e_2h1p + if(lmct)then + dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(i_hole) - corr_energy_2h1p_per_orb_bb(i_hole) + endif + endif + if (n_h == 1.and.n_p==0)then ! 1h + dressing_H_mat_elem(i)+= 0.d0 + else if (n_h == 0.and.n_p==1)then ! 1p + dressing_H_mat_elem(i)+= total_corr_e_2h1p + dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(p1) - corr_energy_2h1p_per_orb_aa(p1) + else if (n_h == 1.and.n_p==1)then ! 1h1p +! if(degree==1)then + dressing_H_mat_elem(i)+= total_corr_e_2h1p + dressing_H_mat_elem(i)+= - corr_energy_2h1p_per_orb_ab(h1) +! else +! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & +! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) +! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) & +! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2)) +! dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1)) +! endif + else if (n_h == 2.and.n_p==1)then ! 2h1p + dressing_H_mat_elem(i)+= 0.d0 + else if (n_h == 1.and.n_p==2)then ! 1h2p + dressing_H_mat_elem(i)+= total_corr_e_2h1p + dressing_H_mat_elem(i) += - corr_energy_2h1p_per_orb_ab(h1) + endif + enddo + + end + + subroutine dress_diag_elem_1h2p(dressing_H_mat_elem,ndet,lmct,i_hole) + use bitmasks + double precision, intent(inout) :: dressing_H_mat_elem(Ndet) + integer, intent(in) :: ndet,i_hole + logical, intent(in) :: lmct + ! if lmct = .True. ===> LMCT + ! else ===> MLCT + implicit none + integer :: i + integer :: n_p,n_h,number_of_holes,number_of_particles + integer :: exc(0:2,2,2) + integer :: degree + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2 + do i = 1, N_det + + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + if (n_h == 0.and.n_p==0)then ! CAS + dressing_H_mat_elem(i)+= total_corr_e_1h2p + if(.not.lmct)then + dressing_H_mat_elem(i) += - corr_energy_1h2p_per_orb_ab(i_hole) - corr_energy_1h2p_per_orb_aa(i_hole) + endif + endif + if (n_h == 1.and.n_p==0)then ! 1h + dressing_H_mat_elem(i)+= total_corr_e_1h2p - corr_energy_1h2p_per_orb_ab(h1) + else if (n_h == 0.and.n_p==1)then ! 1p + dressing_H_mat_elem(i)+= 0.d0 + else if (n_h == 1.and.n_p==1)then ! 1h1p + if(degree==1)then + dressing_H_mat_elem(i)+= total_corr_e_1h2p + dressing_H_mat_elem(i)+= - corr_energy_1h2p_per_orb_ab(h1) + else + dressing_H_mat_elem(i) +=0.d0 + endif +! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & +! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) +! dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) & +! - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2)) +! dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1)) +! endif + else if (n_h == 2.and.n_p==1)then ! 2h1p + dressing_H_mat_elem(i)+= total_corr_e_1h2p + dressing_H_mat_elem(i)+= - corr_energy_1h2p_per_orb_ab(h1) - corr_energy_1h2p_per_orb_ab(h1) + else if (n_h == 1.and.n_p==2)then ! 1h2p + dressing_H_mat_elem(i) += 0.d0 + endif + enddo + + end + + subroutine dress_diag_elem_2h2p(dressing_H_mat_elem,ndet) + use bitmasks + double precision, intent(inout) :: dressing_H_mat_elem(Ndet) + integer, intent(in) :: ndet + implicit none + integer :: i + integer :: n_p,n_h,number_of_holes,number_of_particles + integer :: exc(0:2,2,2) + integer :: degree + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2 + do i = 1, N_det + dressing_H_mat_elem(i)+= total_corr_e_2h2p + + n_h = number_of_holes(psi_det(1,1,i)) + n_p = number_of_particles(psi_det(1,1,i)) + call get_excitation(ref_bitmask,psi_det(1,1,i),exc,degree,phase,N_int) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + if (n_h == 1.and.n_p==0)then ! 1h + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) + else if (n_h == 0.and.n_p==1)then ! 1p + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1)) + else if (n_h == 1.and.n_p==1)then ! 1h1p + if(degree==1)then + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1)) + dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_a(h1,p1) + corr_energy_2h2p_for_1h1p_b(h1,p1)) + else + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2)) + dressing_H_mat_elem(i) += 0.5d0 * (corr_energy_2h2p_for_1h1p_double(h1,p1)) + endif + else if (n_h == 2.and.n_p==1)then ! 2h1p + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) - corr_energy_2h2p_per_orb_bb(h1) & + - corr_energy_2h2p_per_orb_ab(h2) & + - 0.5d0 * ( corr_energy_2h2p_per_orb_bb(h2) + corr_energy_2h2p_per_orb_bb(h2)) + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) + if(s1.ne.s2)then + dressing_H_mat_elem(i) += corr_energy_2h2p_ab_2_orb(h1,h2) + else + dressing_H_mat_elem(i) += corr_energy_2h2p_bb_2_orb(h1,h2) + endif + else if (n_h == 1.and.n_p==2)then ! 1h2p + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(h1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(h1) + corr_energy_2h2p_per_orb_bb(h1)) + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p1) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p1) + corr_energy_2h2p_per_orb_bb(p1)) + dressing_H_mat_elem(i) += - corr_energy_2h2p_per_orb_ab(p2) & + - 0.5d0 * (corr_energy_2h2p_per_orb_aa(p2) + corr_energy_2h2p_per_orb_bb(p2)) + if(s1.ne.s2)then + dressing_H_mat_elem(i) += corr_energy_2h2p_ab_2_orb(p1,p2) + else + dressing_H_mat_elem(i) += corr_energy_2h2p_bb_2_orb(p1,p2) + endif + endif + enddo + + end + + subroutine diag_dressed_2h2p_hamiltonian_and_update_psi_det(i_hole,lmct) + implicit none + double precision, allocatable :: dressing_H_mat_elem(:),energies(:) + integer, intent(in) :: i_hole + logical, intent(in) :: lmct + ! if lmct = .True. ===> LMCT + ! else ===> MLCT + integer :: i + double precision :: hij + allocate(dressing_H_mat_elem(N_det),energies(N_states_diag)) + print*,'' + print*,'dressing with the 2h2p in a CC logic' + print*,'' + do i = 1, N_det + call i_h_j(psi_det(1,1,i),psi_det(1,1,i),N_int,hij) + dressing_H_mat_elem(i) = hij + enddo + call dress_diag_elem_2h2p(dressing_H_mat_elem,N_det) + call dress_diag_elem_2h1p(dressing_H_mat_elem,N_det,lmct,i_hole) + call dress_diag_elem_1h2p(dressing_H_mat_elem,N_det,lmct,i_hole) + call davidson_diag_hjj(psi_det,psi_coef,dressing_H_mat_elem,energies,size(psi_coef,1),N_det,N_states_diag,N_int,output_determinants) + do i = 1, 2 + print*,'psi_coef = ',psi_coef(i,1) + enddo + + + deallocate(dressing_H_mat_elem) + + + + end 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/Full_CI/micro_pt2.irp.f b/plugins/Full_CI/micro_pt2.irp.f index d78a942d..14cc52bf 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) @@ -33,6 +35,8 @@ subroutine run_wf call provide_everything integer :: rc, i + print *, 'Contribution to PT2 running' + !$OMP PARALLEL PRIVATE(i) i = omp_get_thread_num() call H_apply_FCI_PT2_slave_tcp(i) diff --git a/plugins/Generators_restart/generators.irp.f b/plugins/Generators_restart/generators.irp.f index 0a82e6f9..17854330 100644 --- a/plugins/Generators_restart/generators.irp.f +++ b/plugins/Generators_restart/generators.irp.f @@ -1,5 +1,5 @@ use bitmasks - + BEGIN_PROVIDER [ integer, N_det_generators ] implicit none BEGIN_DOC @@ -8,17 +8,18 @@ BEGIN_PROVIDER [ integer, N_det_generators ] integer :: i integer, save :: ifirst = 0 double precision :: norm - read_wf = .True. if(ifirst == 0)then - N_det_generators = N_det + call ezfio_get_determinants_n_det(N_det_generators) ifirst = 1 + else + print*,'PB in generators restart !!!' endif call write_int(output_determinants,N_det_generators,'Number of generators') END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_generators, (psi_det_size,N_states) ] + BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,N_det_generators) ] +&BEGIN_PROVIDER [ double precision, psi_coef_generators, (N_det_generators,N_states) ] implicit none BEGIN_DOC ! read wf @@ -26,17 +27,20 @@ END_PROVIDER END_DOC integer :: i, k integer, save :: ifirst = 0 + double precision, allocatable :: psi_coef_read(:,:) if(ifirst == 0)then - do i=1,N_det_generators - do k=1,N_int - psi_det_generators(k,1,i) = psi_det(k,1,i) - psi_det_generators(k,2,i) = psi_det(k,2,i) - enddo + call read_dets(psi_det_generators,N_int,N_det_generators) + allocate (psi_coef_read(N_det_generators,N_states)) + call ezfio_get_determinants_psi_coef(psi_coef_read) do k = 1, N_states - psi_coef_generators(i,k) = psi_coef(i,k) + do i = 1, N_det_generators + psi_coef_generators(i,k) = psi_coef_read(i,k) + enddo enddo - enddo ifirst = 1 + deallocate(psi_coef_read) + else + print*,'PB in generators restart !!!' endif END_PROVIDER diff --git a/plugins/Hartree_Fock/damping_SCF.irp.f b/plugins/Hartree_Fock/damping_SCF.irp.f index 6a532b25..d383eb74 100644 --- a/plugins/Hartree_Fock/damping_SCF.irp.f +++ b/plugins/Hartree_Fock/damping_SCF.irp.f @@ -119,7 +119,9 @@ subroutine damping_SCF write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '====' write(output_hartree_fock,*) - call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1) + if(.not.no_oa_or_av_opt)then + call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1) + endif call write_double(output_hartree_fock, E_min, 'Hartree-Fock energy') call ezfio_set_hartree_fock_energy(E_min) 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 57d6d5c1..0a8f55fe 100644 --- a/plugins/MRCC_Utils/H_apply.irp.f +++ b/plugins/MRCC_Utils/H_apply.irp.f @@ -25,7 +25,7 @@ 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() @@ -36,6 +36,11 @@ s.energy = "psi_ref_energy_diagonalized" 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/plugins/Molden/NEEDED_CHILDREN_MODULES b/plugins/Molden/NEEDED_CHILDREN_MODULES index 305dfb78..80d0af12 100644 --- a/plugins/Molden/NEEDED_CHILDREN_MODULES +++ b/plugins/Molden/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -MO_Basis Utils +MO_Basis Utils diff --git a/plugins/Molden/aos.irp.f b/plugins/Molden/aos.irp.f deleted file mode 100644 index 71f8c5b8..00000000 --- a/plugins/Molden/aos.irp.f +++ /dev/null @@ -1,196 +0,0 @@ -BEGIN_PROVIDER [ character*(128), ao_l_char, (ao_num) ] - implicit none - BEGIN_DOC -! ao_l = l value of the AO: a+b+c in x^a y^b z^c - END_DOC - integer :: i - do i=1,ao_num - ao_l_char(i) = l_to_character(ao_l(i)) - enddo -END_PROVIDER - - -BEGIN_PROVIDER [ character*(128), l_to_character, (0:4)] - BEGIN_DOC - ! character corresponding to the "L" value of an AO orbital - END_DOC - implicit none - l_to_character(0)='S' - l_to_character(1)='P' - l_to_character(2)='D' - l_to_character(3)='F' - l_to_character(4)='G' -END_PROVIDER - - BEGIN_PROVIDER [ integer, Nucl_N_Aos, (nucl_num)] -&BEGIN_PROVIDER [ integer, N_AOs_max ] - implicit none - integer :: i - BEGIN_DOC - ! Number of AOs per atom - END_DOC - Nucl_N_Aos = 0 - do i = 1, ao_num - Nucl_N_Aos(ao_nucl(i)) +=1 - enddo - N_AOs_max = maxval(Nucl_N_Aos) -END_PROVIDER - - BEGIN_PROVIDER [ integer, Nucl_Aos, (nucl_num,N_AOs_max)] - implicit none - BEGIN_DOC - ! List of AOs attached on each atom - END_DOC - integer :: i - integer, allocatable :: nucl_tmp(:) - allocate(nucl_tmp(nucl_num)) - nucl_tmp = 0 - Nucl_Aos = 0 - do i = 1, ao_num - nucl_tmp(ao_nucl(i))+=1 - Nucl_Aos(ao_nucl(i),nucl_tmp(ao_nucl(i))) = i - enddo - deallocate(nucl_tmp) -END_PROVIDER - - - BEGIN_PROVIDER [ integer, Nucl_list_shell_Aos, (nucl_num,N_AOs_max)] -&BEGIN_PROVIDER [ integer, Nucl_num_shell_Aos, (nucl_num)] - implicit none - integer :: i,j,k - BEGIN_DOC - ! Index of the shell type Aos and of the corresponding Aos - ! Per convention, for P,D,F and G AOs, we take the index - ! of the AO with the the corresponding power in the "X" axis - END_DOC - do i = 1, nucl_num - Nucl_num_shell_Aos(i) = 0 - - do j = 1, Nucl_N_Aos(i) - if(ao_l(Nucl_Aos(i,j))==0)then - ! S type function - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - elseif(ao_l(Nucl_Aos(i,j))==1)then - ! P type function - if(ao_power(Nucl_Aos(i,j),1)==1)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - elseif(ao_l(Nucl_Aos(i,j))==2)then - ! D type function - if(ao_power(Nucl_Aos(i,j),1)==2)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - elseif(ao_l(Nucl_Aos(i,j))==3)then - ! F type function - if(ao_power(Nucl_Aos(i,j),1)==3)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - elseif(ao_l(Nucl_Aos(i,j))==4)then - ! G type function - if(ao_power(Nucl_Aos(i,j),1)==4)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - endif - - enddo - enddo - -END_PROVIDER - - -BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ] - implicit none - integer :: i - character*(4) :: give_ao_character_space - do i=1,ao_num - - if(ao_l(i)==0)then - ! S type AO - give_ao_character_space = 'S ' - elseif(ao_l(i) == 1)then - ! P type AO - if(ao_power(i,1)==1)then - give_ao_character_space = 'X ' - elseif(ao_power(i,2) == 1)then - give_ao_character_space = 'Y ' - else - give_ao_character_space = 'Z ' - endif - elseif(ao_l(i) == 2)then - ! D type AO - if(ao_power(i,1)==2)then - give_ao_character_space = 'XX ' - elseif(ao_power(i,2) == 2)then - give_ao_character_space = 'YY ' - elseif(ao_power(i,3) == 2)then - give_ao_character_space = 'ZZ ' - elseif(ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'XY ' - elseif(ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'XZ ' - else - give_ao_character_space = 'YZ ' - endif - elseif(ao_l(i) == 3)then - ! F type AO - if(ao_power(i,1)==3)then - give_ao_character_space = 'XXX ' - elseif(ao_power(i,2) == 3)then - give_ao_character_space = 'YYY ' - elseif(ao_power(i,3) == 3)then - give_ao_character_space = 'ZZZ ' - elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'XXY ' - elseif(ao_power(i,1) == 2 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'XXZ ' - elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1)then - give_ao_character_space = 'YYX ' - elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'YYZ ' - elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1)then - give_ao_character_space = 'ZZX ' - elseif(ao_power(i,3) == 2 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'ZZY ' - elseif(ao_power(i,3) == 1 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'XYZ ' - endif - elseif(ao_l(i) == 4)then - ! G type AO - if(ao_power(i,1)==4)then - give_ao_character_space = 'XXXX' - elseif(ao_power(i,2) == 4)then - give_ao_character_space = 'YYYY' - elseif(ao_power(i,3) == 4)then - give_ao_character_space = 'ZZZZ' - elseif(ao_power(i,1) == 3 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'XXXY' - elseif(ao_power(i,1) == 3 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'XXXZ' - elseif(ao_power(i,2) == 3 .and. ao_power(i,1) == 1)then - give_ao_character_space = 'YYYX' - elseif(ao_power(i,2) == 3 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'YYYZ' - elseif(ao_power(i,3) == 3 .and. ao_power(i,1) == 1)then - give_ao_character_space = 'ZZZX' - elseif(ao_power(i,3) == 3 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'ZZZY' - elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 2)then - give_ao_character_space = 'XXYY' - elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 2)then - give_ao_character_space = 'YYZZ' - elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'XXYZ' - elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then - give_ao_character_space = 'YYXZ' - elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then - give_ao_character_space = 'ZZXY' - endif - endif - ao_l_char_space(i) = give_ao_character_space - enddo -END_PROVIDER diff --git a/plugins/Molden/print_mo.irp.f b/plugins/Molden/print_mo.irp.f index b147fe50..6ac51bdb 100644 --- a/plugins/Molden/print_mo.irp.f +++ b/plugins/Molden/print_mo.irp.f @@ -104,6 +104,8 @@ subroutine write_Ao_basis(i_unit_output) write(i_unit_output,*)'' write(i_unit_output,'(A47,2X,I3)')'TOTAL NUMBER OF BASIS SET SHELLS =', i_shell write(i_unit_output,'(A47,2X,I3)')'NUMBER OF CARTESIAN GAUSSIAN BASIS FUNCTIONS =', ao_num +! this is for the new version of molden + write(i_unit_output,'(A12)')'PP =NONE' write(i_unit_output,*)'' @@ -126,7 +128,9 @@ subroutine write_Mo_basis(i_unit_output) write(i_unit_output,'(18X,F8.5)')-1.d0 write(i_unit_output,*)'' do i = 1, ao_num - write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j) +! write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j) +! F12.6 for larger coefficients... + write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F12.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j) ! write(i_unit_output,'(I3, X A1, X I3, X A4 X F16.8)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)) enddo write(i_unit_output,*)'' diff --git a/plugins/Perturbation/pt2_equations.irp.f b/plugins/Perturbation/pt2_equations.irp.f index e990a37c..e406cd03 100644 --- a/plugins/Perturbation/pt2_equations.irp.f +++ b/plugins/Perturbation/pt2_equations.irp.f @@ -125,6 +125,8 @@ subroutine pt2_moller_plesset ($arguments) delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + & (Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2)) delta_e = 1.d0/delta_e +! print*,'h1,p1',h1,p1 +! print*,'h2,p2',h2,p2 else if (degree == 1) then call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) delta_e = Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1) diff --git a/plugins/Properties/hyperfine_constants.irp.f b/plugins/Properties/hyperfine_constants.irp.f index c1d88d2c..e31b3ba4 100644 --- a/plugins/Properties/hyperfine_constants.irp.f +++ b/plugins/Properties/hyperfine_constants.irp.f @@ -133,3 +133,16 @@ END_PROVIDER enddo END_PROVIDER + + +subroutine print_hcc + implicit none + double precision :: accu + integer :: i,j + print*,'Z AU GAUSS MHZ cm^-1' + do i = 1, nucl_num + write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i) + enddo + +end + diff --git a/plugins/Properties/mulliken.irp.f b/plugins/Properties/mulliken.irp.f index d56c9a44..cc0a2f8e 100644 --- a/plugins/Properties/mulliken.irp.f +++ b/plugins/Properties/mulliken.irp.f @@ -105,3 +105,34 @@ END_PROVIDER enddo END_PROVIDER + + +subroutine print_mulliken_sd + implicit none + double precision :: accu + integer :: i + integer :: j + print*,'Mulliken spin densities' + accu= 0.d0 + do i = 1, nucl_num + print*,i,nucl_charge(i),mulliken_spin_densities(i) + accu += mulliken_spin_densities(i) + enddo + print*,'Sum of Mulliken SD = ',accu + print*,'AO SPIN POPULATIONS' + accu = 0.d0 + do i = 1, ao_num + accu += spin_gross_orbital_product(i) + write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i) + enddo + print*,'sum = ',accu + accu = 0.d0 + print*,'Angular momentum analysis' + do i = 0, ao_l_max + accu += spin_population_angular_momentum(i) + print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i) + print*,'sum = ',accu + enddo + +end + diff --git a/plugins/Properties/print_hcc.irp.f b/plugins/Properties/print_hcc.irp.f index f0091e1e..45bca5e6 100644 --- a/plugins/Properties/print_hcc.irp.f +++ b/plugins/Properties/print_hcc.irp.f @@ -1,17 +1,6 @@ -program print_hcc +program print_hcc_main implicit none read_wf = .True. touch read_wf - call test + call print_hcc end -subroutine test - implicit none - double precision :: accu - integer :: i,j - print*,'Z AU GAUSS MHZ cm^-1' - do i = 1, nucl_num - write(*,'(I2,X,F3.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i) - enddo - -end - diff --git a/plugins/Properties/print_mulliken.irp.f b/plugins/Properties/print_mulliken.irp.f index 100c8556..d4be534a 100644 --- a/plugins/Properties/print_mulliken.irp.f +++ b/plugins/Properties/print_mulliken.irp.f @@ -2,34 +2,5 @@ program print_mulliken implicit none read_wf = .True. touch read_wf - print*,'Mulliken spin densities' - - call test + call print_mulliken_sd end -subroutine test - double precision :: accu - integer :: i - integer :: j - accu= 0.d0 - do i = 1, nucl_num - print*,i,nucl_charge(i),mulliken_spin_densities(i) - accu += mulliken_spin_densities(i) - enddo - print*,'Sum of Mulliken SD = ',accu - print*,'AO SPIN POPULATIONS' - accu = 0.d0 - do i = 1, ao_num - accu += spin_gross_orbital_product(i) - write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i) - enddo - print*,'sum = ',accu - accu = 0.d0 - print*,'Angular momentum analysis' - do i = 0, ao_l_max - accu += spin_population_angular_momentum(i) - print*,' ',trim(l_to_charater(i)),spin_population_angular_momentum(i) - print*,'sum = ',accu - enddo - -end - diff --git a/plugins/QmcChem/e_curve_qmc.irp.f b/plugins/QmcChem/e_curve_qmc.irp.f new file mode 100644 index 00000000..4beed3fa --- /dev/null +++ b/plugins/QmcChem/e_curve_qmc.irp.f @@ -0,0 +1,102 @@ +program e_curve + use bitmasks + implicit none + integer :: i,j,k, nab, m, l + double precision :: norm, E, hij, num, ci, cj + integer, allocatable :: iorder(:) + double precision , allocatable :: norm_sort(:) + nab = n_det_alpha_unique+n_det_beta_unique + allocate ( norm_sort(0:nab), iorder(0:nab) ) + + + norm_sort(0) = 0.d0 + iorder(0) = 0 + do i=1,n_det_alpha_unique + norm_sort(i) = det_alpha_norm(i) + iorder(i) = i + enddo + + do i=1,n_det_beta_unique + norm_sort(i+n_det_alpha_unique) = det_beta_norm(i) + iorder(i+n_det_alpha_unique) = -i + enddo + + call dsort(norm_sort(1),iorder(1),nab) + + if (.not.read_wf) then + stop 'Please set read_wf to true' + endif + + PROVIDE psi_bilinear_matrix_values nuclear_repulsion + print *, '' + print *, '==============================' + print *, 'Energies at different cut-offs' + print *, '==============================' + print *, '' + print *, '==========================================================' + print '(A8,2X,A8,2X,A12,2X,A10,2X,A12)', 'Thresh.', 'Ndet', 'Cost', 'Norm', 'E' + print *, '==========================================================' + double precision :: thresh + integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) + thresh = 1.d-10 + do j=0,nab + i = iorder(j) + if (i<0) then + do k=1,n_det + if (psi_bilinear_matrix_columns(k) == -i) then + psi_bilinear_matrix_values(k,1) = 0.d0 + endif + enddo + else + do k=1,n_det + if (psi_bilinear_matrix_rows(k) == i) then + psi_bilinear_matrix_values(k,1) = 0.d0 + endif + enddo + endif + if (thresh > norm_sort(j)) then + cycle + endif + num = 0.d0 + norm = 0.d0 + m = 0 + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num) + allocate( det_i(N_int,2), det_j(N_int,2)) + !$OMP DO SCHEDULE(guided) + do k=1,n_det + if (psi_bilinear_matrix_values(k,1) == 0.d0) then + cycle + endif + ci = psi_bilinear_matrix_values(k,1) + det_i(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(k)) + det_i(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(k)) + do l=1,n_det + if (psi_bilinear_matrix_values(l,1) == 0.d0) then + cycle + endif + cj = psi_bilinear_matrix_values(l,1) + det_j(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(l)) + det_j(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(l)) + call i_h_j(det_i, det_j, N_int, hij) + num = num + ci*cj*hij + enddo + norm = norm + ci*ci + m = m+1 + enddo + !$OMP END DO + deallocate (det_i,det_j) + !$OMP END PARALLEL + if (m == 0) then + exit + endif + E = num / norm + nuclear_repulsion + print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F12.6)', thresh, m, & + dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / & + dble( elec_alpha_num**3 + elec_alpha_num**2 * (j-1)), norm, E + thresh = thresh * 2.d0 + enddo + print *, '==========================================================' + + deallocate (iorder, norm_sort) +end + diff --git a/plugins/QmcChem/save_for_qmcchem.irp.f b/plugins/QmcChem/save_for_qmcchem.irp.f index c8ddb4d9..a281a184 100644 --- a/plugins/QmcChem/save_for_qmcchem.irp.f +++ b/plugins/QmcChem/save_for_qmcchem.irp.f @@ -1,9 +1,46 @@ program save_for_qmc - read_wf = .True. - TOUCH read_wf - print *, "N_det = ", N_det - call write_spindeterminants - if (do_pseudo) then - call write_pseudopotential - endif + + integer :: iunit + integer, external :: get_unit_and_open + logical :: exists + double precision :: e_ref + + ! Determinants + read_wf = .True. + TOUCH read_wf + print *, "N_det = ", N_det + call write_spindeterminants + + ! Reference Energy + if (do_pseudo) then + call write_pseudopotential + endif + call system( & + 'mkdir -p '//trim(ezfio_filename)//'/simulation ;' // & + 'cp '//trim(ezfio_filename)//'/.version '//trim(ezfio_filename)//'/simulation/.version ; ' // & + 'mkdir -p '//trim(ezfio_filename)//'/properties ;' // & + 'cp '//trim(ezfio_filename)//'/.version '//trim(ezfio_filename)//'/properties/.version ; ' // & + 'echo T > '//trim(ezfio_filename)//'/properties/e_loc' & + ) + iunit = 13 + open(unit=iunit,file=trim(ezfio_filename)//'/simulation/e_ref',action='write') + call ezfio_has_full_ci_energy_pt2(exists) + if (exists) then + call ezfio_get_full_ci_energy_pt2(e_ref) + else + call ezfio_has_full_ci_energy(exists) + if (exists) then + call ezfio_get_full_ci_energy(e_ref) + else + call ezfio_has_hartree_fock_energy(exists) + if (exists) then + call ezfio_get_hartree_fock_energy(e_ref) + else + e_ref = 0.d0 + endif + endif + endif + write(iunit,*) e_ref + close(iunit) + end diff --git a/plugins/loc_cele/loc.f b/plugins/loc_cele/loc.f index 575932a3..edc3aa7a 100644 --- a/plugins/loc_cele/loc.f +++ b/plugins/loc_cele/loc.f @@ -17,9 +17,11 @@ C data small/1.d-6/ zprt=.true. - niter=500 + niter=1000000 conv=1.d-8 +C niter=1000000 +C conv=1.d-6 write (6,5) n,m,conv 5 format (//5x,'Unitary transformation of',i3,' vectors'/ * 5x,'following the principle of maximum overlap with a set of', diff --git a/plugins/loc_cele/loc_cele.irp.f b/plugins/loc_cele/loc_cele.irp.f index e9c26f9d..c9036aa1 100644 --- a/plugins/loc_cele/loc_cele.irp.f +++ b/plugins/loc_cele/loc_cele.irp.f @@ -92,13 +92,182 @@ - nrot(1) = 6 ! number of orbitals to be localized + nrot(1) = 64 ! number of orbitals to be localized integer :: index_rot(1000,1) cmoref = 0.d0 + irot = 0 + +! H2 molecule for the mixed localization + do i=1,64 + irot(i,1) = i+2 + enddo + + do i=1,17 + cmoref(i+1,i,1)=1.d0 + enddo + cmoref(19,19-1,1)=1.d0 + cmoref(20,19-1,1)=-1.d0 + cmoref(19,20-1,1)=-1.d0 + cmoref(20,20-1,1)=-1.d0 + cmoref(21,20-1,1)=2.d0 + cmoref(22,21-1,1)=1.d0 + cmoref(23,22-1,1)=1.d0 + cmoref(24,23-1,1)=1.d0 + + + cmoref(25,24-1,1)=1.d0 + cmoref(26,24-1,1)=-1.d0 + cmoref(25,25-1,1)=-1.d0 + cmoref(26,25-1,1)=-1.d0 + cmoref(27,25-1,1)=2.d0 + cmoref(28,26-1,1)=1.d0 + cmoref(29,27-1,1)=1.d0 + cmoref(30,28-1,1)=1.d0 + + cmoref(31,29-1,1)=1.d0 + cmoref(32,29-1,1)=-1.d0 + cmoref(31,30-1,1)=-1.d0 + cmoref(32,30-1,1)=-1.d0 + cmoref(33,30-1,1)=2.d0 + cmoref(34,31-1,1)=1.d0 + cmoref(35,32-1,1)=1.d0 + cmoref(36,33-1,1)=1.d0 + + do i=33,49 + cmoref(i+5,i,1)= 1.d0 + enddo + + cmoref(55,52-2,1)=1.d0 + cmoref(56,52-2,1)=-1.d0 + cmoref(55,53-2,1)=-1.d0 + cmoref(56,53-2,1)=-1.d0 + cmoref(57,53-2,1)=2.d0 + cmoref(58,54-2,1)=1.d0 + cmoref(59,55-2,1)=1.d0 + cmoref(60,56-2,1)=1.d0 + + cmoref(61,57-2,1)=1.d0 + cmoref(62,57-2,1)=-1.d0 + cmoref(61,58-2,1)=-1.d0 + cmoref(62,58-2,1)=-1.d0 + cmoref(63,58-2,1)=2.d0 + cmoref(64,59-2,1)=1.d0 + cmoref(65,60-2,1)=1.d0 + cmoref(66,61-2,1)=1.d0 + + cmoref(67,62-2,1)=1.d0 + cmoref(68,62-2,1)=-1.d0 + cmoref(67,63-2,1)=-1.d0 + cmoref(68,63-2,1)=-1.d0 + cmoref(69,63-2,1)=2.d0 + cmoref(70,64-2,1)=1.d0 + cmoref(71,65-2,1)=1.d0 + cmoref(72,66-2,1)=1.d0 +! H2 molecule +! do i=1,66 +! irot(i,1) = i +! enddo +! +! do i=1,18 +! cmoref(i,i,1)=1.d0 +! enddo +! cmoref(19,19,1)=1.d0 +! cmoref(20,19,1)=-1.d0 +! cmoref(19,20,1)=-1.d0 +! cmoref(20,20,1)=-1.d0 +! cmoref(21,20,1)=2.d0 +! cmoref(22,21,1)=1.d0 +! cmoref(23,22,1)=1.d0 +! cmoref(24,23,1)=1.d0 +! +! +! cmoref(25,24,1)=1.d0 +! cmoref(26,24,1)=-1.d0 +! cmoref(25,25,1)=-1.d0 +! cmoref(26,25,1)=-1.d0 +! cmoref(27,25,1)=2.d0 +! cmoref(28,26,1)=1.d0 +! cmoref(29,27,1)=1.d0 +! cmoref(30,28,1)=1.d0 +! +! cmoref(31,29,1)=1.d0 +! cmoref(32,29,1)=-1.d0 +! cmoref(31,30,1)=-1.d0 +! cmoref(32,30,1)=-1.d0 +! cmoref(33,30,1)=2.d0 +! cmoref(34,31,1)=1.d0 +! cmoref(35,32,1)=1.d0 +! cmoref(36,33,1)=1.d0 +! +! do i=34,51 +! cmoref(i+3,i,1)= 1.d0 +! enddo +! +! cmoref(55,52,1)=1.d0 +! cmoref(56,52,1)=-1.d0 +! cmoref(55,53,1)=-1.d0 +! cmoref(56,53,1)=-1.d0 +! cmoref(57,53,1)=2.d0 +! cmoref(58,54,1)=1.d0 +! cmoref(59,55,1)=1.d0 +! cmoref(60,56,1)=1.d0 +! +! cmoref(61,57,1)=1.d0 +! cmoref(62,57,1)=-1.d0 +! cmoref(61,58,1)=-1.d0 +! cmoref(62,58,1)=-1.d0 +! cmoref(63,58,1)=2.d0 +! cmoref(64,59,1)=1.d0 +! cmoref(65,60,1)=1.d0 +! cmoref(66,61,1)=1.d0 +! +! cmoref(67,62,1)=1.d0 +! cmoref(68,62,1)=-1.d0 +! cmoref(67,63,1)=-1.d0 +! cmoref(68,63,1)=-1.d0 +! cmoref(69,63,1)=2.d0 +! cmoref(70,64,1)=1.d0 +! cmoref(71,65,1)=1.d0 +! cmoref(72,66,1)=1.d0 +! H atom +! do i=1,33 +! irot(i,1) = i +! enddo +! +! do i=1,18 +! cmoref(i,i,1)=1.d0 +! enddo +! cmoref(19,19,1)=1.d0 +! cmoref(20,19,1)=-1.d0 +! cmoref(19,20,1)=-1.d0 +! cmoref(20,20,1)=-1.d0 +! cmoref(21,20,1)=2.d0 +! cmoref(22,21,1)=1.d0 +! cmoref(23,22,1)=1.d0 +! cmoref(24,23,1)=1.d0 + + +! cmoref(25,24,1)=1.d0 +! cmoref(26,24,1)=-1.d0 +! cmoref(25,25,1)=-1.d0 +! cmoref(26,25,1)=-1.d0 +! cmoref(27,25,1)=2.d0 +! cmoref(28,26,1)=1.d0 +! cmoref(29,27,1)=1.d0 +! cmoref(30,28,1)=1.d0 +! +! cmoref(31,29,1)=1.d0 +! cmoref(32,29,1)=-1.d0 +! cmoref(31,30,1)=-1.d0 +! cmoref(32,30,1)=-1.d0 +! cmoref(33,30,1)=2.d0 +! cmoref(34,31,1)=1.d0 +! cmoref(35,32,1)=1.d0 +! cmoref(36,33,1)=1.d0 ! Definition of the index of the MO to be rotated ! irot(2,1) = 21 ! the first mo to be rotated is the 21 th MO @@ -106,25 +275,67 @@ ! irot(4,1) = 23 ! ! irot(5,1) = 24 ! ! irot(6,1) = 25 ! -! do i = 1,12 -! irot(i,1) = i+6 -! enddo - irot(1,1) = 5 - irot(2,1) = 6 - irot(3,1) = 7 - irot(4,1) = 8 - irot(5,1) = 9 - irot(6,1) = 10 + +!N2 +! irot(1,1) = 5 +! irot(2,1) = 6 +! irot(3,1) = 7 +! irot(4,1) = 8 +! irot(5,1) = 9 +! irot(6,1) = 10 +! +! cmoref(5,1,1) = 1.d0 ! +! cmoref(6,2,1) = 1.d0 ! +! cmoref(7,3,1) = 1.d0 ! +! cmoref(40,4,1) = 1.d0 ! +! cmoref(41,5,1) = 1.d0 ! +! cmoref(42,6,1) = 1.d0 ! +!END N2 + +!HEXATRIENE +! irot(1,1) = 20 +! irot(2,1) = 21 +! irot(3,1) = 22 +! irot(4,1) = 23 +! irot(5,1) = 24 +! irot(6,1) = 25 +! +! cmoref(7,1,1) = 1.d0 ! +! cmoref(26,1,1) = 1.d0 ! +! cmoref(45,2,1) = 1.d0 ! +! cmoref(64,2,1) = 1.d0 ! +! cmoref(83,3,1) = 1.d0 ! +! cmoref(102,3,1) = 1.d0 ! +! cmoref(7,4,1) = 1.d0 ! +! cmoref(26,4,1) = -1.d0 ! +! cmoref(45,5,1) = 1.d0 ! +! cmoref(64,5,1) = -1.d0 ! +! cmoref(83,6,1) = 1.d0 ! +! cmoref(102,6,1) = -1.d0 ! +!END HEXATRIENE + +!!!!H2 H2 CAS +! irot(1,1) = 1 +! irot(2,1) = 2 +! +! cmoref(1,1,1) = 1.d0 +! cmoref(37,2,1) = 1.d0 +!END H2 +!!!! LOCALIZATION ON THE BASIS FUNCTIONS +! do i = 1, nrot(1) +! irot(i,1) = i +! cmoref(i,i,1) = 1.d0 +! enddo + +!END BASISLOC + +! do i = 1, nrot(1) +! irot(i,1) = 4+i +! enddo do i = 1, nrot(1) print*,'irot(i,1) = ',irot(i,1) enddo - pause - cmoref(4,1,1) = 1.d0 ! 2S function - cmoref(5,2,1) = 1.d0 ! 2S function - cmoref(6,3,1) = 1.d0 ! 2S function - cmoref(19,4,1) = 1.d0 ! 2S function - cmoref(20,5,1) = 1.d0 ! 2S function - cmoref(21,6,1) = 1.d0 ! 2S function +! pause ! you define the guess vectors that you want ! the new MO to be close to @@ -138,233 +349,21 @@ ! own guess vectors for the MOs ! The new MOs are provided in output ! in the same order than the guess MOs - - ! C-C bonds - ! 1-2 -! i_atom = 1 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,1,1) = -0.012d0 ! 2S function -! cmoref(2+shift,1,1) = 0.18d0 ! -! cmoref(3+shift,1,1) = 0.1d0 ! - -! cmoref(5+shift,1,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,1,1) = -0.1d0 ! 2pZ function - -! i_atom = 2 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,1,1) = -0.012d0 ! 2S function -! cmoref(2+shift,1,1) = 0.18d0 ! -! cmoref(3+shift,1,1) = 0.1d0 ! - -! cmoref(5+shift,1,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,1,1) = 0.1d0 ! 2pZ function - - -! ! 1-3 -! i_atom = 1 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,2,1) = -0.012d0 ! 2S function -! cmoref(2+shift,2,1) = 0.18d0 ! -! cmoref(3+shift,2,1) = 0.1d0 ! - -! cmoref(5+shift,2,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,2,1) = -0.1d0 ! 2pZ function - -! i_atom = 3 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,2,1) = -0.012d0 ! 2S function -! cmoref(2+shift,2,1) = 0.18d0 ! -! cmoref(3+shift,2,1) = 0.1d0 ! - -! cmoref(5+shift,2,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,2,1) = 0.1d0 ! 2pZ function - -! ! 4-6 -! i_atom = 4 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,3,1) = -0.012d0 ! 2S function -! cmoref(2+shift,3,1) = 0.18d0 ! -! cmoref(3+shift,3,1) = 0.1d0 ! - -! cmoref(5+shift,3,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,3,1) = -0.1d0 ! 2pZ function - -! i_atom = 6 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,3,1) = -0.012d0 ! 2S function -! cmoref(2+shift,3,1) = 0.18d0 ! -! cmoref(3+shift,3,1) = 0.1d0 ! - -! cmoref(5+shift,3,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,3,1) = 0.1d0 ! 2pZ function - - -! ! 6-5 -! i_atom = 6 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,4,1) = -0.012d0 ! 2S function -! cmoref(2+shift,4,1) = 0.18d0 ! -! cmoref(3+shift,4,1) = 0.1d0 ! - -! cmoref(5+shift,4,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,4,1) = 0.1d0 ! 2pZ function - -! i_atom = 5 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,4,1) = -0.012d0 ! 2S function -! cmoref(2+shift,4,1) = 0.18d0 ! -! cmoref(3+shift,4,1) = 0.1d0 ! - -! cmoref(5+shift,4,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,4,1) = -0.1d0 ! 2pZ function - - -! ! 2-4 -! i_atom = 2 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,5,1) = -0.012d0 ! 2S function -! cmoref(2+shift,5,1) = 0.18d0 ! -! cmoref(3+shift,5,1) = 0.1d0 ! - -! cmoref(6+shift,5,1) = 0.1d0 ! 2pZ function - -! i_atom = 4 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,5,1) = -0.012d0 ! 2S function -! cmoref(2+shift,5,1) = 0.18d0 ! -! cmoref(3+shift,5,1) = 0.1d0 ! - -! cmoref(6+shift,5,1) = -0.1d0 ! 2pZ function - - -! ! 3-5 -! i_atom = 3 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,6,1) = -0.012d0 ! 2S function -! cmoref(2+shift,6,1) = 0.18d0 ! -! cmoref(3+shift,6,1) = 0.1d0 ! - -! cmoref(6+shift,6,1) = 0.1d0 ! 2pZ function - -! i_atom = 5 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,6,1) = -0.012d0 ! 2S function -! cmoref(2+shift,6,1) = 0.18d0 ! -! cmoref(3+shift,6,1) = 0.1d0 ! - -! cmoref(6+shift,6,1) = -0.1d0 ! 2pZ function - -! ! C-H bonds -! ! 2-7 -! i_atom = 2 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,7,1) = -0.012d0 ! 2S function -! cmoref(2+shift,7,1) = 0.18d0 ! -! cmoref(3+shift,7,1) = 0.1d0 ! - -! cmoref(5+shift,7,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,7,1) = 0.1d0 ! 2pZ function -! -! i_atom = 7 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,7,1) = 0.12d0 ! 1S function - -! ! 4-10 -! i_atom = 4 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,8,1) = -0.012d0 ! 2S function -! cmoref(2+shift,8,1) = 0.18d0 ! -! cmoref(3+shift,8,1) = 0.1d0 ! - -! cmoref(5+shift,8,1) = -0.1d0 ! 2pX function -! cmoref(6+shift,8,1) = -0.1d0 ! 2pZ function -! -! i_atom = 10 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,8,1) = 0.12d0 ! 1S function - -! ! 5-11 -! i_atom = 5 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,9,1) = -0.012d0 ! 2S function -! cmoref(2+shift,9,1) = 0.18d0 ! -! cmoref(3+shift,9,1) = 0.1d0 ! - -! cmoref(5+shift,9,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,9,1) = -0.1d0 ! 2pZ function -! -! i_atom = 11 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,9,1) = 0.12d0 ! 1S function - -! ! 3-8 -! i_atom = 3 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,10,1) = -0.012d0 ! 2S function -! cmoref(2+shift,10,1) = 0.18d0 ! -! cmoref(3+shift,10,1) = 0.1d0 ! -! -! cmoref(5+shift,10,1) = 0.1d0 ! 2pX function -! cmoref(6+shift,10,1) = 0.1d0 ! 2pZ function -! -! i_atom = 8 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,10,1) = 0.12d0 ! 1S function - -! ! 1-9 -! i_atom = 1 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,11,1) = -0.012d0 ! 2S function -! cmoref(2+shift,11,1) = 0.18d0 ! -! cmoref(3+shift,11,1) = 0.1d0 ! -! -! cmoref(6+shift,11,1) = 0.1d0 ! 2pZ function - -! i_atom = 9 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,11,1) = 0.12d0 ! 1S function - -! -! ! 6-12 -! i_atom = 6 -! shift = (i_atom -1) * 15 -! cmoref(1+shift,12,1) = -0.012d0 ! 2S function -! cmoref(2+shift,12,1) = 0.18d0 ! -! cmoref(3+shift,12,1) = 0.1d0 ! -! -! cmoref(6+shift,12,1) = -0.1d0 ! 2pZ function - -! i_atom = 12 -! shift_h = (6-1) * 15 + (i_atom - 6)*5 -! cmoref(1+shift_h,12,1) = 0.12d0 ! 1S function -! cmoref(12,1,1) = 1.d0 ! - -! cmoref(21,2,1) = 1.d0 ! -! cmoref(30,2,1) = 1.d0 ! - -! cmoref(39,3,1) = 1.d0 ! -! cmoref(48,3,1) = 1.d0 ! - -! cmoref(3,4,1) = 1.d0 ! -! cmoref(12,4,1) =-1.d0 ! - -! cmoref(21,5,1) = 1.d0 ! -! cmoref(30,5,1) =-1.d0 ! - -! cmoref(39,6,1) = 1.d0 ! -! cmoref(48,6,1) =-1.d0 ! +! do i = 1, nrot(1) +! j = 5+(i-1)*15 +! cmoref(j,i,1) = 0.2d0 +! cmoref(j+3,i,1) = 0.12d0 +! print*,'j = ',j +! enddo +! pause print*,'passed the definition of the referent vectors ' - !Building the S (overlap) matrix in the AO basis. - - - do i = 1, ao_num - do j = 1, ao_num - s(i,j,1) = ao_overlap(i,j) + do j =1, ao_num + s(i,j,1) = ao_overlap(i,j) enddo enddo !Now big loop over symmetry @@ -398,20 +397,13 @@ ! do i=1,nmo(isym) - do i=1,ao_num - do j=1,nrot(isym) - - ddum(i,j)=0.d0 - - do k=1,ao_num - - ddum(i,j)=ddum(i,j)+s(i,k,isym)*cmo(k,irot(j,isym),isym) - - enddo - - enddo - + do i=1,ao_num + ddum(i,j)=0.d0 + do k=1,ao_num + ddum(i,j)=ddum(i,j)+s(i,k,isym)*cmo(k,irot(j,isym),isym) + enddo + enddo enddo @@ -441,7 +433,7 @@ do i=1,nrot(isym) do j=1,ao_num - write (6,*) 'isym,',isym,nrot(isym),nmo(isym) +! write (6,*) 'isym,',isym,nrot(isym),nmo(isym) newcmo(j,irot(i,isym),isym)=0.d0 do k=1,nrot(isym) newcmo(j,irot(i,isym),isym)=newcmo(j,irot(i,isym),isym) + cmo(j,irot(k,isym),isym)*t(k,i) @@ -459,7 +451,7 @@ enddo !big loop over symmetry - 10 format (4E20.12) + 10 format (4E18.12) ! Now we copyt the newcmo into the mo_coef @@ -472,9 +464,7 @@ enddo enddo enddo -! if(dabs(newcmo(3,19,1) - mo_coef(3,19)) .gt.1.d-10 )then - print*,'mo_coef(3,19)',mo_coef(3,19) - pause +! pause ! we say that it hase been touched, and valid and that everything that diff --git a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py index 0dc99029..e911af28 100755 --- a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py +++ b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py @@ -183,6 +183,9 @@ def get_nb_permutation(str_): def order_l_l_sym(l_l_sym): + + l_order_mo = [i for i,_ in enumerate(l_l_sym)] + n = 1 for i in range(len(l_l_sym)): if n != 1: @@ -192,11 +195,11 @@ def order_l_l_sym(l_l_sym): l = l_l_sym[i] n = get_nb_permutation(l[2]) - l_l_sym[i:i + n] = sorted(l_l_sym[i:i + n], - key=lambda x: x[2], - cmp=compare_gamess_style) + l_l_sym[i:i + n], l_order_mo[i:i+n] = zip(*sorted(zip(l_l_sym[i:i + n],l_order_mo[i:i+n]), + key=lambda x: x[0][2], + cmp=compare_gamess_style)) - return l_l_sym + return l_l_sym, l_order_mo #========================== @@ -205,8 +208,13 @@ def order_l_l_sym(l_l_sym): l_sym_without_header = sym_raw.split("\n")[3:-2] l_l_sym_raw = [i.split() for i in l_sym_without_header] +print len(l_l_sym_raw) + l_l_sym_expend_sym = expend_sym_l(l_l_sym_raw) -l_l_sym_ordered = order_l_l_sym(l_l_sym_expend_sym) +print len(l_l_sym_expend_sym) + +l_l_sym_ordered, l_order_mo = order_l_l_sym(l_l_sym_expend_sym) + #======== #MO COEF @@ -256,7 +264,7 @@ def print_mo_coef(mo_coef_block, l_l_sym): i_a = int(l[1]) - 1 sym = l[2] - print l_label[i_a], sym, " ".join('{: 3.8f}'.format(i) + print l_label[i_a], sym, " ".join('{0: 3.8f}'.format(i) for i in a[i]) if i_block != nb_block - 1: @@ -348,6 +356,7 @@ d_rep={"+":"1","-":"0"} det_without_header = det_raw[pos+2::] + for line_raw in det_without_header.split("\n"): line = line_raw @@ -355,8 +364,14 @@ for line_raw in det_without_header.split("\n"): try: float(line) except ValueError: + + print line_raw.strip(), len(line_raw.strip()) + print l_order_mo, len(l_order_mo) + + line_order = [line_raw[i] for i in l_order_mo] line= "".join([d_rep[x] if x in d_rep else x for x in line_raw]) print line.strip() print "END_DET" + diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index adcfb6f7..cc1c8aa8 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -37,7 +37,7 @@ from qp_path import QP_ROOT, QP_SRC, QP_EZFIO LIB = "" # join(QP_ROOT, "lib", "rdtsc.o") EZFIO_LIB = join(QP_ROOT, "lib", "libezfio_irp.a") -ZMQ_LIB = join(QP_ROOT, "lib", "libf77zmq.a") + " " + join(QP_ROOT, "lib", "libzmq.a") + " -lstdc++ -lrt" +ZMQ_LIB = join(QP_ROOT, "lib", "libf77zmq.a") + " " + join(QP_ROOT, "lib", "libzmq.a") + " -lstdc++ -lrt" ROOT_BUILD_NINJA = join(QP_ROOT, "config", "build.ninja") header = r"""# @@ -96,7 +96,8 @@ def ninja_create_env_variable(pwd_config_file): l_string.append(str_) lib_lapack = get_compilation_option(pwd_config_file, "LAPACK_LIB") - l_string.append("LIB = {0} {1} {2} {3}".format(LIB, lib_lapack, EZFIO_LIB, ZMQ_LIB)) + str_lib = " ".join([LIB, lib_lapack, EZFIO_LIB, ZMQ_LIB]) + l_string.append("LIB = {0} ".format(str_lib)) l_string.append("") @@ -387,6 +388,8 @@ def get_l_file_for_module(path_module): l_src.append(f) obj = '{0}.o'.format(os.path.splitext(f)[0]) l_obj.append(obj) + elif f.lower().endswith(".o"): + l_obj.append(join(path_module.abs, f)) elif f == "EZFIO.cfg": l_depend.append(join(path_module.abs, "ezfio_interface.irp.f")) 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..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,20 +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 self.type in self.write_correspondance: - write = self.write_correspondance[self.type] - output = self.output - name = self.name + if "size" in self.__dict__: + return + 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/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 408ca3f7..9c7a1386 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -6,7 +6,7 @@ open Core.Std;; WARNING This file is autogenerad by -`${{QP_ROOT}}/script/ezfio_interface/ei_handler.py` +`${{QP_ROOT}}/scripts/ezfio_interface/ei_handler.py` *) @@ -120,7 +120,7 @@ let set str s = | Nuclei -> write Nuclei.(of_rst, write) s | Ao_basis -> () (* TODO *) | Mo_basis -> () (* TODO *) - end + end ;; @@ -169,7 +169,9 @@ let run check_only ezfio_filename = in (* Create the temp file *) - let temp_filename = create_temp_file ezfio_filename tasks in + let temp_filename = + create_temp_file ezfio_filename tasks + in (* Open the temp file with external editor *) let editor = @@ -193,7 +195,7 @@ let run check_only ezfio_filename = List.iter ~f:(fun x -> set temp_string x) tasks; (* Remove temp_file *) - Sys.remove temp_filename; + Sys.remove temp_filename ;; diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 436f092d..ae0064cf 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -8,11 +8,22 @@ copy_buffer declarations decls_main deinit_thread -do_double_excitations +skip +init_main +filter_integrals +filter2p +filter2h2p_double +filter2h2p_single filter1h filter1p -filter2h2p -filter2p +only_2p_single +only_2p_double +filter_only_1h1p_single +filter_only_1h1p_double +filter_only_1h2p_single +filter_only_1h2p_double +filter_only_2h2p_single +filter_only_2h2p_double filterhole filter_integrals filter_only_1h1p_double @@ -182,7 +193,7 @@ class H_apply(object): if (is_a_2p(hole)) cycle """ def filter_1p(self): - self["filter0p"] = """ + self["filter1p"] = """ ! ! DIR$ FORCEINLINE if (is_a_1p(hole)) cycle """ @@ -208,6 +219,27 @@ class H_apply(object): if (is_a_1h1p(key).eqv..False.) cycle """ + def filter_only_2h2p(self): + self["filter_only_2h2p_single"] = """ +! ! DIR$ FORCEINLINE + if (is_a_two_holes_two_particles(hole).eqv..False.) cycle + """ + self["filter_only_1h1p_double"] = """ +! ! DIR$ FORCEINLINE + if (is_a_two_holes_two_particles(key).eqv..False.) cycle + """ + + + def filter_only_1h2p(self): + self["filter_only_1h2p_single"] = """ +! ! DIR$ FORCEINLINE + if (is_a_1h2p(hole).eqv..False.) cycle + """ + self["filter_only_1h2p_double"] = """ +! ! DIR$ FORCEINLINE + if (is_a_1h2p(key).eqv..False.) cycle + """ + def unset_skip(self): self["skip"] = """ @@ -215,9 +247,12 @@ class H_apply(object): def set_filter_2h_2p(self): - self["filter2h2p"] = """ + self["filter2h2p_double"] = """ if (is_a_two_holes_two_particles(key)) cycle """ + self["filter2h2p_single"] = """ + if (is_a_two_holes_two_particles(hole)) cycle + """ def set_perturbation(self,pert): @@ -248,13 +283,13 @@ class H_apply(object): """ self.data["deinit_thread"] = """ - !$ call omp_set_lock(lck) + ! OMP CRITICAL do k=1,N_st sum_e_2_pert_in(k) = sum_e_2_pert_in(k) + sum_e_2_pert(k) sum_norm_pert_in(k) = sum_norm_pert_in(k) + sum_norm_pert(k) sum_H_pert_diag_in(k) = sum_H_pert_diag_in(k) + sum_H_pert_diag(k) enddo - !$ call omp_unset_lock(lck) + ! OMP END CRITICAL deallocate (e_2_pert_buffer, coef_pert_buffer) """ self.data["size_max"] = "8192" @@ -356,12 +391,12 @@ class H_apply(object): self.data["skip"] = """ if (i_generator < size_select_max) then if (select_max(i_generator) < selection_criterion_min*selection_criterion_factor) then - !$ call omp_set_lock(lck) + ! OMP CRITICAL do k=1,N_st norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k) pt2_old(k) = 0.d0 enddo - !$ call omp_unset_lock(lck) + ! OMP END CRITICAL cycle endif select_max(i_generator) = 0.d0 @@ -401,7 +436,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 +460,4 @@ class H_apply_zmq(H_apply): select_max(i_generator) = 0.d0 endif """ + diff --git a/src/AO_Basis/aos.irp.f b/src/AO_Basis/aos.irp.f index aa805093..8d420b15 100644 --- a/src/AO_Basis/aos.irp.f +++ b/src/AO_Basis/aos.irp.f @@ -25,7 +25,7 @@ END_PROVIDER BEGIN_DOC ! Coefficients including the AO normalization END_DOC - double precision :: norm, norm2,overlap_x,overlap_y,overlap_z,C_A(3), c + double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c integer :: l, powA(3), nz integer :: i,j,k nz=100 @@ -34,9 +34,11 @@ END_PROVIDER C_A(3) = 0.d0 ao_coef_normalized = 0.d0 do i=1,ao_num + powA(1) = ao_power(i,1) powA(2) = ao_power(i,2) powA(3) = ao_power(i,3) + do j=1,ao_prim_num(i) call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz) ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm) @@ -51,8 +53,42 @@ END_PROVIDER enddo ao_coef_normalization_factor(i) = 1.d0/sqrt(norm) enddo + END_PROVIDER +BEGIN_PROVIDER [ double precision, ao_coef_normalization_libint_factor, (ao_num) ] + implicit none + BEGIN_DOC + ! Coefficients including the AO normalization + END_DOC + double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c + integer :: l, powA(3), nz + integer :: i,j,k + nz=100 + C_A(1) = 0.d0 + C_A(2) = 0.d0 + C_A(3) = 0.d0 + + do i=1,ao_num + powA(1) = ao_l(i) + powA(2) = 0 + powA(3) = 0 + + ! Normalization of the contracted basis functions + norm = 0.d0 + do j=1,ao_prim_num(i) + do k=1,ao_prim_num(i) + call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz) + norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k) + enddo + enddo + ao_coef_normalization_libint_factor(i) = ao_coef_normalization_factor(i) * sqrt(norm) + + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered, (ao_num_align,ao_prim_num_max) ] &BEGIN_PROVIDER [ double precision, ao_expo_ordered, (ao_num_align,ao_prim_num_max) ] implicit none @@ -170,3 +206,176 @@ BEGIN_PROVIDER [ character*(128), l_to_charater, (0:4)] l_to_charater(4)='G' END_PROVIDER + + BEGIN_PROVIDER [ integer, Nucl_N_Aos, (nucl_num)] +&BEGIN_PROVIDER [ integer, N_AOs_max ] + implicit none + integer :: i + BEGIN_DOC + ! Number of AOs per atom + END_DOC + Nucl_N_Aos = 0 + do i = 1, ao_num + Nucl_N_Aos(ao_nucl(i)) +=1 + enddo + N_AOs_max = maxval(Nucl_N_Aos) +END_PROVIDER + + BEGIN_PROVIDER [ integer, Nucl_Aos, (nucl_num,N_AOs_max)] + implicit none + BEGIN_DOC + ! List of AOs attached on each atom + END_DOC + integer :: i + integer, allocatable :: nucl_tmp(:) + allocate(nucl_tmp(nucl_num)) + nucl_tmp = 0 + Nucl_Aos = 0 + do i = 1, ao_num + nucl_tmp(ao_nucl(i))+=1 + Nucl_Aos(ao_nucl(i),nucl_tmp(ao_nucl(i))) = i + enddo + deallocate(nucl_tmp) +END_PROVIDER + + + BEGIN_PROVIDER [ integer, Nucl_list_shell_Aos, (nucl_num,N_AOs_max)] +&BEGIN_PROVIDER [ integer, Nucl_num_shell_Aos, (nucl_num)] + implicit none + integer :: i,j,k + BEGIN_DOC + ! Index of the shell type Aos and of the corresponding Aos + ! Per convention, for P,D,F and G AOs, we take the index + ! of the AO with the the corresponding power in the "X" axis + END_DOC + do i = 1, nucl_num + Nucl_num_shell_Aos(i) = 0 + + do j = 1, Nucl_N_Aos(i) + if(ao_l(Nucl_Aos(i,j))==0)then + ! S type function + Nucl_num_shell_Aos(i)+=1 + Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) + elseif(ao_l(Nucl_Aos(i,j))==1)then + ! P type function + if(ao_power(Nucl_Aos(i,j),1)==1)then + Nucl_num_shell_Aos(i)+=1 + Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) + endif + elseif(ao_l(Nucl_Aos(i,j))==2)then + ! D type function + if(ao_power(Nucl_Aos(i,j),1)==2)then + Nucl_num_shell_Aos(i)+=1 + Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) + endif + elseif(ao_l(Nucl_Aos(i,j))==3)then + ! F type function + if(ao_power(Nucl_Aos(i,j),1)==3)then + Nucl_num_shell_Aos(i)+=1 + Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) + endif + elseif(ao_l(Nucl_Aos(i,j))==4)then + ! G type function + if(ao_power(Nucl_Aos(i,j),1)==4)then + Nucl_num_shell_Aos(i)+=1 + Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) + endif + endif + + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ] + implicit none + integer :: i + character*(4) :: give_ao_character_space + do i=1,ao_num + + if(ao_l(i)==0)then + ! S type AO + give_ao_character_space = 'S ' + elseif(ao_l(i) == 1)then + ! P type AO + if(ao_power(i,1)==1)then + give_ao_character_space = 'X ' + elseif(ao_power(i,2) == 1)then + give_ao_character_space = 'Y ' + else + give_ao_character_space = 'Z ' + endif + elseif(ao_l(i) == 2)then + ! D type AO + if(ao_power(i,1)==2)then + give_ao_character_space = 'XX ' + elseif(ao_power(i,2) == 2)then + give_ao_character_space = 'YY ' + elseif(ao_power(i,3) == 2)then + give_ao_character_space = 'ZZ ' + elseif(ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'XY ' + elseif(ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'XZ ' + else + give_ao_character_space = 'YZ ' + endif + elseif(ao_l(i) == 3)then + ! F type AO + if(ao_power(i,1)==3)then + give_ao_character_space = 'XXX ' + elseif(ao_power(i,2) == 3)then + give_ao_character_space = 'YYY ' + elseif(ao_power(i,3) == 3)then + give_ao_character_space = 'ZZZ ' + elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'XXY ' + elseif(ao_power(i,1) == 2 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'XXZ ' + elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1)then + give_ao_character_space = 'YYX ' + elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'YYZ ' + elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1)then + give_ao_character_space = 'ZZX ' + elseif(ao_power(i,3) == 2 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'ZZY ' + elseif(ao_power(i,3) == 1 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'XYZ ' + endif + elseif(ao_l(i) == 4)then + ! G type AO + if(ao_power(i,1)==4)then + give_ao_character_space = 'XXXX' + elseif(ao_power(i,2) == 4)then + give_ao_character_space = 'YYYY' + elseif(ao_power(i,3) == 4)then + give_ao_character_space = 'ZZZZ' + elseif(ao_power(i,1) == 3 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'XXXY' + elseif(ao_power(i,1) == 3 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'XXXZ' + elseif(ao_power(i,2) == 3 .and. ao_power(i,1) == 1)then + give_ao_character_space = 'YYYX' + elseif(ao_power(i,2) == 3 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'YYYZ' + elseif(ao_power(i,3) == 3 .and. ao_power(i,1) == 1)then + give_ao_character_space = 'ZZZX' + elseif(ao_power(i,3) == 3 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'ZZZY' + elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 2)then + give_ao_character_space = 'XXYY' + elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 2)then + give_ao_character_space = 'YYZZ' + elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'XXYZ' + elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then + give_ao_character_space = 'YYXZ' + elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then + give_ao_character_space = 'ZZXY' + endif + endif + ao_l_char_space(i) = give_ao_character_space + enddo +END_PROVIDER diff --git a/src/Bitmask/bitmask_cas_routines.irp.f b/src/Bitmask/bitmask_cas_routines.irp.f index 4441fb22..4984d9a8 100644 --- a/src/Bitmask/bitmask_cas_routines.irp.f +++ b/src/Bitmask/bitmask_cas_routines.irp.f @@ -212,6 +212,12 @@ logical function is_a_two_holes_two_particles(key_in) implicit none integer(bit_kind), intent(in) :: key_in(N_int,2) integer :: i,i_diff + integer :: number_of_holes, number_of_particles + is_a_two_holes_two_particles = .False. + if(number_of_holes(key_in) == 2 .and. number_of_particles(key_in) == 2)then + is_a_two_holes_two_particles = .True. + return + endif i_diff = 0 if(N_int == 1)then i_diff = i_diff & @@ -456,6 +462,17 @@ logical function is_a_1h1p(key_in) end +logical function is_a_1h2p(key_in) + implicit none + integer(bit_kind), intent(in) :: key_in(N_int,2) + integer :: number_of_particles, number_of_holes + is_a_1h2p = .False. + if(number_of_holes(key_in).eq.1 .and. number_of_particles(key_in).eq.2)then + is_a_1h2p = .True. + endif + +end + logical function is_a_1h(key_in) implicit none integer(bit_kind), intent(in) :: key_in(N_int,2) diff --git a/src/Bitmask/bitmasks.irp.f b/src/Bitmask/bitmasks.irp.f index 6fe36c57..7bb6e16e 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/src/Bitmask/bitmasks.irp.f @@ -95,9 +95,40 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ] END_PROVIDER +BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ] + implicit none + BEGIN_DOC + ! Number of bitmasks for generators + END_DOC + logical :: exists + PROVIDE ezfio_filename + + call ezfio_has_bitmasks_N_mask_gen(exists) + if (exists) then + call ezfio_get_bitmasks_N_mask_gen(N_generators_bitmask_restart) + integer :: N_int_check + integer :: bit_kind_check + call ezfio_get_bitmasks_bit_kind(bit_kind_check) + if (bit_kind_check /= bit_kind) then + print *, bit_kind_check, bit_kind + print *, 'Error: bit_kind is not correct in EZFIO file' + endif + call ezfio_get_bitmasks_N_int(N_int_check) + if (N_int_check /= N_int) then + print *, N_int_check, N_int + print *, 'Error: N_int is not correct in EZFIO file' + endif + else + N_generators_bitmask_restart = 1 + endif + ASSERT (N_generators_bitmask_restart > 0) + +END_PROVIDER -BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_generators_bitmask) ] + + +BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_generators_bitmask_restart) ] implicit none BEGIN_DOC ! Bitmasks for generator determinants. @@ -306,7 +337,7 @@ END_PROVIDER n_inact_orb = 0 n_virt_orb = 0 - if(N_generators_bitmask == 1)then + if(N_generators_bitmask_restart == 1)then do j = 1, N_int inact_bitmask(j,1) = xor(generators_bitmask_restart(j,1,1,1),cas_bitmask(j,1,1)) inact_bitmask(j,2) = xor(generators_bitmask_restart(j,2,1,1),cas_bitmask(j,2,1)) @@ -319,15 +350,15 @@ END_PROVIDER i_hole = 1 i_gen = 1 do i = 1, N_int - inact_bitmask(i,1) = generators_bitmask(i,1,i_hole,i_gen) - inact_bitmask(i,2) = generators_bitmask(i,2,i_hole,i_gen) + inact_bitmask(i,1) = generators_bitmask_restart(i,1,i_hole,i_gen) + inact_bitmask(i,2) = generators_bitmask_restart(i,2,i_hole,i_gen) n_inact_orb += popcnt(inact_bitmask(i,1)) enddo i_part = 2 i_gen = 3 do i = 1, N_int - virt_bitmask(i,1) = generators_bitmask(i,1,i_part,i_gen) - virt_bitmask(i,2) = generators_bitmask(i,2,i_part,i_gen) + virt_bitmask(i,1) = generators_bitmask_restart(i,1,i_part,i_gen) + virt_bitmask(i,2) = generators_bitmask_restart(i,2,i_part,i_gen) n_virt_orb += popcnt(virt_bitmask(i,1)) enddo endif diff --git a/src/Determinants/H_apply.irp.f b/src/Determinants/H_apply.irp.f index 28513597..cadf84b4 100644 --- a/src/Determinants/H_apply.irp.f +++ b/src/Determinants/H_apply.irp.f @@ -214,8 +214,13 @@ subroutine remove_duplicates_in_psi_det(found_duplicates) duplicate(i) = .False. enddo - do i=1,N_det-1 + found_duplicates = .False. + i=0 + j=0 + do while (i 2.d0) then $printout_now wall_0 = wall_1 endif - !$ call omp_unset_lock(lck) + !$OMP END CRITICAL enddo !$OMP END DO deallocate( mask, fock_diag_tmp ) !$OMP END PARALLEL - !$ call omp_destroy_lock(lck) $copy_buffer $generate_psi_guess diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index c492a739..2faceb77 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -10,9 +10,9 @@ subroutine $subroutine($params_main) $decls_main + integer :: i integer :: i_generator double precision :: wall_0, wall_1 - integer(omp_lock_kind) :: lck integer(bit_kind), allocatable :: mask(:,:,:) integer :: ispin, k integer :: rc @@ -26,6 +26,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.) @@ -37,24 +40,26 @@ 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) + 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) ) - !$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 N_states + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i) & + !$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_generators, norm_pert_generators, H_pert_diag_generators, i_generator, size(pt2_generators), 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') @@ -62,6 +67,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) @@ -169,7 +175,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 @@ -186,7 +192,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 @@ -194,7 +200,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 @@ -202,22 +208,25 @@ 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) - 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) - 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) @@ -234,9 +243,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), 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) diff --git a/src/Determinants/SC2.irp.f b/src/Determinants/SC2.irp.f index ea942307..4f321b87 100644 --- a/src/Determinants/SC2.irp.f +++ b/src/Determinants/SC2.irp.f @@ -1,4 +1,4 @@ -subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence) +subroutine CISD_SC2(dets_in,u_in,energies,diag_H_elements,dim_in,sze,N_st,Nint,convergence) use bitmasks implicit none BEGIN_DOC @@ -21,6 +21,7 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence) integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) double precision, intent(inout) :: u_in(dim_in,N_st) double precision, intent(out) :: energies(N_st) + double precision, intent(out) :: diag_H_elements(dim_in) double precision, intent(in) :: convergence ASSERT (N_st > 0) ASSERT (sze > 0) @@ -197,6 +198,9 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence) converged = dabs(e_corr_double - e_corr_double_before) < convergence converged = converged if (converged) then + do i = 1, dim_in + diag_H_elements(i) = H_jj_dressed(i) - H_jj_ref(i) + enddo exit endif e_corr_double_before = e_corr_double diff --git a/src/Determinants/davidson.irp.f b/src/Determinants/davidson.irp.f index 3d074563..a4166e10 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/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 400345c1..52d2cc53 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -58,7 +58,7 @@ BEGIN_PROVIDER [ integer, psi_det_size ] else psi_det_size = 1 endif - psi_det_size = max(psi_det_size,10000) + psi_det_size = max(psi_det_size,100000) call write_int(output_determinants,psi_det_size,'Dimension of the psi arrays') END_PROVIDER diff --git a/src/Determinants/diagonalize_CI_SC2.irp.f b/src/Determinants/diagonalize_CI_SC2.irp.f index 97161ad3..498792d9 100644 --- a/src/Determinants/diagonalize_CI_SC2.irp.f +++ b/src/Determinants/diagonalize_CI_SC2.irp.f @@ -23,8 +23,10 @@ END_PROVIDER threshold_convergence_SC2 = 1.d-10 END_PROVIDER + BEGIN_PROVIDER [ double precision, CI_SC2_electronic_energy, (N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_SC2_eigenvectors, (N_det,N_states_diag) ] +&BEGIN_PROVIDER [ double precision, Diag_H_elements_SC2, (N_det) ] implicit none BEGIN_DOC ! Eigenvectors/values of the CI matrix @@ -39,7 +41,8 @@ END_PROVIDER enddo call CISD_SC2(psi_det,CI_SC2_eigenvectors,CI_SC2_electronic_energy, & - size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) +! size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) + diag_H_elements_SC2,size(CI_SC2_eigenvectors,1),N_det,N_states_diag,N_int,threshold_convergence_SC2) END_PROVIDER subroutine diagonalize_CI_SC2 @@ -54,5 +57,6 @@ subroutine diagonalize_CI_SC2 psi_coef(i,j) = CI_SC2_eigenvectors(i,j) enddo enddo - SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors + SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors diag_h_elements_sc2 +! SOFT_TOUCH psi_coef CI_SC2_electronic_energy CI_SC2_energy CI_SC2_eigenvectors end diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index 9810b219..9a60dbd9 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -301,13 +301,21 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma print*,'' print*,'nstates = ',nstates allocate(s2(nstates,nstates),overlap(nstates,nstates)) - do i = 1, nstates - overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) - do j = i+1, nstates - overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) - overlap(j,i) = overlap(i,j) - enddo - enddo + !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) & + !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n) + do i = 1, nstates + do j = 1, nstates + if (i < j) then + cycle + else if (i == j) then + overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) + else + overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) + overlap(j,i) = overlap(i,j) + endif + enddo + enddo + !$OMP END PARALLEL DO print*,'Overlap matrix in the basis of the states considered' do i = 1, nstates write(*,'(10(F16.10,X))')overlap(i,:) @@ -315,13 +323,21 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma call ortho_lowdin(overlap,size(overlap,1),nstates,psi_coefs_inout,size(psi_coefs_inout,1),n) print*,'passed ortho' - do i = 1, nstates - overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) - do j = i+1, nstates - overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) - overlap(j,i) = overlap(i,j) - enddo - enddo + !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) & + !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n) + do i = 1, nstates + do j = 1, nstates + if (i < j) then + cycle + else if (i == j) then + overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) + else + overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) + overlap(j,i) = overlap(i,j) + endif + enddo + enddo + !$OMP END PARALLEL DO print*,'Overlap matrix in the basis of the Lowdin orthonormalized states ' do i = 1, nstates write(*,'(10(F16.10,X))')overlap(i,:) diff --git a/src/Determinants/save_natorb.irp.f b/src/Determinants/save_natorb.irp.f index e56f9821..674ba32e 100644 --- a/src/Determinants/save_natorb.irp.f +++ b/src/Determinants/save_natorb.irp.f @@ -2,5 +2,6 @@ program save_natorb read_wf = .True. touch read_wf call save_natural_mos + call save_ref_determinant end diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 3374dfb2..f4783f86 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -970,12 +970,13 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis integer, intent(in) :: Nint integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) - integer(bit_kind) :: subList(Nint, 2, N_fullList) + integer(bit_kind), allocatable :: subList(:,:,:) logical,intent(out) :: fullMatch integer,intent(out) :: N_miniList integer(bit_kind) :: key_mask(Nint, 2) integer :: ni, i, k, l, N_subList + allocate (subList(Nint, 2, N_fullList)) fullMatch = .false. N_miniList = 0 @@ -1032,6 +1033,8 @@ subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullLis enddo N_minilist = N_minilist + N_subList end if + + deallocate(sublist) end subroutine diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index eb443701..b7c75fb8 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -4,6 +4,7 @@ double precision function ao_bielec_integral(i,j,k,l) ! integral of the AO basis or (ij|kl) ! i(r1) j(r1) 1/r12 k(r2) l(r2) END_DOC + integer,intent(in) :: i,j,k,l integer :: p,q,r,s double precision :: I_center(3),J_center(3),K_center(3),L_center(3) @@ -374,20 +375,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/Integrals_Bielec/map_integrals.irp.f b/src/Integrals_Bielec/map_integrals.irp.f index 4041242e..e9775eec 100644 --- a/src/Integrals_Bielec/map_integrals.irp.f +++ b/src/Integrals_Bielec/map_integrals.irp.f @@ -230,7 +230,6 @@ subroutine clear_ao_map end - !! MO Map !! ====== diff --git a/src/Integrals_Bielec/mo_bi_integrals.irp.f b/src/Integrals_Bielec/mo_bi_integrals.irp.f index 4d471545..69ca0733 100644 --- a/src/Integrals_Bielec/mo_bi_integrals.irp.f +++ b/src/Integrals_Bielec/mo_bi_integrals.irp.f @@ -72,7 +72,7 @@ subroutine add_integrals_to_map(mask_ijkl) integer :: i2,i3,i4 double precision,parameter :: thr_coef = 1.d-10 - PROVIDE ao_bielec_integrals_in_map + PROVIDE ao_bielec_integrals_in_map mo_coef !Get list of MOs for i,j,k and l !------------------------------- @@ -329,7 +329,7 @@ end double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) if (.not.do_direct_integrals) then - PROVIDE ao_bielec_integrals_in_map + PROVIDE ao_bielec_integrals_in_map mo_coef endif mo_bielec_integral_jj_from_ao = 0.d0 @@ -495,4 +495,13 @@ subroutine clear_mo_map call map_deinit(mo_integrals_map) FREE mo_integrals_map mo_bielec_integral_schwartz mo_bielec_integral_jj mo_bielec_integral_jj_anti FREE mo_bielec_integral_jj_exchange mo_bielec_integrals_in_map + + +end + +subroutine provide_all_mo_integrals + implicit none + provide mo_integrals_map mo_bielec_integral_schwartz mo_bielec_integral_jj mo_bielec_integral_jj_anti + provide mo_bielec_integral_jj_exchange mo_bielec_integrals_in_map + end diff --git a/src/Integrals_Monoelec/mo_mono_ints.irp.f b/src/Integrals_Monoelec/mo_mono_ints.irp.f index 714222ec..5bae9868 100644 --- a/src/Integrals_Monoelec/mo_mono_ints.irp.f +++ b/src/Integrals_Monoelec/mo_mono_ints.irp.f @@ -5,6 +5,7 @@ BEGIN_PROVIDER [ double precision, mo_mono_elec_integral,(mo_tot_num_align,mo_to ! array of the mono electronic hamiltonian on the MOs basis ! : sum of the kinetic and nuclear electronic potential END_DOC + print*,'Providing the mono electronic integrals' do j = 1, mo_tot_num do i = 1, mo_tot_num mo_mono_elec_integral(i,j) = mo_nucl_elec_integral(i,j) + mo_kinetic_integral(i,j) + mo_pseudo_integral(i,j) 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 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 diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index af97161b..ae1de6e7 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 @@ -355,11 +350,11 @@ subroutine end_zmq_pull_socket(zmq_socket_pull) ! endif rc = f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address) - if (rc /= 0) then - print *, rc - print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)' - stop 'error' - endif +! if (rc /= 0) then +! print *, rc +! print *, irp_here, 'f77_zmq_unbind(zmq_socket_pull,zmq_socket_pull_tcp_address)' +! stop 'error' +! endif call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922 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" {