From 518520d619bb07828e75bb685513ea6c2db80f50 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Fri, 19 Feb 2016 17:32:35 +0100 Subject: [PATCH 01/12] Changes in FOBOCI --- plugins/FOBOCI/all_singles.irp.f | 4 +- plugins/FOBOCI/all_singles_split.irp.f | 44 ++++-- plugins/FOBOCI/new_approach.irp.f | 17 ++- plugins/FOBOCI/routines_dressing.irp.f | 189 ++++++++++++++++++++++--- scripts/generate_h_apply.py | 2 +- 5 files changed, 216 insertions(+), 40 deletions(-) diff --git a/plugins/FOBOCI/all_singles.irp.f b/plugins/FOBOCI/all_singles.irp.f index e2c4c01e..924e1c72 100644 --- a/plugins/FOBOCI/all_singles.irp.f +++ b/plugins/FOBOCI/all_singles.irp.f @@ -6,7 +6,7 @@ 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 soft_touch threshold_davidson davidson_criterion @@ -79,6 +79,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 diff --git a/plugins/FOBOCI/all_singles_split.irp.f b/plugins/FOBOCI/all_singles_split.irp.f index e7b0943f..57f6ebde 100644 --- a/plugins/FOBOCI/all_singles_split.irp.f +++ b/plugins/FOBOCI/all_singles_split.irp.f @@ -32,46 +32,57 @@ subroutine all_single_split(psi_det_generators_input,psi_coef_generators_input,N end -subroutine all_single_for_1h(dressing_matrix_1h1p,dressing_matrix_2h1p) +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) - integer :: i,i_hole + 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_2h1p + integer :: n_det_1h1p,n_det_2h1p,n_det_extra_1h_or_1p 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_1h1p(:,:) double precision, allocatable :: psi_coef_2h1p(:,:) - call all_single_no_1h_or_1p + double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:) +!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) + 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)) - 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) + 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) 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) + 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_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,39 +208,48 @@ 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) +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) - integer :: i,i_hole + 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 + 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(:,:) - call all_single_no_1h_or_1p_or_2p + 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(n_det_1h1p,n_det_1h2p) + 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)) - 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) + 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) diff --git a/plugins/FOBOCI/new_approach.irp.f b/plugins/FOBOCI/new_approach.irp.f index 49dcafc3..90b29faa 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 @@ -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,6 +211,7 @@ 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 @@ -221,7 +228,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 diff --git a/plugins/FOBOCI/routines_dressing.irp.f b/plugins/FOBOCI/routines_dressing.irp.f index 910f1109..b0edd949 100644 --- a/plugins/FOBOCI/routines_dressing.irp.f +++ b/plugins/FOBOCI/routines_dressing.irp.f @@ -81,6 +81,72 @@ subroutine provide_matrix_dressing(dressing_matrix,ndet_generators_input,psi_det enddo !print*,'i_pert_count = ',i_pert_count 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.3d0)then + i_pert = 1 + exit + endif + enddo + 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) @@ -170,31 +236,41 @@ 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 @@ -212,72 +288,89 @@ subroutine give_n_1h1p_and_n_2h1p_in_psi_det(n_det_1h1p,n_det_2h1p) end -subroutine give_n_1h1p_and_n_1h2p_in_psi_det(n_det_1h1p,n_det_1h2p) +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(out) :: n_det_1h1p, n_det_1h2p + 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_1h + 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_1h = 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 - n_det_1h +=1 + 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 1p, 1h1p or 1h2p' + 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 +!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_extra_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_extra_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 +380,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_extra_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 +418,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 +454,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 +516,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 +584,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/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index ca2be5d6..f9be4fa6 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -168,7 +168,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 """ From fbcddd5b62864d9cd28b1026fe29b533c43d431e Mon Sep 17 00:00:00 2001 From: Thomas Applencourt Date: Thu, 10 Mar 2016 08:40:20 +0100 Subject: [PATCH 02/12] Update qp_convert_qmcpack_to_ezfio.py Support python 2.6 for qmcpack --- plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py index 0dc99029..3298129d 100755 --- a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py +++ b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py @@ -256,7 +256,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: From ac8e5303726bd20e407d75230d3cc42b16e0b30f Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Fri, 11 Mar 2016 23:27:39 +0100 Subject: [PATCH 03/12] FOBO-SCF executable works --- config/ifort.cfg | 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/H_apply.irp.f | 16 +- plugins/FOBOCI/H_apply_dressed_autonom.irp.f | 4 +- .../FOBOCI/H_apply_dressed_autonom_bis.irp.f | 385 +++++++++++++++ plugins/FOBOCI/NEEDED_CHILDREN_MODULES | 2 +- plugins/FOBOCI/all_singles.irp.f | 333 +++++++++---- plugins/FOBOCI/all_singles_split.irp.f | 452 ++++++++++++++---- plugins/FOBOCI/collect_all_lmct.irp.f | 436 +++++++++++++++++ plugins/FOBOCI/corr_energy_2h2p.irp.f | 363 ++++++++++++++ plugins/FOBOCI/diag_fock_inactiv_virt.irp.f | 48 ++ plugins/FOBOCI/dress_simple.irp.f | 27 -- plugins/FOBOCI/fobo_scf.irp.f | 35 ++ .../foboci_lmct_mlct_threshold_old.irp.f | 97 +++- 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 | 316 ++++++++++-- plugins/FOBOCI/new_new_approach.irp.f | 132 +++++ plugins/FOBOCI/routines_dressing.irp.f | 314 +++++++++++- plugins/FOBOCI/routines_foboci.irp.f | 51 +- plugins/Generators_restart/generators.irp.f | 28 +- plugins/Hartree_Fock/damping_SCF.irp.f | 4 +- 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 +- scripts/generate_h_apply.py | 33 +- src/Bitmask/bitmask_cas_routines.irp.f | 17 + src/Bitmask/bitmasks.irp.f | 45 +- src/Determinants/H_apply.template.f | 25 +- src/Determinants/SC2.irp.f | 6 +- src/Determinants/determinants.irp.f | 2 +- src/Determinants/diagonalize_CI_SC2.irp.f | 8 +- src/Determinants/save_natorb.irp.f | 1 + 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 + 43 files changed, 3082 insertions(+), 499 deletions(-) create mode 100644 plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f 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 diff --git a/config/ifort.cfg b/config/ifort.cfg index cc848cba..2efa9eac 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -51,7 +51,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz # [DEBUG] FC : -g -traceback -FCFLAGS : -xSSE2 -C -fpe0 +FCFLAGS : -xSSE2 -C IRPF90_FLAGS : --openmp # OpenMP flags 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 3fcb443b..08e17cdd 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) if (abort_all) then exit 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/H_apply_dressed_autonom.irp.f b/plugins/FOBOCI/H_apply_dressed_autonom.irp.f index c5b0aa5c..5f09390e 100644 --- a/plugins/FOBOCI/H_apply_dressed_autonom.irp.f +++ b/plugins/FOBOCI/H_apply_dressed_autonom.irp.f @@ -449,8 +449,8 @@ subroutine H_apply_dressed_pert(delta_ij_generators_, Ndet_generators,psi_det_g integer, intent(in) :: Ndet_generators - integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators),E_ref - double precision, intent(in) :: delta_ij_generators_(Ndet_generators,Ndet_generators) + integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) + double precision, intent(in) :: delta_ij_generators_(Ndet_generators,Ndet_generators),E_ref integer :: i_generator, nmax diff --git a/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f b/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f new file mode 100644 index 00000000..a9b05fc7 --- /dev/null +++ b/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f @@ -0,0 +1,385 @@ +subroutine H_apply_dressed_pert_monoexc_bis(key_in, hole_1,particl_1,i_generator,iproc_in , delta_ij_generators_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input ) + use omp_lib + use bitmasks + implicit none + BEGIN_DOC + ! Generate all single excitations of key_in using the bit masks of holes and + ! particles. + ! Assume N_int is already provided. + END_DOC + integer,parameter :: size_max = 3072 + + integer, intent(in) :: Ndet_generators,n_det_input + double precision, intent(inout) :: delta_ij_generators_(n_det_input,n_det_input),E_ref + + integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) + integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) + + integer ,intent(in) :: i_generator + integer(bit_kind),intent(in) :: key_in(N_int,2) + integer(bit_kind),intent(in) :: hole_1(N_int,2), particl_1(N_int,2) + integer, intent(in) :: iproc_in + integer(bit_kind),allocatable :: keys_out(:,:,:) + integer(bit_kind),allocatable :: hole_save(:,:) + integer(bit_kind),allocatable :: key(:,:),hole(:,:), particle(:,:) + integer(bit_kind),allocatable :: hole_tmp(:,:), particle_tmp(:,:) + integer(bit_kind),allocatable :: hole_2(:,:), particl_2(:,:) + integer :: ii,i,jj,j,k,ispin,l + integer,allocatable :: occ_particle(:,:), occ_hole(:,:) + integer,allocatable :: occ_particle_tmp(:,:), occ_hole_tmp(:,:) + integer,allocatable :: ib_jb_pairs(:,:) + integer :: kk,pp,other_spin,key_idx + integer :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2) + integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2) + logical :: is_a_two_holes_two_particles + integer(bit_kind), allocatable :: key_union_hole_part(:) + + integer, allocatable :: ia_ja_pairs(:,:,:) + logical, allocatable :: array_pairs(:,:) + double precision :: diag_H_mat_elem + integer(omp_lock_kind), save :: lck, ifirst=0 + integer :: iproc + + logical :: check_double_excitation + logical :: is_a_1h1p + logical :: is_a_1h + logical :: is_a_1p + iproc = iproc_in + + check_double_excitation = .True. + + check_double_excitation = .False. + + + + + if (ifirst == 0) then + ifirst=1 +!!$ call omp_init_lock(lck) + endif + + + + PROVIDE elec_num_tab +! !$OMP PARALLEL DEFAULT(SHARED) & +! !$OMP PRIVATE(i,j,k,l,keys_out,hole,particle, & +! !$OMP occ_particle,occ_hole,j_a,k_a,other_spin, & +! !$OMP hole_save,ispin,jj,l_a,ib_jb_pairs,array_pairs, & +! !$OMP accu,i_a,hole_tmp,particle_tmp,occ_particle_tmp, & +! !$OMP occ_hole_tmp,key_idx,i_b,j_b,key,N_elec_in_key_part_1,& +! !$OMP N_elec_in_key_hole_1,N_elec_in_key_part_2, & +! !$OMP N_elec_in_key_hole_2,ia_ja_pairs,key_union_hole_part) & +! !$OMP SHARED(key_in,N_int,elec_num_tab,mo_tot_num, & +! !$OMP hole_1, particl_1, hole_2, particl_2, & +! !$OMP elec_alpha_num,i_generator) FIRSTPRIVATE(iproc) +!!$ iproc = omp_get_thread_num() + allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), & + key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),& + particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), & + occ_hole(N_int*bit_kind_size,2), occ_particle_tmp(N_int*bit_kind_size,2),& + occ_hole_tmp(N_int*bit_kind_size,2),key_union_hole_part(N_int)) + + !!!! First couple hole particle + do j = 1, N_int + hole(j,1) = iand(hole_1(j,1),key_in(j,1)) + hole(j,2) = iand(hole_1(j,2),key_in(j,2)) + particle(j,1) = iand(xor(particl_1(j,1),key_in(j,1)),particl_1(j,1)) + particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2)) + enddo + + call bitstring_to_list(particle(1,1),occ_particle(1,1),N_elec_in_key_part_1(1),N_int) + call bitstring_to_list(particle(1,2),occ_particle(1,2),N_elec_in_key_part_1(2),N_int) + call bitstring_to_list(hole (1,1),occ_hole (1,1),N_elec_in_key_hole_1(1),N_int) + call bitstring_to_list(hole (1,2),occ_hole (1,2),N_elec_in_key_hole_1(2),N_int) + allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2)) + + do ispin=1,2 + i=0 + do ii=N_elec_in_key_hole_1(ispin),1,-1 ! hole + i_a = occ_hole(ii,ispin) + do jj=1,N_elec_in_key_part_1(ispin) !particule + j_a = occ_particle(jj,ispin) + i += 1 + ia_ja_pairs(1,i,ispin) = i_a + ia_ja_pairs(2,i,ispin) = j_a + enddo + enddo + ia_ja_pairs(1,0,ispin) = i + enddo + + key_idx = 0 + + integer :: i_a,j_a,i_b,j_b,k_a,l_a,k_b,l_b + integer(bit_kind) :: test(N_int,2) + double precision :: accu + accu = 0.d0 + integer :: jjtest,na,nb + do ispin=1,2 + other_spin = iand(ispin,1)+1 +! !$OMP DO SCHEDULE (static) + do ii=1,ia_ja_pairs(1,0,ispin) + i_a = ia_ja_pairs(1,ii,ispin) + j_a = ia_ja_pairs(2,ii,ispin) + hole = key_in + k = ishft(i_a-1,-bit_kind_shift)+1 + j = i_a-ishft(k-1,bit_kind_shift)-1 + + hole(k,ispin) = ibclr(hole(k,ispin),j) + k_a = ishft(j_a-1,-bit_kind_shift)+1 + l_a = j_a-ishft(k_a-1,bit_kind_shift)-1 + + hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + na = 0 + nb = 0 +! if (is_a_1h(hole)) then +! cycle +! endif +! if (is_a_1p(hole)) then +! cycle +! endif + + + key_idx += 1 + do k=1,N_int + keys_out(k,1,key_idx) = hole(k,1) + keys_out(k,2,key_idx) = hole(k,2) + enddo + if (key_idx == size_max) then + call standard_dress_bis(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) + key_idx = 0 + endif + enddo ! ii +! !$OMP ENDDO NOWAIT + enddo ! ispin + call standard_dress_bis(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) + + deallocate (ia_ja_pairs, & + keys_out, hole_save, & + key,hole, particle, hole_tmp,& + particle_tmp, occ_particle, & + occ_hole, occ_particle_tmp,& + occ_hole_tmp,key_union_hole_part) +! !$OMP END PARALLEL + + +end + + +subroutine H_apply_dressed_pertk_single(delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,psi_det_input,n_det_input) + implicit none + use omp_lib + use bitmasks + BEGIN_DOC + ! Calls H_apply on the HF determinant and selects all connected single and double + ! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + END_DOC + + + integer, intent(in) :: Ndet_generators,n_det_input + integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) + integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) + double precision, intent(inout) :: delta_ij_(n_det_input,n_det_input),E_ref + + + + integer :: i_generator, nmax + double precision :: wall_0, wall_1 + integer(omp_lock_kind) :: lck + integer(bit_kind), allocatable :: mask(:,:,:) + integer :: ispin, k + integer :: iproc + + + PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map + + nmax = mod( Ndet_generators,nproc ) + + +! !$ call omp_init_lock(lck) + call start_progress(Ndet_generators,'Selection (norm)',0.d0) + + call wall_time(wall_0) + + iproc = 0 + allocate( mask(N_int,2,6) ) + do i_generator=1,nmax + + progress_bar(1) = i_generator + + if (abort_here) then + exit + endif + + + +! ! Create bit masks for holes and particles + do ispin=1,2 + do k=1,N_int + mask(k,ispin,s_hole) = & + iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,s_part) = & + iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), & + not(psi_det_generators_input(k,ispin,i_generator)) ) + mask(k,ispin,d_hole1) = & + iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,d_part1) = & + iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), & + not(psi_det_generators_input(k,ispin,i_generator)) ) + mask(k,ispin,d_hole2) = & + iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,d_part2) = & + iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), & + not(psi_det_generators_input(k,ispin,i_generator)) ) + enddo + enddo + call H_apply_dressed_pert_monoexc(psi_det_generators_input(1,1,i_generator), & + mask(1,1,s_hole ), mask(1,1,s_part ), & + i_generator, iproc , delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input) + call wall_time(wall_1) + + if (wall_1 - wall_0 > 2.d0) then + write(output_determinants,*) & + 100.*float(i_generator)/float(Ndet_generators), '% in ', wall_1-wall_0, 's' + wall_0 = wall_1 + endif + enddo + + deallocate( mask ) + +! !$OMP PARALLEL DEFAULT(SHARED) & +! !$OMP PRIVATE(i_generator,wall_1,wall_0,ispin,k,mask,iproc) + call wall_time(wall_0) +! !$ iproc = omp_get_thread_num() + allocate( mask(N_int,2,6) ) +! !$OMP DO SCHEDULE(dynamic,1) + do i_generator=nmax+1,Ndet_generators + if (iproc == 0) then + progress_bar(1) = i_generator + endif + if (abort_here) then + cycle + endif + + + + ! Create bit masks for holes and particles + do ispin=1,2 + do k=1,N_int + mask(k,ispin,s_hole) = & + iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,s_part) = & + iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), & + not(psi_det_generators_input(k,ispin,i_generator)) ) + mask(k,ispin,d_hole1) = & + iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,d_part1) = & + iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), & + not(psi_det_generators_input(k,ispin,i_generator)) ) + mask(k,ispin,d_hole2) = & + iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), & + psi_det_generators_input(k,ispin,i_generator) ) + mask(k,ispin,d_part2) = & + iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), & + not (psi_det_generators_input(k,ispin,i_generator)) ) + enddo + enddo + + if(.True.)then + call H_apply_dressed_pert_monoexc(psi_det_generators_input(1,1,i_generator), & + mask(1,1,s_hole ), mask(1,1,s_part ), & + i_generator, iproc , delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input) + endif +! !$ call omp_set_lock(lck) + call wall_time(wall_1) + + if (wall_1 - wall_0 > 2.d0) then + write(output_determinants,*) & + 100.*float(i_generator)/float(Ndet_generators), '% in ', wall_1-wall_0, 's' + wall_0 = wall_1 + endif +! !$ call omp_unset_lock(lck) + enddo +! !$OMP END DO + deallocate( mask ) +! !$OMP END PARALLEL +! !$ call omp_destroy_lock(lck) + + abort_here = abort_all + call stop_progress + + + + +end + + +subroutine standard_dress_bis(delta_ij_generators_,size_buffer,Ndet_generators,i_generator,n_selected,det_buffer,Nint,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint, iproc,n_det_input + integer, intent(in) :: Ndet_generators,size_buffer + double precision, intent(inout) :: delta_ij_generators_(n_det_input,n_det_input),E_ref + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,size_buffer) + integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) + integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) + integer :: i,j,k,m + integer :: new_size + integer :: degree(n_det_input) + integer :: idx(0:n_det_input) + logical :: good + + integer :: c_ref + integer :: connected_to_ref + + + double precision :: hka, haa + double precision :: haj + double precision :: f + integer :: connected_to_ref_by_mono + logical :: is_in_wavefunction + double precision :: H_array(n_det_input) + double precision :: contrib,lambda_i,accu + integer :: number_of_holes,n_h, number_of_particles,n_p + + do i=1,n_selected + c_ref = connected_to_ref_by_mono(det_buffer(1,1,i),psi_det_generators_input,N_int,i_generator,Ndet_generators) + if (c_ref /= 0) then + cycle + endif + if (is_in_wavefunction(det_buffer(1,1,i),Nint)) then + cycle + endif + print* + n_h = number_of_holes(det_buffer(1,1,i)) + n_p = number_of_particles(det_buffer(1,1,i)) + print*,'n_h,n_p = ',n_h,n_p + call get_excitation_degree_vector(psi_det_input,det_buffer(1,1,i),degree,N_int,n_det_input,idx) + H_array = 0.d0 + do k=1,idx(0) + call i_h_j(det_buffer(1,1,i),psi_det_input(1,1,idx(k)),Nint,hka) + H_array(idx(k)) = hka + enddo + + call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa) + f = 1.d0/(E_ref-haa) + + lambda_i = f + do k=1,idx(0) + contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i + delta_ij_generators_(idx(k), idx(k)) += contrib + do j=k+1,idx(0) + contrib = H_array(idx(k)) * H_array(idx(j)) * lambda_i + delta_ij_generators_(idx(k), idx(j)) += contrib + delta_ij_generators_(idx(j), idx(k)) += contrib + enddo + enddo + enddo +end + 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 924e1c72..c4f0b7ae 100644 --- a/plugins/FOBOCI/all_singles.irp.f +++ b/plugins/FOBOCI/all_singles.irp.f @@ -8,7 +8,7 @@ subroutine all_single 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 + threshold_davidson = 1.d-9 soft_touch threshold_davidson davidson_criterion i = 0 print*,'Doing all the mono excitations !' @@ -52,10 +52,12 @@ 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 - soft_touch threshold_davidson davidson_criterion - call diagonalize_CI +! 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 @@ -67,10 +69,250 @@ 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_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 + 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 + 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_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 @@ -126,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 ' @@ -217,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 57f6ebde..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,16 +22,170 @@ 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_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,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_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 @@ -39,50 +193,168 @@ subroutine all_single_for_1h(i_hole,dressing_matrix_1h1p,dressing_matrix_2h1p,dr 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 + integer :: i,j n_det_max_jacobi = 50 soft_touch n_det_max_jacobi - integer :: n_det_1h1p,n_det_2h1p,n_det_extra_1h_or_1p - 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_1h1p(:,:) - double precision, allocatable :: psi_coef_2h1p(:,:) - double precision, allocatable :: psi_coef_extra_1h_or_1p(:,:) -!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(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) - 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) - 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_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) + + + 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 @@ -208,56 +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(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 +! 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..ebece3ed --- /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_singles)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_singles)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..8c4f2fe3 --- /dev/null +++ b/plugins/FOBOCI/corr_energy_2h2p.irp.f @@ -0,0 +1,363 @@ + BEGIN_PROVIDER [double precision, corr_energy_2h2p_per_orb_ab, (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 + 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_per_orb_ab = 0.d0 + corr_energy_2h2p_per_orb_aa = 0.d0 + corr_energy_2h2p_per_orb_bb = 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 + corr_energy_2h2p_per_orb_ab(i_hole) += contrib + corr_energy_2h2p_per_orb_ab(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 + corr_energy_2h2p_per_orb_aa(i_hole) += contrib + corr_energy_2h2p_per_orb_aa(k_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_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 + corr_energy_2h2p_per_orb_bb(i_hole) += contrib + corr_energy_2h2p_per_orb_bb(k_part) += contrib + enddo + enddo + enddo + enddo + +END_PROVIDER + + 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 + 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_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)) + + 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_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 + 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 + 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 + 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..9df94140 100644 --- a/plugins/FOBOCI/dress_simple.irp.f +++ b/plugins/FOBOCI/dress_simple.irp.f @@ -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..1b134733 --- /dev/null +++ b/plugins/FOBOCI/fobo_scf.irp.f @@ -0,0 +1,35 @@ +program foboscf + implicit none + no_oa_or_av_opt = .True. + touch no_oa_or_av_opt + call run_prepare + call routine_fobo_scf + call save_mos + +end + +subroutine run_prepare + implicit none + 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 + 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..b406284f 100644 --- a/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f +++ b/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f @@ -36,6 +36,10 @@ subroutine FOBOCI_lmct_mlct_old_thr print*,'' print*,'' print*,'DOING FIRST LMCT !!' + integer(bit_kind) , allocatable :: zero_bitmask(:,:) + integer(bit_kind) , allocatable :: psi_singles(:,:,:) + double precision, allocatable :: psi_singles_coef(:,:) + allocate( zero_bitmask(N_int,2) ) do i = 1, n_inact_orb integer :: i_hole_osoci i_hole_osoci = list_inact(i) @@ -54,24 +58,85 @@ subroutine FOBOCI_lmct_mlct_old_thr call is_a_good_candidate(threshold,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 + +! ! 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) @@ -132,24 +197,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 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 90b29faa..2e551dcd 100644 --- a/plugins/FOBOCI/new_approach.irp.f +++ b/plugins/FOBOCI/new_approach.irp.f @@ -213,6 +213,8 @@ subroutine new_approach 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 @@ -251,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 @@ -284,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 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 b0edd949..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,8 +75,52 @@ 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 @@ -125,11 +165,14 @@ subroutine provide_matrix_dressing_for_extra_1h_or_1p(dressing_matrix,psi_det_re 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 @@ -178,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 @@ -275,19 +319,257 @@ subroutine give_n_1h1p_and_n_2h1p_in_psi_det(i_hole,n_det_extra_1h_or_1p,n_det_1 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_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_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 + logical :: is_the_hole_in_det + n_det_ref_1h_1p = 0 + n_det_2h1p = 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 ==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 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 + +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 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 @@ -353,7 +635,7 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_d 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,n_det_extra_1h_or_1p_tmp - integer :: n_det_extra_1h_tmp + integer :: n_det_1h_tmp integer, allocatable :: index_generator(:) integer, allocatable :: index_1h1p(:) integer, allocatable :: index_2h1p(:) @@ -370,7 +652,7 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_d n_det_1h1p_tmp = 0 n_det_2h1p_tmp = 0 n_det_extra_1h_or_1p_tmp = 0 - n_det_extra_1h_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)) @@ -385,7 +667,7 @@ subroutine split_wf_generators_and_1h1p_and_2h1p(i_hole,n_det_extra_1h_or_1p,n_d 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_extra_1h_tmp +=1 + 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 diff --git a/plugins/FOBOCI/routines_foboci.irp.f b/plugins/FOBOCI/routines_foboci.irp.f index 696011a9..4def99e2 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 @@ -389,14 +389,14 @@ subroutine save_osoci_natural_mos jorb = list_inact(j) if(dabs(tmp(iorb,jorb)).gt.threshold_singles)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 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) @@ -520,14 +521,14 @@ subroutine set_osoci_natural_mos jorb = list_inact(j) if(dabs(tmp(iorb,jorb)).gt.threshold_singles)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 print*,'VIRT ' - print*,'DM ',iorb,jorb,dabs(tmp(iorb,jorb)) + print*,'DM ',iorb,jorb,(tmp(iorb,jorb)) endif enddo enddo @@ -602,15 +603,7 @@ 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 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 d77c91c5..5c626db9 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,X,A16, X, A16, X, A16, X, 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/Perturbation/pt2_equations.irp.f b/plugins/Perturbation/pt2_equations.irp.f index 72d03808..0086c67e 100644 --- a/plugins/Perturbation/pt2_equations.irp.f +++ b/plugins/Perturbation/pt2_equations.irp.f @@ -126,6 +126,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/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index f9be4fa6..84150c1b 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -24,13 +24,18 @@ skip init_main filter_integrals filter2p -filter2h2p +filter2h2p_double +filter2h2p_single filter1h filter1p 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 filterparticle do_double_excitations @@ -194,6 +199,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"] = """ @@ -201,9 +227,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): 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 d6d8fcb0..3f8299f6 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/src/Bitmask/bitmasks.irp.f @@ -98,9 +98,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. @@ -258,7 +289,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ] call ezfio_get_bitmasks_cas(cas_bitmask) print*,'---------------------' else - if(N_generators_bitmask == 1)then + if(N_generators_bitmask_restart == 1)then do i=1,N_cas_bitmask cas_bitmask(:,:,i) = iand(not(HF_bitmask(:,:)),full_ijkl_bitmask(:,:)) enddo @@ -302,7 +333,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)) @@ -315,15 +346,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.template.f b/src/Determinants/H_apply.template.f index 86780430..fdf2ec80 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -166,6 +166,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl logical :: check_double_excitation logical :: is_a_1h1p + logical :: is_a_1h2p logical :: is_a_1h logical :: is_a_1p logical :: is_a_2p @@ -301,8 +302,10 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl k = ishft(j_b-1,-bit_kind_shift)+1 l = j_b-ishft(k-1,bit_kind_shift)-1 key(k,other_spin) = ibset(key(k,other_spin),l) - $filter2h2p + $filter2h2p_double $filter_only_1h1p_double + $filter_only_1h2p_double + $filter_only_2h2p_double $only_2p_double key_idx += 1 do k=1,N_int @@ -353,8 +356,10 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl k = ishft(j_b-1,-bit_kind_shift)+1 l = j_b-ishft(k-1,bit_kind_shift)-1 key(k,ispin) = ibset(key(k,ispin),l) - $filter2h2p + $filter2h2p_double $filter_only_1h1p_double + $filter_only_1h2p_double + $filter_only_2h2p_double $only_2p_double key_idx += 1 do k=1,N_int @@ -427,6 +432,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato logical :: check_double_excitation logical :: is_a_1h1p + logical :: is_a_1h2p logical :: is_a_1h logical :: is_a_1p logical :: is_a_2p @@ -505,8 +511,10 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato $filter1h $filter1p $filter2p - $filter2h2p + $filter2h2p_single $filter_only_1h1p_single + $filter_only_1h2p_single + $filter_only_2h2p_single key_idx += 1 do k=1,N_int keys_out(k,1,key_idx) = hole(k,1) @@ -566,7 +574,6 @@ subroutine $subroutine($params_main) iproc = 0 allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_tot_num+1) ) do i_generator=1,nmax - progress_bar(1) = i_generator if (abort_here) then @@ -600,6 +607,16 @@ subroutine $subroutine($params_main) not(psi_det_generators(k,ispin,i_generator)) ) enddo enddo +! print*,'generator in ' +! call debug_det(psi_det_generators(1,1,i_generator),N_int) +! print*,'hole 1' +! call debug_det(mask(1,1,d_hole1),N_int) +! print*,'hole 2' +! call debug_det(mask(1,1,d_hole2),N_int) +! print*,'part 1' +! call debug_det(mask(1,1,d_part1),N_int) +! print*,'part 2' +! call debug_det(mask(1,1,d_part2),N_int) if($do_double_excitations)then call $subroutine_diexc(psi_det_generators(1,1,i_generator), & psi_det_generators(1,1,1), & diff --git a/src/Determinants/SC2.irp.f b/src/Determinants/SC2.irp.f index 440b2870..4f613abc 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) @@ -200,6 +201,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 .or. abort_here 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/determinants.irp.f b/src/Determinants/determinants.irp.f index 63ed7a92..f453a8a3 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/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/Integrals_Bielec/map_integrals.irp.f b/src/Integrals_Bielec/map_integrals.irp.f index 84b08715..dc35f278 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 0ff14168..000fcb4d 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 !------------------------------- @@ -341,7 +341,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 @@ -513,4 +513,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) From 4cef44732eb67945688436d38a58f8b3012b25c7 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Mon, 14 Mar 2016 16:01:55 +0100 Subject: [PATCH 04/12] Program FOBO-SCF works --- plugins/FOBOCI/EZFIO.cfg | 25 ++- plugins/FOBOCI/all_singles.irp.f | 2 +- plugins/FOBOCI/collect_all_lmct.irp.f | 4 +- plugins/FOBOCI/corr_energy_2h2p.irp.f | 64 +++++- plugins/FOBOCI/dress_simple.irp.f | 34 +-- plugins/FOBOCI/fobo_scf.irp.f | 26 ++- .../foboci_lmct_mlct_threshold_old.irp.f | 27 ++- plugins/FOBOCI/new_approach.irp.f | 6 +- plugins/FOBOCI/routines_foboci.irp.f | 211 +++++++++++++++++- 9 files changed, 357 insertions(+), 42 deletions(-) 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/all_singles.irp.f b/plugins/FOBOCI/all_singles.irp.f index c4f0b7ae..0594e56e 100644 --- a/plugins/FOBOCI/all_singles.irp.f +++ b/plugins/FOBOCI/all_singles.irp.f @@ -66,7 +66,7 @@ subroutine all_single print*,'E = ',CI_energy(i) print*,'S^2 = ',CI_eigenvectors_s2(i) enddo - do i = 1, 2 + do i = 1, max(2,N_det_generators) print*,'psi_coef = ',psi_coef(i,1) enddo deallocate(pt2,norm_pert,E_before) diff --git a/plugins/FOBOCI/collect_all_lmct.irp.f b/plugins/FOBOCI/collect_all_lmct.irp.f index ebece3ed..96eb2858 100644 --- a/plugins/FOBOCI/collect_all_lmct.irp.f +++ b/plugins/FOBOCI/collect_all_lmct.irp.f @@ -92,7 +92,7 @@ subroutine collect_lmct_mlct(hole_particle,n_couples) iorb = list_act(i) 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 n_couples +=1 hole_particle(n_couples,1) = jorb hole_particle(n_couples,2) = iorb @@ -102,7 +102,7 @@ subroutine collect_lmct_mlct(hole_particle,n_couples) 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 n_couples +=1 hole_particle(n_couples,1) = iorb hole_particle(n_couples,2) = jorb diff --git a/plugins/FOBOCI/corr_energy_2h2p.irp.f b/plugins/FOBOCI/corr_energy_2h2p.irp.f index 8c4f2fe3..ada46bf2 100644 --- a/plugins/FOBOCI/corr_energy_2h2p.irp.f +++ b/plugins/FOBOCI/corr_energy_2h2p.irp.f @@ -1,8 +1,16 @@ 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 @@ -12,9 +20,14 @@ 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 @@ -36,8 +49,24 @@ 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 @@ -65,8 +94,12 @@ 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 @@ -94,8 +127,20 @@ 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 @@ -103,7 +148,11 @@ END_PROVIDER - BEGIN_PROVIDER [double precision, corr_energy_2h1p_per_orb_ab, (mo_tot_num)] + 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] @@ -120,6 +169,10 @@ END_PROVIDER 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 @@ -141,6 +194,7 @@ END_PROVIDER 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 @@ -199,6 +253,7 @@ END_PROVIDER 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 @@ -212,6 +267,7 @@ 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] @@ -252,6 +308,8 @@ END_PROVIDER 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 @@ -282,6 +340,8 @@ END_PROVIDER 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 @@ -312,6 +372,8 @@ END_PROVIDER 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 diff --git a/plugins/FOBOCI/dress_simple.irp.f b/plugins/FOBOCI/dress_simple.irp.f index 9df94140..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 diff --git a/plugins/FOBOCI/fobo_scf.irp.f b/plugins/FOBOCI/fobo_scf.irp.f index 1b134733..8656b633 100644 --- a/plugins/FOBOCI/fobo_scf.irp.f +++ b/plugins/FOBOCI/fobo_scf.irp.f @@ -1,8 +1,8 @@ program foboscf implicit none + call run_prepare no_oa_or_av_opt = .True. touch no_oa_or_av_opt - call run_prepare call routine_fobo_scf call save_mos @@ -10,6 +10,8 @@ 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 @@ -22,6 +24,28 @@ subroutine routine_fobo_scf 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 diff --git a/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f b/plugins/FOBOCI/foboci_lmct_mlct_threshold_old.irp.f index b406284f..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,11 +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*,'--------------------------' @@ -55,7 +55,7 @@ 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 allocate(dressing_matrix(N_det_generators,N_det_generators)) @@ -81,6 +81,9 @@ subroutine FOBOCI_lmct_mlct_old_thr 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 @@ -148,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 @@ -172,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)) @@ -187,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 @@ -221,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)) @@ -263,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 @@ -297,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)) @@ -337,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/new_approach.irp.f b/plugins/FOBOCI/new_approach.irp.f index 2e551dcd..8e2f2e53 100644 --- a/plugins/FOBOCI/new_approach.irp.f +++ b/plugins/FOBOCI/new_approach.irp.f @@ -46,7 +46,7 @@ subroutine new_approach verbose = .True. - threshold = threshold_singles + threshold = threshold_lmct print*,'threshold = ',threshold thr = 1.d-12 print*,'' @@ -623,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/routines_foboci.irp.f b/plugins/FOBOCI/routines_foboci.irp.f index 4def99e2..4aca60d7 100644 --- a/plugins/FOBOCI/routines_foboci.irp.f +++ b/plugins/FOBOCI/routines_foboci.irp.f @@ -387,14 +387,14 @@ 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,(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,(tmp(iorb,jorb)) endif @@ -519,14 +519,14 @@ 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,(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,(tmp(iorb,jorb)) endif @@ -607,3 +607,206 @@ end 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 From 470a6d51c9fd121a0dcc91658e68e7fff1b57474 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Mon, 14 Mar 2016 16:21:05 +0100 Subject: [PATCH 05/12] rm FOBOCI/H_apply_dressed_autonom_bis.irp.f --- .../FOBOCI/H_apply_dressed_autonom_bis.irp.f | 385 ------------------ 1 file changed, 385 deletions(-) delete mode 100644 plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f diff --git a/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f b/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f deleted file mode 100644 index a9b05fc7..00000000 --- a/plugins/FOBOCI/H_apply_dressed_autonom_bis.irp.f +++ /dev/null @@ -1,385 +0,0 @@ -subroutine H_apply_dressed_pert_monoexc_bis(key_in, hole_1,particl_1,i_generator,iproc_in , delta_ij_generators_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input ) - use omp_lib - use bitmasks - implicit none - BEGIN_DOC - ! Generate all single excitations of key_in using the bit masks of holes and - ! particles. - ! Assume N_int is already provided. - END_DOC - integer,parameter :: size_max = 3072 - - integer, intent(in) :: Ndet_generators,n_det_input - double precision, intent(inout) :: delta_ij_generators_(n_det_input,n_det_input),E_ref - - integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) - integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) - - integer ,intent(in) :: i_generator - integer(bit_kind),intent(in) :: key_in(N_int,2) - integer(bit_kind),intent(in) :: hole_1(N_int,2), particl_1(N_int,2) - integer, intent(in) :: iproc_in - integer(bit_kind),allocatable :: keys_out(:,:,:) - integer(bit_kind),allocatable :: hole_save(:,:) - integer(bit_kind),allocatable :: key(:,:),hole(:,:), particle(:,:) - integer(bit_kind),allocatable :: hole_tmp(:,:), particle_tmp(:,:) - integer(bit_kind),allocatable :: hole_2(:,:), particl_2(:,:) - integer :: ii,i,jj,j,k,ispin,l - integer,allocatable :: occ_particle(:,:), occ_hole(:,:) - integer,allocatable :: occ_particle_tmp(:,:), occ_hole_tmp(:,:) - integer,allocatable :: ib_jb_pairs(:,:) - integer :: kk,pp,other_spin,key_idx - integer :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2) - integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2) - logical :: is_a_two_holes_two_particles - integer(bit_kind), allocatable :: key_union_hole_part(:) - - integer, allocatable :: ia_ja_pairs(:,:,:) - logical, allocatable :: array_pairs(:,:) - double precision :: diag_H_mat_elem - integer(omp_lock_kind), save :: lck, ifirst=0 - integer :: iproc - - logical :: check_double_excitation - logical :: is_a_1h1p - logical :: is_a_1h - logical :: is_a_1p - iproc = iproc_in - - check_double_excitation = .True. - - check_double_excitation = .False. - - - - - if (ifirst == 0) then - ifirst=1 -!!$ call omp_init_lock(lck) - endif - - - - PROVIDE elec_num_tab -! !$OMP PARALLEL DEFAULT(SHARED) & -! !$OMP PRIVATE(i,j,k,l,keys_out,hole,particle, & -! !$OMP occ_particle,occ_hole,j_a,k_a,other_spin, & -! !$OMP hole_save,ispin,jj,l_a,ib_jb_pairs,array_pairs, & -! !$OMP accu,i_a,hole_tmp,particle_tmp,occ_particle_tmp, & -! !$OMP occ_hole_tmp,key_idx,i_b,j_b,key,N_elec_in_key_part_1,& -! !$OMP N_elec_in_key_hole_1,N_elec_in_key_part_2, & -! !$OMP N_elec_in_key_hole_2,ia_ja_pairs,key_union_hole_part) & -! !$OMP SHARED(key_in,N_int,elec_num_tab,mo_tot_num, & -! !$OMP hole_1, particl_1, hole_2, particl_2, & -! !$OMP elec_alpha_num,i_generator) FIRSTPRIVATE(iproc) -!!$ iproc = omp_get_thread_num() - allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), & - key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),& - particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), & - occ_hole(N_int*bit_kind_size,2), occ_particle_tmp(N_int*bit_kind_size,2),& - occ_hole_tmp(N_int*bit_kind_size,2),key_union_hole_part(N_int)) - - !!!! First couple hole particle - do j = 1, N_int - hole(j,1) = iand(hole_1(j,1),key_in(j,1)) - hole(j,2) = iand(hole_1(j,2),key_in(j,2)) - particle(j,1) = iand(xor(particl_1(j,1),key_in(j,1)),particl_1(j,1)) - particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2)) - enddo - - call bitstring_to_list(particle(1,1),occ_particle(1,1),N_elec_in_key_part_1(1),N_int) - call bitstring_to_list(particle(1,2),occ_particle(1,2),N_elec_in_key_part_1(2),N_int) - call bitstring_to_list(hole (1,1),occ_hole (1,1),N_elec_in_key_hole_1(1),N_int) - call bitstring_to_list(hole (1,2),occ_hole (1,2),N_elec_in_key_hole_1(2),N_int) - allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2)) - - do ispin=1,2 - i=0 - do ii=N_elec_in_key_hole_1(ispin),1,-1 ! hole - i_a = occ_hole(ii,ispin) - do jj=1,N_elec_in_key_part_1(ispin) !particule - j_a = occ_particle(jj,ispin) - i += 1 - ia_ja_pairs(1,i,ispin) = i_a - ia_ja_pairs(2,i,ispin) = j_a - enddo - enddo - ia_ja_pairs(1,0,ispin) = i - enddo - - key_idx = 0 - - integer :: i_a,j_a,i_b,j_b,k_a,l_a,k_b,l_b - integer(bit_kind) :: test(N_int,2) - double precision :: accu - accu = 0.d0 - integer :: jjtest,na,nb - do ispin=1,2 - other_spin = iand(ispin,1)+1 -! !$OMP DO SCHEDULE (static) - do ii=1,ia_ja_pairs(1,0,ispin) - i_a = ia_ja_pairs(1,ii,ispin) - j_a = ia_ja_pairs(2,ii,ispin) - hole = key_in - k = ishft(i_a-1,-bit_kind_shift)+1 - j = i_a-ishft(k-1,bit_kind_shift)-1 - - hole(k,ispin) = ibclr(hole(k,ispin),j) - k_a = ishft(j_a-1,-bit_kind_shift)+1 - l_a = j_a-ishft(k_a-1,bit_kind_shift)-1 - - hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) - na = 0 - nb = 0 -! if (is_a_1h(hole)) then -! cycle -! endif -! if (is_a_1p(hole)) then -! cycle -! endif - - - key_idx += 1 - do k=1,N_int - keys_out(k,1,key_idx) = hole(k,1) - keys_out(k,2,key_idx) = hole(k,2) - enddo - if (key_idx == size_max) then - call standard_dress_bis(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) - key_idx = 0 - endif - enddo ! ii -! !$OMP ENDDO NOWAIT - enddo ! ispin - call standard_dress_bis(delta_ij_generators_,size_max,Ndet_generators,i_generator,key_idx,keys_out,N_int,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) - - deallocate (ia_ja_pairs, & - keys_out, hole_save, & - key,hole, particle, hole_tmp,& - particle_tmp, occ_particle, & - occ_hole, occ_particle_tmp,& - occ_hole_tmp,key_union_hole_part) -! !$OMP END PARALLEL - - -end - - -subroutine H_apply_dressed_pertk_single(delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,psi_det_input,n_det_input) - implicit none - use omp_lib - use bitmasks - BEGIN_DOC - ! Calls H_apply on the HF determinant and selects all connected single and double - ! excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - END_DOC - - - integer, intent(in) :: Ndet_generators,n_det_input - integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) - integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) - double precision, intent(inout) :: delta_ij_(n_det_input,n_det_input),E_ref - - - - integer :: i_generator, nmax - double precision :: wall_0, wall_1 - integer(omp_lock_kind) :: lck - integer(bit_kind), allocatable :: mask(:,:,:) - integer :: ispin, k - integer :: iproc - - - PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map - - nmax = mod( Ndet_generators,nproc ) - - -! !$ call omp_init_lock(lck) - call start_progress(Ndet_generators,'Selection (norm)',0.d0) - - call wall_time(wall_0) - - iproc = 0 - allocate( mask(N_int,2,6) ) - do i_generator=1,nmax - - progress_bar(1) = i_generator - - if (abort_here) then - exit - endif - - - -! ! Create bit masks for holes and particles - do ispin=1,2 - do k=1,N_int - mask(k,ispin,s_hole) = & - iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,s_part) = & - iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), & - not(psi_det_generators_input(k,ispin,i_generator)) ) - mask(k,ispin,d_hole1) = & - iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,d_part1) = & - iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), & - not(psi_det_generators_input(k,ispin,i_generator)) ) - mask(k,ispin,d_hole2) = & - iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,d_part2) = & - iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), & - not(psi_det_generators_input(k,ispin,i_generator)) ) - enddo - enddo - call H_apply_dressed_pert_monoexc(psi_det_generators_input(1,1,i_generator), & - mask(1,1,s_hole ), mask(1,1,s_part ), & - i_generator, iproc , delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input) - call wall_time(wall_1) - - if (wall_1 - wall_0 > 2.d0) then - write(output_determinants,*) & - 100.*float(i_generator)/float(Ndet_generators), '% in ', wall_1-wall_0, 's' - wall_0 = wall_1 - endif - enddo - - deallocate( mask ) - -! !$OMP PARALLEL DEFAULT(SHARED) & -! !$OMP PRIVATE(i_generator,wall_1,wall_0,ispin,k,mask,iproc) - call wall_time(wall_0) -! !$ iproc = omp_get_thread_num() - allocate( mask(N_int,2,6) ) -! !$OMP DO SCHEDULE(dynamic,1) - do i_generator=nmax+1,Ndet_generators - if (iproc == 0) then - progress_bar(1) = i_generator - endif - if (abort_here) then - cycle - endif - - - - ! Create bit masks for holes and particles - do ispin=1,2 - do k=1,N_int - mask(k,ispin,s_hole) = & - iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,s_part) = & - iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), & - not(psi_det_generators_input(k,ispin,i_generator)) ) - mask(k,ispin,d_hole1) = & - iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,d_part1) = & - iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), & - not(psi_det_generators_input(k,ispin,i_generator)) ) - mask(k,ispin,d_hole2) = & - iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), & - psi_det_generators_input(k,ispin,i_generator) ) - mask(k,ispin,d_part2) = & - iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), & - not (psi_det_generators_input(k,ispin,i_generator)) ) - enddo - enddo - - if(.True.)then - call H_apply_dressed_pert_monoexc(psi_det_generators_input(1,1,i_generator), & - mask(1,1,s_hole ), mask(1,1,s_part ), & - i_generator, iproc , delta_ij_, Ndet_generators,psi_det_generators_input,E_ref,n_det_input,psi_det_input) - endif -! !$ call omp_set_lock(lck) - call wall_time(wall_1) - - if (wall_1 - wall_0 > 2.d0) then - write(output_determinants,*) & - 100.*float(i_generator)/float(Ndet_generators), '% in ', wall_1-wall_0, 's' - wall_0 = wall_1 - endif -! !$ call omp_unset_lock(lck) - enddo -! !$OMP END DO - deallocate( mask ) -! !$OMP END PARALLEL -! !$ call omp_destroy_lock(lck) - - abort_here = abort_all - call stop_progress - - - - -end - - -subroutine standard_dress_bis(delta_ij_generators_,size_buffer,Ndet_generators,i_generator,n_selected,det_buffer,Nint,iproc,psi_det_generators_input,E_ref,psi_det_input,n_det_input) - use bitmasks - implicit none - - integer, intent(in) :: i_generator,n_selected, Nint, iproc,n_det_input - integer, intent(in) :: Ndet_generators,size_buffer - double precision, intent(inout) :: delta_ij_generators_(n_det_input,n_det_input),E_ref - - integer(bit_kind), intent(in) :: det_buffer(Nint,2,size_buffer) - integer(bit_kind), intent(in) :: psi_det_generators_input(N_int,2,Ndet_generators) - integer(bit_kind), intent(in) :: psi_det_input(N_int,2,n_det_input) - integer :: i,j,k,m - integer :: new_size - integer :: degree(n_det_input) - integer :: idx(0:n_det_input) - logical :: good - - integer :: c_ref - integer :: connected_to_ref - - - double precision :: hka, haa - double precision :: haj - double precision :: f - integer :: connected_to_ref_by_mono - logical :: is_in_wavefunction - double precision :: H_array(n_det_input) - double precision :: contrib,lambda_i,accu - integer :: number_of_holes,n_h, number_of_particles,n_p - - do i=1,n_selected - c_ref = connected_to_ref_by_mono(det_buffer(1,1,i),psi_det_generators_input,N_int,i_generator,Ndet_generators) - if (c_ref /= 0) then - cycle - endif - if (is_in_wavefunction(det_buffer(1,1,i),Nint)) then - cycle - endif - print* - n_h = number_of_holes(det_buffer(1,1,i)) - n_p = number_of_particles(det_buffer(1,1,i)) - print*,'n_h,n_p = ',n_h,n_p - call get_excitation_degree_vector(psi_det_input,det_buffer(1,1,i),degree,N_int,n_det_input,idx) - H_array = 0.d0 - do k=1,idx(0) - call i_h_j(det_buffer(1,1,i),psi_det_input(1,1,idx(k)),Nint,hka) - H_array(idx(k)) = hka - enddo - - call i_h_j(det_buffer(1,1,i),det_buffer(1,1,i),Nint,haa) - f = 1.d0/(E_ref-haa) - - lambda_i = f - do k=1,idx(0) - contrib = H_array(idx(k)) * H_array(idx(k)) * lambda_i - delta_ij_generators_(idx(k), idx(k)) += contrib - do j=k+1,idx(0) - contrib = H_array(idx(k)) * H_array(idx(j)) * lambda_i - delta_ij_generators_(idx(k), idx(j)) += contrib - delta_ij_generators_(idx(j), idx(k)) += contrib - enddo - enddo - enddo -end - From 34dce5e161c5539604e437e046d50c2ff626c480 Mon Sep 17 00:00:00 2001 From: Lorenzo Tenti Date: Mon, 14 Mar 2016 17:32:20 +0100 Subject: [PATCH 06/12] Now print_mo works with the new version of Molden, loc_cele fixed. --- config/ifort.cfg | 2 +- configure | 6 + ocaml/qp_edit.ml | 36 ++-- plugins/Molden/print_mo.irp.f | 6 +- plugins/loc_cele/loc.f | 4 +- plugins/loc_cele/loc_cele.irp.f | 336 ++++++++++++++++++++++++-------- 6 files changed, 288 insertions(+), 102 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index cc848cba..5653ff1c 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 : -xHost -O2 -ip -ftz -g +FCFLAGS : -O2 -xHost -ip -ftz # Profiling flags ################# diff --git a/configure b/configure index b5c46269..4e5f3732 100755 --- a/configure +++ b/configure @@ -251,6 +251,12 @@ def checking(d_dependency): except (OSError,subprocess.CalledProcessError): default_path = d_info[binary].default_path + if binary == 'f77zmq': + print ' ------------------- ' + print ' ------------------- ' + print default_path + print ' ------------------- ' + print ' ------------------- ' if os.path.exists(default_path): return default_path else: diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index 53e3ea59..05a442e4 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -17,12 +17,12 @@ type keyword = | Electrons | Mo_basis | Nuclei -| Hartree_fock -| Pseudo | Integrals_bielec +| Determinants | Perturbation | Properties -| Determinants +| Hartree_fock +| Pseudo ;; @@ -32,12 +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" +| Determinants -> "Determinants" | Perturbation -> "Perturbation" | Properties -> "Properties" -| Determinants -> "Determinants" +| Hartree_fock -> "Hartree_fock" +| Pseudo -> "Pseudo" ;; @@ -86,18 +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) + | Determinants -> + f Determinants.(read, to_rst) | Perturbation -> f Perturbation.(read, to_rst) | Properties -> f Properties.(read, to_rst) - | Determinants -> - f Determinants.(read, to_rst) + | Hartree_fock -> + f Hartree_fock.(read, to_rst) + | Pseudo -> + f Pseudo.(read, to_rst) end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") @@ -135,12 +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 + | Determinants -> write Determinants.(of_rst, write) s | Perturbation -> write Perturbation.(of_rst, write) s | Properties -> write Properties.(of_rst, write) s - | Determinants -> write Determinants.(of_rst, write) s + | Hartree_fock -> write Hartree_fock.(of_rst, write) s + | Pseudo -> write Pseudo.(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 @@ -188,12 +188,12 @@ let run check_only ezfio_filename = Nuclei ; Ao_basis; Electrons ; - Hartree_fock ; - Pseudo ; Integrals_bielec ; + Determinants ; Perturbation ; Properties ; - Determinants ; + Hartree_fock ; + Pseudo ; Mo_basis; Determinants_by_hand ; ] 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/loc_cele/loc.f b/plugins/loc_cele/loc.f index e2439b7f..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=100 + 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 12f90b64..3c42517a 100644 --- a/plugins/loc_cele/loc_cele.irp.f +++ b/plugins/loc_cele/loc_cele.irp.f @@ -92,21 +92,250 @@ - 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(1,1) = 20 ! the first mo to be rotated is the 19 th MO - irot(2,1) = 21 ! the first mo to be rotated is the 20 th MO - irot(3,1) = 22 ! etc.... - irot(4,1) = 23 ! - irot(5,1) = 24 ! - irot(6,1) = 25 ! +! irot(2,1) = 21 ! the first mo to be rotated is the 21 th MO +! irot(3,1) = 22 ! etc.... +! irot(4,1) = 23 ! +! irot(5,1) = 24 ! +! irot(6,1) = 25 ! + +!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 ! you define the guess vectors that you want ! the new MO to be close to @@ -120,68 +349,22 @@ ! own guess vectors for the MOs ! The new MOs are provided in output ! in the same order than the guess MOs - cmoref(3,1,1) = 1.d0 ! - 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 isym=1,nsym - - if (nrot(isym).eq.0) cycle - - do i=1,ao_num - - s(i,i,isym)=1.d0 - - do j=1,ao_num - - if (i.ne.j) s(i,j,isym)=0.d0 - - ddum(i,j)=0.d0 - - do k=1,nmo(isym) - - ddum(i,j)=ddum(i,j)+cmo(i,k,isym)*cmo(j,k,isym) - - enddo - + do i = 1, ao_num + do j =1, ao_num + s(i,j,1) = ao_overlap(i,j) enddo - - enddo - - call dgesv(ao_num,ao_num,ddum,id1,ipiv,s(1,1,isym),id1,info) - - if (info.ne.0) then - - write (6,*) 'Something wrong in dgsev',isym - - stop - - endif - - - enddo @@ -219,20 +402,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 @@ -262,7 +438,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) @@ -280,7 +456,7 @@ enddo !big loop over symmetry - 10 format (4E20.12) + 10 format (4E18.12) ! Now we copyt the newcmo into the mo_coef @@ -293,9 +469,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 From 87f57a1f795367a086fe5cf178b04b6600ea718e Mon Sep 17 00:00:00 2001 From: Lorenzo Tenti Date: Mon, 14 Mar 2016 18:08:56 +0100 Subject: [PATCH 07/12] Deleted debug prints in configure --- configure | 6 ------ 1 file changed, 6 deletions(-) diff --git a/configure b/configure index 0f414621..b217cbea 100755 --- a/configure +++ b/configure @@ -251,12 +251,6 @@ def checking(d_dependency): except (OSError,subprocess.CalledProcessError): default_path = d_info[binary].default_path - if binary == 'f77zmq': - print ' ------------------- ' - print ' ------------------- ' - print default_path - print ' ------------------- ' - print ' ------------------- ' if os.path.exists(default_path): return default_path else: From 7c01f2c00373a55bf3b56a83f43e537c68d676cf Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 15 Mar 2016 01:16:24 +0100 Subject: [PATCH 08/12] moved Molden/aos.irp.f in AO_Basis/aos.irp.f --- plugins/Molden/NEEDED_CHILDREN_MODULES | 2 +- plugins/Molden/aos.irp.f | 196 ------------------------- src/AO_Basis/aos.irp.f | 173 ++++++++++++++++++++++ 3 files changed, 174 insertions(+), 197 deletions(-) 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 index 71f8c5b8..e69de29b 100644 --- a/plugins/Molden/aos.irp.f +++ b/plugins/Molden/aos.irp.f @@ -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/src/AO_Basis/aos.irp.f b/src/AO_Basis/aos.irp.f index aa805093..acc78912 100644 --- a/src/AO_Basis/aos.irp.f +++ b/src/AO_Basis/aos.irp.f @@ -170,3 +170,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 From 1b376ec13506ed0a82684ca6f6ade2c1f58c4e81 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 15 Mar 2016 01:16:56 +0100 Subject: [PATCH 09/12] rm Molden/aos.irp.f --- plugins/Molden/aos.irp.f | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 plugins/Molden/aos.irp.f diff --git a/plugins/Molden/aos.irp.f b/plugins/Molden/aos.irp.f deleted file mode 100644 index e69de29b..00000000 From 5065178bb155491a80c98feaba0bcd26aebeb7b6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 19 Mar 2016 18:22:09 +0100 Subject: [PATCH 10/12] QP Logo --- data/qp.png | Bin 0 -> 42781 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 data/qp.png 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 Date: Sat, 19 Mar 2016 18:25:04 +0100 Subject: [PATCH 11/12] QP Image --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index e313f444..57de7ded 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,11 @@ Quantum package =============== + + [![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) - +![QP](https://raw.githubusercontent.com/LCPQ/quantum_package/master/data/qp.png)] Set of quantum chemistry programs and libraries. (under GNU GENERAL PUBLIC LICENSE v2) From 3b14123cad11ac08eb817de5d33d0bca2783c419 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 19 Mar 2016 18:26:39 +0100 Subject: [PATCH 12/12] Update README.md --- README.md | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/README.md b/README.md index 57de7ded..5372b7ac 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,6 @@ -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) -![QP](https://raw.githubusercontent.com/LCPQ/quantum_package/master/data/qp.png)] Set of quantum chemistry programs and libraries. (under GNU GENERAL PUBLIC LICENSE v2)