From 949ff3ce3afa2ce21e7dcc44a504e1499b576c2d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 13 Jan 2020 11:01:10 -0600 Subject: [PATCH 001/256] added periodic ao bielec map --- src/ao_two_e_ints/map_integrals.irp.f | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 5272096d..e1a49357 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -16,6 +16,19 @@ BEGIN_PROVIDER [ type(map_type), ao_integrals_map ] print*, 'AO map initialized : ', sze END_PROVIDER +BEGIN_PROVIDER [ type(map_type), ao_integrals_map_periodic ] + implicit none + BEGIN_DOC + ! AO integrals + END_DOC + integer(key_kind) :: key_max + integer(map_size_kind) :: sze + call two_e_integrals_index_2fold(ao_num,ao_num,ao_num,ao_num,key_max) + sze = key_max + call map_init(ao_integrals_map_periodic,sze) + print*, 'complex AO map initialized : ', sze +END_PROVIDER + subroutine two_e_integrals_index(i,j,k,l,i1) use map_module implicit none @@ -425,7 +438,7 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) type(map_type), intent(inout) :: map integer :: ii complex(integral_kind) :: tmp - PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min + PROVIDE ao_two_e_integrals_in_map_periodic ao_integrals_cache_periodic ao_integrals_cache_min !DIR$ FORCEINLINE if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then tmp = (0.d0,0.d0) @@ -507,7 +520,7 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) END_DOC implicit none integer, intent(in) :: j,k,l, sze - complex(integral_kind), intent(out) :: out_val(sze) + complex*16, intent(out) :: out_val(sze) integer :: i integer(key_kind) :: hash @@ -515,14 +528,14 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) PROVIDE ao_two_e_integrals_in_map ao_integrals_map thresh = ao_integrals_threshold - if (ao_overlap_abs(j,l) < thresh) then - out_val = 0.d0 + if (ao_overlap_abs_periodic(j,l) < thresh) then + out_val = (0.d0,0.d0) return endif - double precision :: get_ao_two_e_integral + complex*16 :: get_ao_two_e_integral_periodic do i=1,sze - out_val(i) = get_ao_two_e_integral(i,j,k,l,ao_integrals_map) + out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map) enddo end From 4e933906323ef96abf570f594403b45fcf9ec611 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 22 Jan 2020 11:35:41 -0600 Subject: [PATCH 002/256] working on two e ints --- src/ao_one_e_ints/ao_overlap.irp.f | 11 +- src/ao_one_e_ints/kin_ao_ints.irp.f | 4 +- src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f | 30 ++ src/ao_two_e_ints/map_integrals.irp.f | 479 ++++++++---------- src/ao_two_e_ints/two_e_integrals.irp.f | 142 +++--- src/utils/map_module.f90 | 19 +- .../export_integrals_ao_periodic.irp.f | 212 ++++++++ .../import_integrals_ao_periodic.irp.f | 97 ++-- 8 files changed, 618 insertions(+), 376 deletions(-) create mode 100644 src/utils_periodic/export_integrals_ao_periodic.irp.f diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index d7300936..6510fd23 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -75,7 +75,16 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ] BEGIN_DOC ! Imaginary part of the overlap END_DOC - ao_overlap_imag = 0.d0 + if (read_ao_integrals_overlap) then + call ezfio_get_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) + print *, 'AO overlap integrals read from disk' + else + ao_overlap_imag = 0.d0 + endif + if (write_ao_integrals_overlap) then + call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) + print *, 'AO overlap integrals written to disk' + endif END_PROVIDER BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ] diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f index 4f117deb..442c1f88 100644 --- a/src/ao_one_e_ints/kin_ao_ints.irp.f +++ b/src/ao_one_e_ints/kin_ao_ints.irp.f @@ -160,13 +160,13 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals_imag, (ao_num,ao_num)] integer :: i,j,k,l if (read_ao_integrals_kinetic) then - call ezfio_get_ao_one_e_ints_ao_integrals_kinetic(ao_kinetic_integrals_imag) + call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) print *, 'AO kinetic integrals read from disk' else print *, irp_here, ': Not yet implemented' endif if (write_ao_integrals_kinetic) then - call ezfio_set_ao_one_e_ints_ao_integrals_kinetic(ao_kinetic_integrals_imag) + call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) print *, 'AO kinetic integrals written to disk' endif END_PROVIDER diff --git a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f index 988bbe0a..a92ba1f4 100644 --- a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f @@ -27,6 +27,36 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)] END_PROVIDER +BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_imag, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Imaginary part of the pseudo_integrals + END_DOC + if (read_ao_integrals_pseudo) then + call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) + print *, 'AO pseudo_integrals integrals read from disk' + else + ao_pseudo_integrals_imag = 0.d0 + endif + if (write_ao_integrals_pseudo) then + call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) + print *, 'AO pseudo_integrals integrals written to disk' + endif +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Overlap for complex AOs + END_DOC + integer :: i,j + do j=1,ao_num + do i=1,ao_num + ao_pseudo_integrals_complex(i,j) = dcmplx( ao_pseudo_integrals(i,j), ao_pseudo_integrals_imag(i,j) ) + enddo + enddo +END_PROVIDER + BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)] implicit none BEGIN_DOC diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index e1a49357..e9d2740c 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -4,6 +4,7 @@ use map_module !! ====== BEGIN_PROVIDER [ type(map_type), ao_integrals_map ] +&BEGIN_PROVIDER [ type(map_type), ao_integrals_map_2 ] implicit none BEGIN_DOC ! AO integrals @@ -11,22 +12,17 @@ BEGIN_PROVIDER [ type(map_type), ao_integrals_map ] integer(key_kind) :: key_max integer(map_size_kind) :: sze call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max) - sze = key_max - call map_init(ao_integrals_map,sze) - print*, 'AO map initialized : ', sze -END_PROVIDER - -BEGIN_PROVIDER [ type(map_type), ao_integrals_map_periodic ] - implicit none - BEGIN_DOC - ! AO integrals - END_DOC - integer(key_kind) :: key_max - integer(map_size_kind) :: sze - call two_e_integrals_index_2fold(ao_num,ao_num,ao_num,ao_num,key_max) - sze = key_max - call map_init(ao_integrals_map_periodic,sze) - print*, 'complex AO map initialized : ', sze + if (is_periodic) then + sze = key_max*2 + call map_init(ao_integrals_map,sze) + call map_init(ao_integrals_map_2,sze) + print*, 'AO maps initialized (complex): ', 2*sze + else + sze = key_max + call map_init(ao_integrals_map,sze) + call map_init(ao_integrals_map_2,1_map_size_kind) + print*, 'AO map initialized : ', sze + endif END_PROVIDER subroutine two_e_integrals_index(i,j,k,l,i1) @@ -34,7 +30,7 @@ subroutine two_e_integrals_index(i,j,k,l,i1) implicit none BEGIN_DOC ! Gives a unique index for i,j,k,l using permtuation symmetry. -! i <-> k, j <-> l, and (i,k) <-> (j,l) for non-periodic systems +! i <-> k, j <-> l, and (i,k) <-> (j,l) END_DOC integer, intent(in) :: i,j,k,l integer(key_kind), intent(out) :: i1 @@ -50,6 +46,28 @@ subroutine two_e_integrals_index(i,j,k,l,i1) i1 = i1+shiftr(i2*i2-i2,1) end +subroutine two_e_integrals_index_periodic(i,j,k,l,i1,p,q) + use map_module + implicit none + BEGIN_DOC +! Gives a unique index for i,j,k,l using permtuation symmetry. +! i <-> k, j <-> l, and (i,k) <-> (j,l) + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind), intent(out) :: i1 + integer(key_kind) :: r,s,i2 + integer(key_kind),intent(out) :: p,q + p = min(i,k) + r = max(i,k) + p = p+shiftr(r*r-r,1) + q = min(j,l) + s = max(j,l) + q = q+shiftr(s*s-s,1) + i1 = min(p,q) + i2 = max(p,q) + i1 = i1+shiftr(i2*i2-i2,1) +end + subroutine two_e_integrals_index_reverse(i,j,k,l,i1) @@ -143,152 +161,6 @@ end -subroutine ao_idx2_sq(i,j,ij) - implicit none - integer, intent(in) :: i,j - integer, intent(out) :: ij - if (ij) then - ij=(i-1)*(i-1)+2*j-mod(i,2) - else - ij=i*i - endif -end - -subroutine idx2_tri_int(i,j,ij) - implicit none - integer, intent(in) :: i,j - integer, intent(out) :: ij - integer :: p,q - p = max(i,j) - q = min(i,j) - ij = q+ishft(p*p-p,-1) -end - -subroutine ao_idx2_tri_key(i,j,ij) - use map_module - implicit none - integer, intent(in) :: i,j - integer(key_kind), intent(out) :: ij - integer(key_kind) :: p,q - p = max(i,j) - q = min(i,j) - ij = q+ishft(p*p-p,-1) -end - -subroutine two_e_integrals_index_2fold(i,j,k,l,i1) - use map_module - implicit none - integer, intent(in) :: i,j,k,l - integer(key_kind), intent(out) :: i1 - integer :: ik,jl - - call ao_idx2_sq(i,k,ik) - call ao_idx2_sq(j,l,jl) - call ao_idx2_tri_key(ik,jl,i1) -end - -subroutine ao_idx2_sq_rev(i,k,ik) - BEGIN_DOC - ! reverse square compound index - END_DOC -! p = ceiling(dsqrt(dble(ik))) -! q = ceiling(0.5d0*(dble(ik)-dble((p-1)*(p-1)))) -! if (mod(ik,2)==0) then -! k=p -! i=q -! else -! i=p -! k=q -! endif - integer, intent(in) :: ik - integer, intent(out) :: i,k - integer :: pq(0:1),i1,i2 - pq(0) = ceiling(dsqrt(dble(ik))) - pq(1) = ceiling(0.5d0*(dble(ik)-dble((pq(0)-1)*(pq(0)-1)))) - i1=mod(ik,2) - i2=mod(ik+1,2) - - k=pq(i1) - i=pq(i2) -end - -subroutine ao_idx2_tri_rev_key(i,k,ik) - use map_module - BEGIN_DOC - !return i<=k - END_DOC - integer(key_kind), intent(in) :: ik - integer, intent(out) :: i,k - integer(key_kind) :: tmp_k - k = ceiling(0.5d0*(dsqrt(8.d0*dble(ik)+1.d0)-1.d0)) - tmp_k = k - i = int(ik - ishft(tmp_k*tmp_k-tmp_k,-1)) -end - -subroutine idx2_tri_rev_int(i,k,ik) - BEGIN_DOC - !return i<=k - END_DOC - integer, intent(in) :: ik - integer, intent(out) :: i,k - k = ceiling(0.5d0*(dsqrt(8.d0*dble(ik)+1.d0)-1.d0)) - i = int(ik - ishft(k*k-k,-1)) -end - -subroutine two_e_integrals_index_reverse_2fold(i,j,k,l,i1) - use map_module - implicit none - integer, intent(out) :: i(2),j(2),k(2),l(2) - integer(key_kind), intent(in) :: i1 - integer(key_kind) :: i0 - integer :: i2,i3 - i = 0 - call ao_idx2_tri_rev_key(i3,i2,i1) - - call ao_idx2_sq_rev(j(1),l(1),i2) - call ao_idx2_sq_rev(i(1),k(1),i3) - - !ijkl - i(2) = j(1) !jilk - j(2) = i(1) - k(2) = l(1) - l(2) = k(1) - -! i(3) = k(1) !klij complex conjugate -! j(3) = l(1) -! k(3) = i(1) -! l(3) = j(1) -! -! i(4) = l(1) !lkji complex conjugate -! j(4) = k(1) -! k(4) = j(1) -! l(4) = i(1) - - integer :: ii - if ( (i(1)==i(2)).and. & - (j(1)==j(2)).and. & - (k(1)==k(2)).and. & - (l(1)==l(2)) ) then - i(2) = 0 - endif -! This has been tested with up to 1000 AOs, and all the reverse indices are -! correct ! We can remove the test -! do ii=1,2 -! if (i(ii) /= 0) then -! call two_e_integrals_index_2fold(i(ii),j(ii),k(ii),l(ii),i0) -! if (i1 /= i0) then -! print *, i1, i0 -! print *, i(ii), j(ii), k(ii), l(ii) -! stop 'two_e_integrals_index_reverse_2fold failed' -! endif -! endif -! enddo -end - - - BEGIN_PROVIDER [ integer, ao_integrals_cache_min ] &BEGIN_PROVIDER [ integer, ao_integrals_cache_max ] @@ -384,32 +256,47 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] real(integral_kind) :: tmp_re, tmp_im integer(key_kind) :: idx_re,idx_im complex(integral_kind) :: integral + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl - !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) + !$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, & + !$OMP i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) do l=ao_integrals_cache_min,ao_integrals_cache_max do k=ao_integrals_cache_min,ao_integrals_cache_max do j=ao_integrals_cache_min,ao_integrals_cache_max do i=ao_integrals_cache_min,ao_integrals_cache_max !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(i,j,k,l,idx1) - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(k,l,i,j,idx2) - idx_re = min(idx1,idx2) - idx_im = max(idx1,idx2) - !DIR$ FORCEINLINE - call map_get(ao_integrals_map,idx_re,tmp_re) - if (idx_re /= idx_im) then - call map_get(ao_integrals_map,idx_im,tmp_im) - if (idx1 < idx2) then + call two_e_integrals_index(i,j,k,l,idx1) + ilek = (i.le.k) + jlel = (j.le.l) + idx1 = 2*idx1 - 1 + if (ilek.eqv.jlel) then !map1 + !TODO: merge these calls using map_get_2 + call map_get(ao_integrals_map,idx1,tmp_re) + call map_get(ao_integrals_map,idx1+1,tmp_im) + if (ilek) then integral = dcmplx(tmp_re,tmp_im) else integral = dcmplx(tmp_re,-tmp_im) endif - else - tmp_im = 0.d0 - integral = dcmplx(tmp_re,tmp_im) - endif + else !map2 + !TODO: merge these calls using map_get_2 + call map_get(ao_integrals_map_2,idx1,tmp_re) + call map_get(ao_integrals_map_2,idx1+1,tmp_im) + p = min(i,k) + r = max(i,k) + ik = p+shiftr(r*r-r,1) + q = min(j,l) + s = max(j,l) + jl = q+shiftr(s*s-s,1) + iklejl = (ik.le.jl) + if (ilek.eqv.iklejl) then + integral = dcmplx(tmp_re,tmp_im) + else + integral = dcmplx(tmp_re,-tmp_im) + endif + endif ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) @@ -424,8 +311,53 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] END_PROVIDER +subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + use map_module + implicit none + BEGIN_DOC + ! get position of periodic AO integral + ! use_map1: true if integral is in first ao map, false if integral is in second ao map + ! idx: position of real part of integral in map (imag part is at idx+1) + ! sign: sign of imaginary part + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind), intent(out) :: idx + logical, intent(out) :: use_map1 + double precision, intent(out) :: sign + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl, ikeqjl + ! i.le.k, j.le.l, tri(i,k).le.tri(j,l) + !DIR$ FORCEINLINE + call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) + ilek = (i.le.k) + jlel = (j.le.l) + idx = 2*idx-1 + ikeqjl = (ik.eq.jl) + if (ilek.eqv.jlel) then !map1 + use_map1=.True. + if (ikeqjl) then + sign=0.d0 + else if (ilek) then + sign=1.d0 + else + sign=-1.d0 + endif + else !map2 + use_map1=.False. + if (ikeqjl) then + sign=0.d0 + else + iklejl = (ik.le.jl) + if (ilek.eqv.iklejl) then + sign=1.d0 + else + sign=-1.d0 + endif + endif + endif +end -complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) +complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) use map_module implicit none BEGIN_DOC @@ -435,10 +367,66 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) integer(key_kind) :: idx1,idx2 real(integral_kind) :: tmp_re, tmp_im integer(key_kind) :: idx_re,idx_im - type(map_type), intent(inout) :: map + type(map_type), intent(inout) :: map,map2 integer :: ii complex(integral_kind) :: tmp - PROVIDE ao_two_e_integrals_in_map_periodic ao_integrals_cache_periodic ao_integrals_cache_min + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl + ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) + PROVIDE ao_two_e_integrals_in_map + !DIR$ FORCEINLINE + call two_e_integrals_index(i,j,k,l,idx1) + ilek = (i.le.k) + jlel = (j.le.l) + idx1 = idx1*2-1 + if (ilek.eqv.jlel) then !map1 + !TODO: merge these calls using map_get_2 + call map_get(map,idx1,tmp_re) + call map_get(map,idx1+1,tmp_im) + if (ilek) then + tmp = dcmplx(tmp_re,tmp_im) + else + tmp = dcmplx(tmp_re,-tmp_im) + endif + else !map2 + !TODO: merge these calls using map_get_2 + call map_get(map2,idx1,tmp_re) + call map_get(map2,idx1+1,tmp_im) + p = min(i,k) + r = max(i,k) + ik = p+shiftr(r*r-r,1) + q = min(j,l) + s = max(j,l) + jl = q+shiftr(s*s-s,1) + iklejl = (ik.le.jl) + if (ilek.eqv.iklejl) then + tmp = dcmplx(tmp_re,tmp_im) + else + tmp = dcmplx(tmp_re,-tmp_im) + endif + endif + result = tmp +end + + +complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(result) + use map_module + implicit none + BEGIN_DOC + ! Gets one AO bi-electronic integral from the AO map + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind) :: idx1,idx2 + real(integral_kind) :: tmp_re, tmp_im + integer(key_kind) :: idx_re,idx_im + type(map_type), intent(inout) :: map,map2 + integer :: ii + complex(integral_kind) :: tmp + complex(integral_kind) :: get_ao_two_e_integral_periodic_simple + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl + ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) + PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min !DIR$ FORCEINLINE if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then tmp = (0.d0,0.d0) @@ -450,25 +438,7 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) ii = ior(ii, j-ao_integrals_cache_min) ii = ior(ii, i-ao_integrals_cache_min) if (iand(ii, -64) /= 0) then - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(i,j,k,l,idx1) - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(k,l,i,j,idx2) - idx_re = min(idx1,idx2) - idx_im = max(idx1,idx2) - !DIR$ FORCEINLINE - call map_get(ao_integrals_map,idx_re,tmp_re) - if (idx_re /= idx_im) then - call map_get(ao_integrals_map,idx_im,tmp_im) - if (idx1 < idx2) then - tmp = dcmplx(tmp_re,tmp_im) - else - tmp = dcmplx(tmp_re,-tmp_im) - endif - else - tmp_im = 0.d0 - tmp = dcmplx(tmp_re,tmp_im) - endif + tmp = get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) else ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) @@ -528,14 +498,14 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) PROVIDE ao_two_e_integrals_in_map ao_integrals_map thresh = ao_integrals_threshold - if (ao_overlap_abs_periodic(j,l) < thresh) then + if (ao_overlap_abs(j,l) < thresh) then out_val = (0.d0,0.d0) return endif complex*16 :: get_ao_two_e_integral_periodic do i=1,sze - out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map) + out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) enddo end @@ -554,6 +524,10 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z integer :: i integer(key_kind) :: hash double precision :: thresh,tmp + if(is_periodic) then + print*,'not implemented for periodic:',irp_here + stop -1 + endif PROVIDE ao_two_e_integrals_in_map thresh = ao_integrals_threshold @@ -598,6 +572,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out integer(key_kind) :: hash double precision :: tmp + if(is_periodic) then + print*,'not implemented for periodic:',irp_here + stop -1 + endif PROVIDE ao_two_e_integrals_in_map non_zero_int = 0 if (ao_overlap_abs(j,l) < thresh) then @@ -644,6 +622,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s integer(key_kind) :: hash double precision :: tmp + if(is_periodic) then + print*,'not implemented for periodic:',irp_here + stop -1 + endif PROVIDE ao_two_e_integrals_in_map non_zero_int = 0 if (ao_overlap_abs(j,l) < thresh) then @@ -682,7 +664,7 @@ function get_ao_map_size() BEGIN_DOC ! Returns the number of elements in the AO map END_DOC - get_ao_map_size = ao_integrals_map % n_elements + get_ao_map_size = ao_integrals_map % n_elements + ao_integrals_map_2 % n_elements end subroutine clear_ao_map @@ -692,6 +674,9 @@ subroutine clear_ao_map END_DOC call map_deinit(ao_integrals_map) FREE ao_integrals_map + call map_deinit(ao_integrals_map_2) + FREE ao_integrals_map_2 + end @@ -709,82 +694,18 @@ subroutine insert_into_ao_integrals_map(n_integrals,buffer_i, buffer_values) call map_append(ao_integrals_map, buffer_i, buffer_values, n_integrals) end +subroutine insert_into_ao_integrals_map_2(n_integrals,buffer_i, buffer_values) + use map_module + implicit none + BEGIN_DOC + ! Create new entry into AO map + END_DOC -!subroutine dump_ao_integrals(filename) -! use map_module -! implicit none -! BEGIN_DOC -! ! Save to disk the |AO| integrals -! END_DOC -! character*(*), intent(in) :: filename -! integer(cache_key_kind), pointer :: key(:) -! real(integral_kind), pointer :: val(:) -! integer*8 :: i,j, n -! if (.not.mpi_master) then -! return -! endif -! call ezfio_set_work_empty(.False.) -! open(unit=66,file=filename,FORM='unformatted') -! write(66) integral_kind, key_kind -! write(66) ao_integrals_map%sorted, ao_integrals_map%map_size, & -! ao_integrals_map%n_elements -! do i=0_8,ao_integrals_map%map_size -! write(66) ao_integrals_map%map(i)%sorted, ao_integrals_map%map(i)%map_size,& -! ao_integrals_map%map(i)%n_elements -! enddo -! do i=0_8,ao_integrals_map%map_size -! key => ao_integrals_map%map(i)%key -! val => ao_integrals_map%map(i)%value -! n = ao_integrals_map%map(i)%n_elements -! write(66) (key(j), j=1,n), (val(j), j=1,n) -! enddo -! close(66) -! -!end + integer, intent(in) :: n_integrals + integer(key_kind), intent(inout) :: buffer_i(n_integrals) + real(integral_kind), intent(inout) :: buffer_values(n_integrals) + + call map_append(ao_integrals_map_2, buffer_i, buffer_values, n_integrals) +end -!integer function load_ao_integrals(filename) -! implicit none -! BEGIN_DOC -! ! Read from disk the |AO| integrals -! END_DOC -! character*(*), intent(in) :: filename -! integer*8 :: i -! integer(cache_key_kind), pointer :: key(:) -! real(integral_kind), pointer :: val(:) -! integer :: iknd, kknd -! integer*8 :: n, j -! load_ao_integrals = 1 -! open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN') -! read(66,err=98,end=98) iknd, kknd -! if (iknd /= integral_kind) then -! print *, 'Wrong integrals kind in file :', iknd -! stop 1 -! endif -! if (kknd /= key_kind) then -! print *, 'Wrong key kind in file :', kknd -! stop 1 -! endif -! read(66,err=98,end=98) ao_integrals_map%sorted, ao_integrals_map%map_size,& -! ao_integrals_map%n_elements -! do i=0_8, ao_integrals_map%map_size -! read(66,err=99,end=99) ao_integrals_map%map(i)%sorted, & -! ao_integrals_map%map(i)%map_size, ao_integrals_map%map(i)%n_elements -! call cache_map_reallocate(ao_integrals_map%map(i),ao_integrals_map%map(i)%map_size) -! enddo -! do i=0_8, ao_integrals_map%map_size -! key => ao_integrals_map%map(i)%key -! val => ao_integrals_map%map(i)%value -! n = ao_integrals_map%map(i)%n_elements -! read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n) -! enddo -! call map_sort(ao_integrals_map) -! load_ao_integrals = 0 -! return -! 99 continue -! call map_deinit(ao_integrals_map) -! 98 continue -! stop 'Problem reading ao_integrals_map file in work/' -! -!end -! diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f index a2bde897..e3ca0566 100644 --- a/src/ao_two_e_ints/two_e_integrals.irp.f +++ b/src/ao_two_e_ints/two_e_integrals.irp.f @@ -348,77 +348,91 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ] integer :: kk, m, j1, i1, lmax character*(64) :: fmt - integral = ao_two_e_integral(1,1,1,1) double precision :: map_mb PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals - if (read_ao_two_e_integrals) then - print*,'Reading the AO integrals' - call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) - print*, 'AO integrals provided' - ao_two_e_integrals_in_map = .True. - return - endif - - print*, 'Providing the AO integrals' - call wall_time(wall_0) - call wall_time(wall_1) - call cpu_time(cpu_1) - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull - call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals') - - character(len=:), allocatable :: task - allocate(character(len=ao_num*12) :: task) - write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))' - do l=1,ao_num - write(task,fmt) (i,l, i=1,l) - integer, external :: add_task_to_taskserver - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then - stop 'Unable to add task to server' + if (is_periodic) then + if (read_ao_two_e_integrals) then + print*,'Reading the AO integrals (periodic)' + call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) + call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) + print*, 'AO integrals provided (periodic)' + ao_two_e_integrals_in_map = .True. + return + else + print*,'calculation of periodic AOs not implemented' + stop -1 endif - enddo - deallocate(task) - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - PROVIDE nproc - !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1) - i = omp_get_thread_num() - if (i==0) then - call ao_two_e_integrals_in_map_collector(zmq_socket_pull) - else - call ao_two_e_integrals_in_map_slave_inproc(i) + else + if (read_ao_two_e_integrals) then + print*,'Reading the AO integrals' + call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) + print*, 'AO integrals provided' + ao_two_e_integrals_in_map = .True. + return + endif + + integral = ao_two_e_integral(1,1,1,1) + print*, 'Providing the AO integrals' + call wall_time(wall_0) + call wall_time(wall_1) + call cpu_time(cpu_1) + + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull + call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals') + + character(len=:), allocatable :: task + allocate(character(len=ao_num*12) :: task) + write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))' + do l=1,ao_num + write(task,fmt) (i,l, i=1,l) + integer, external :: add_task_to_taskserver + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then + stop 'Unable to add task to server' endif - !$OMP END PARALLEL - - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals') - - - print*, 'Sorting the map' - call map_sort(ao_integrals_map) - call cpu_time(cpu_2) - call wall_time(wall_2) - integer(map_size_kind) :: get_ao_map_size, ao_map_size - ao_map_size = get_ao_map_size() - - print*, 'AO integrals provided:' - print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB' - print*, ' Number of AO integrals :', ao_map_size - print*, ' cpu time :',cpu_2 - cpu_1, 's' - print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )' - - ao_two_e_integrals_in_map = .True. - - if (write_ao_two_e_integrals.and.mpi_master) then - call ezfio_set_work_empty(.False.) - call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) - call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') + enddo + deallocate(task) + + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + PROVIDE nproc + !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1) + i = omp_get_thread_num() + if (i==0) then + call ao_two_e_integrals_in_map_collector(zmq_socket_pull) + else + call ao_two_e_integrals_in_map_slave_inproc(i) + endif + !$OMP END PARALLEL + + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals') + + + print*, 'Sorting the map' + call map_sort(ao_integrals_map) + call cpu_time(cpu_2) + call wall_time(wall_2) + integer(map_size_kind) :: get_ao_map_size, ao_map_size + ao_map_size = get_ao_map_size() + + print*, 'AO integrals provided:' + print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB' + print*, ' Number of AO integrals :', ao_map_size + print*, ' cpu time :',cpu_2 - cpu_1, 's' + print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )' + + ao_two_e_integrals_in_map = .True. + + if (write_ao_two_e_integrals.and.mpi_master) then + call ezfio_set_work_empty(.False.) + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') + endif endif - END_PROVIDER BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] diff --git a/src/utils/map_module.f90 b/src/utils/map_module.f90 index 98e73470..e41ee8d0 100644 --- a/src/utils/map_module.f90 +++ b/src/utils/map_module.f90 @@ -531,13 +531,30 @@ subroutine map_get(map, key, value) real(integral_kind), intent(out) :: value integer(map_size_kind) :: idx_cache integer(cache_map_size_kind) :: idx - + idx=1 ! index in tha pointers array idx_cache = shiftr(key,map_shift) !DIR$ FORCEINLINE call cache_map_get_interval(map%map(idx_cache), key, value, 1, map%map(idx_cache)%n_elements,idx) end +subroutine map_get_2(map, key, value1, value2) + use map_module + implicit none + type (map_type), intent(inout) :: map + integer(key_kind), intent(in) :: key + real(integral_kind), intent(out) :: value1, value2 + integer(map_size_kind) :: idx_cache + integer(cache_map_size_kind) :: idx + + idx=1 + ! index in tha pointers array + idx_cache = shiftr(key,map_shift) + !DIR$ FORCEINLINE + call cache_map_get_interval(map%map(idx_cache), key, value1, 1, map%map(idx_cache)%n_elements,idx) + call cache_map_get_interval(map%map(idx_cache), key+1, value2, idx+1, idx+2, idx) +end + subroutine cache_map_get_interval(map, key, value, ibegin, iend, idx) use map_module implicit none diff --git a/src/utils_periodic/export_integrals_ao_periodic.irp.f b/src/utils_periodic/export_integrals_ao_periodic.irp.f new file mode 100644 index 00000000..8d60ff49 --- /dev/null +++ b/src/utils_periodic/export_integrals_ao_periodic.irp.f @@ -0,0 +1,212 @@ +program print_integrals + call run +end + +subroutine run + use map_module + implicit none + + integer :: iunit + integer :: getunitandopen + + integer ::i,j,k,l + double precision :: integral + double precision, allocatable :: A(:,:), B(:,:) + double precision :: tmp_re, tmp_im + + integer :: n_integrals_1, n_integrals_2 + integer(key_kind), allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind), allocatable :: buffer_values_1(:), buffer_values_2(:) + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + + + +provide ao_two_e_integrals_in_map + allocate (A(ao_num,ao_num), B(ao_num,ao_num) ) + + A(1,1) = huge(1.d0) + iunit = getunitandopen('E.qp','r') + read (iunit,*,end=9) A(1,1) + 9 continue + close(iunit) + if (A(1,1) /= huge(1.d0)) then +! call ezfio_set_nuclei_nuclear_repulsion(A(1,1)) +! call ezfio_set_nuclei_io_nuclear_repulsion("Read") + print*, nuclear_repulsion,A(1,1) + endif + + A = 0.d0 + B = 0.d0 + ! iunit = getunitandopen('T.qp','r') + ! do + ! read (iunit,*,end=10) i,j, tmp_re, tmp_im + ! A(i,j) = tmp_re + ! B(i,j) = tmp_im + ! print*,ao_kinetic_integrals(i,j),A(i,j) + ! print*,ao_kinetic_integrals_imag(i,j),B(i,j) + ! if (i.ne.j) then + ! A(j,i) = tmp_re + ! B(j,i) = -tmp_im + ! print*,ao_kinetic_integrals(j,i),A(j,i) + ! print*,ao_kinetic_integrals_imag(j,i),B(j,i) + ! endif + ! enddo + ! 10 continue + ! close(iunit) +! call ezfio_set_ao_one_e_ints_ao_integrals_kinetic(A(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(B(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_io_ao_integrals_kinetic("Read") + + A = 0.d0 + B = 0.d0 + ! iunit = getunitandopen('S.qp','r') + ! do + ! read (iunit,*,end=11) i,j, tmp_re, tmp_im + ! A(i,j) = tmp_re + ! B(i,j) = tmp_im + ! print*,real(ao_overlap_complex(i,j)),A(i,j) + ! print*,imag(ao_overlap_complex(i,j)),B(i,j) + ! print*,ao_overlap_imag(i,j),B(i,j) + ! if (i.ne.j) then + ! A(j,i) = tmp_re + ! B(j,i) = -tmp_im + ! print*,real(ao_overlap_complex(j,i)),A(j,i) + ! print*,imag(ao_overlap_complex(j,i)),B(j,i) + ! print*,ao_overlap_imag(j,i),B(j,i) + ! endif + ! enddo + ! 11 continue + ! close(iunit) +! call ezfio_set_ao_one_e_ints_ao_integrals_overlap(A(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(B(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_io_ao_integrals_overlap("Read") + + A = 0.d0 + B = 0.d0 +! iunit = getunitandopen('P.qp','r') +! do +! read (iunit,*,end=14) i,j, tmp_re, tmp_im +! A(i,j) = tmp_re +! B(i,j) = tmp_im +! print*,ao_pseudo_integrals(i,j),A(i,j) +! print*,ao_pseudo_integrals_imag(i,j),B(i,j) +! ! print*,real(ao_integrals_pseudo(i,j)),A(i,j) +! ! print*,imag(ao_integrals_pseudo(i,j)),B(i,j) +! if (i.ne.j) then +! A(j,i) = tmp_re +! B(j,i) = -tmp_im +! print*,ao_pseudo_integrals(j,i),A(j,i) +! print*,ao_pseudo_integrals_imag(j,i),B(j,i) +! ! print*,real(ao_integrals_pseudo(j,i)),A(j,i) +! ! print*,imag(ao_integrals_pseudo(j,i)),B(j,i) +! endif +! enddo +! 14 continue +! close(iunit) +! call ezfio_set_ao_one_e_ints_ao_integrals_pseudo(A(1:ao_num,1:ao_num)) +! call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(B(1:ao_num,1:ao_num)) +! call ezfio_set_ao_one_e_ints_io_ao_integrals_pseudo("Read") + + A = 0.d0 + B = 0.d0 +! iunit = getunitandopen('V.qp','r') +! do +! read (iunit,*,end=12) i,j, tmp_re, tmp_im +! A(i,j) = tmp_re +! B(i,j) = tmp_im +! print*,ao_integrals_n_e(i,j),A(i,j) +! print*,ao_integrals_n_e_imag(i,j),B(i,j) +! if (i.ne.j) then +! A(j,i) = tmp_re +! B(j,i) = -tmp_im +! print*,ao_integrals_n_e(j,i),A(j,i) +! print*,ao_integrals_n_e_imag(j,i),B(j,i) +! endif +! enddo +! 12 continue +! close(iunit) +! call ezfio_set_ao_one_e_ints_ao_integrals_n_e(A(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_ao_integrals_n_e_imag(B(1:ao_num, 1:ao_num)) +! call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e("Read") + complex*16 :: int2e_tmp1,int2e_tmp2,get_ao_two_e_integral_periodic_simple,get_ao_two_e_integral_periodic + double precision :: tmp3,tmp4,tmp5,tmp6 + allocate(buffer_i_1(ao_num**3), buffer_values_1(ao_num**3)) + allocate(buffer_i_2(ao_num**3), buffer_values_2(ao_num**3)) + iunit = getunitandopen('W.qp','r') + n_integrals_1=0 + n_integrals_2=0 + buffer_values_1 = 0.d0 + buffer_values_2 = 0.d0 + do + read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im + int2e_tmp1 = get_ao_two_e_integral_periodic_simple(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + int2e_tmp2 = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + print'(4(I4),3(E15.7))',i,j,k,l,tmp_re,real(int2e_tmp1),real(int2e_tmp2) + print'(4(I4),3(E15.7))',i,j,k,l,tmp_im,imag(int2e_tmp1),imag(int2e_tmp2) + call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + print*,use_map1,idx_tmp,sign + call map_get(ao_integrals_map,idx_tmp,tmp3) + call map_get(ao_integrals_map_2,idx_tmp,tmp4) + call map_get(ao_integrals_map,idx_tmp+1,tmp5) + call map_get(ao_integrals_map_2,idx_tmp+1,tmp6) + print*,tmp3,tmp4 + print*,tmp5,tmp6 +! if (use_map1) then +! n_integrals_1 += 1 +! buffer_i_1(n_integrals_1-1)=idx_tmp +! buffer_values_1(n_integrals_1-1)=tmp_re +! if (sign.ne.0.d0) then +! n_integrals_1 += 1 +! buffer_i_1(n_integrals_2)=idx_tmp+1 +! buffer_values_1(n_integrals_1)=tmp_im*sign +! endif +! if (n_integrals_1 >= size(buffer_i_1)-1) then +!! call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) +! n_integrals_1 = 0 +! endif +! else +! n_integrals_2 += 1 +! buffer_i_2(n_integrals_2-1)=idx_tmp +! buffer_values_2(n_integrals_2-1)=tmp_re +! if (sign.ne.0.d0) then +! n_integrals_2 += 1 +! buffer_i_2(n_integrals_2)=idx_tmp+1 +! buffer_values_2(n_integrals_2)=tmp_im*sign +! endif +! if (n_integrals_2 >= size(buffer_i_2)-1) then +!! call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) +! n_integrals_2 = 0 +! endif +! endif + enddo + 13 continue + close(iunit) + +! if (n_integrals_1 > 0) then +!! call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) +! endif +! if (n_integrals_2 > 0) then +!! call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) +! endif +! +! call map_sort(ao_integrals_map) +! call map_unique(ao_integrals_map) +! call map_sort(ao_integrals_map_2) +! call map_unique(ao_integrals_map_2) +! +! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) +! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) +! call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read' +print*,'map1' + do i=0,ao_integrals_map%map_size + print*,i,ao_integrals_map%map(i)%value(:) + print*,i,ao_integrals_map%map(i)%key(:) + enddo +print*,'map2' + do i=0,ao_integrals_map_2%map_size + print*,i,ao_integrals_map_2%map(i)%value(:) + print*,i,ao_integrals_map_2%map(i)%key(:) + enddo +end diff --git a/src/utils_periodic/import_integrals_ao_periodic.irp.f b/src/utils_periodic/import_integrals_ao_periodic.irp.f index 79eb8fe0..039af101 100644 --- a/src/utils_periodic/import_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/import_integrals_ao_periodic.irp.f @@ -17,9 +17,13 @@ subroutine run double precision, allocatable :: A(:,:), B(:,:) double precision :: tmp_re, tmp_im - integer :: n_integrals - integer(key_kind), allocatable :: buffer_i(:) - real(integral_kind), allocatable :: buffer_values(:) + integer :: n_integrals_1, n_integrals_2 + integer(key_kind), allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind), allocatable :: buffer_values_1(:), buffer_values_2(:) + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + call ezfio_set_ao_basis_ao_num(ao_num) @@ -107,31 +111,66 @@ subroutine run call ezfio_set_ao_one_e_ints_ao_integrals_n_e_imag(B(1:ao_num, 1:ao_num)) call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e("Read") -! allocate(buffer_i(ao_num**3), buffer_values(ao_num**3)) -! iunit = getunitandopen('W.qp','r') -! n_integrals=0 -! buffer_values = 0.d0 -! do -! read (iunit,*,end=13) i,j,k,l, integral -! n_integrals += 1 -! call two_e_integrals_index(i, j, k, l, buffer_i(n_integrals) ) -! buffer_values(n_integrals) = integral -! if (n_integrals == size(buffer_i)) then -! call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_values) -! n_integrals = 0 -! endif -! enddo -! 13 continue -! close(iunit) -! -! if (n_integrals > 0) then -! call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_values) -! endif -! -! call map_sort(ao_integrals_map) -! call map_unique(ao_integrals_map) -! -! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) -! call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') + allocate(buffer_i_1(ao_num**3), buffer_values_1(ao_num**3)) + allocate(buffer_i_2(ao_num**3), buffer_values_2(ao_num**3)) + iunit = getunitandopen('W.qp','r') + n_integrals_1=0 + n_integrals_2=0 + buffer_values_1 = 0.d0 + buffer_values_2 = 0.d0 + do + read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im + call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + print'(4(I4),(L3),(I6),(F7.1))',i,j,k,l,use_map1,idx_tmp,sign + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + print'(A,4(I4),(I6),(E15.7))','map1',i,j,k,l,idx_tmp,tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + print'(A,4(I4),(I6),(E15.7))','map1',i,j,k,l,idx_tmp+1,tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + print'(A,4(I4),(I6),(E15.7))','map2',i,j,k,l,idx_tmp,tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + print'(A,4(I4),(I6),(E15.7))','map2',i,j,k,l,idx_tmp+1,tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + enddo + 13 continue + close(iunit) + + if (n_integrals_1 > 0) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + + call map_sort(ao_integrals_map) + call map_unique(ao_integrals_map) + call map_sort(ao_integrals_map_2) + call map_unique(ao_integrals_map_2) + + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') end From bcc23bf47f930bd58ce0c79ade56a2e2bb3141fc Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Jan 2020 07:42:37 -0600 Subject: [PATCH 003/256] finished complex mapping, starting comples hartree fock --- src/ao_two_e_ints/map_integrals.irp.f | 165 ++++++++---------- src/mo_basis/mos.irp.f | 29 +++ src/mo_one_e_ints/ao_to_mo.irp.f | 68 ++++++++ src/scf_utils/fock_matrix.irp.f | 58 +++++- .../export_integrals_ao_periodic.irp.f | 8 + 5 files changed, 236 insertions(+), 92 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index e9d2740c..4c30c4df 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -258,6 +258,7 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] complex(integral_kind) :: integral integer(key_kind) :: p,q,r,s,ik,jl logical :: ilek, jlel, iklejl + complex*16 :: get_ao_two_e_integral_periodic_simple !$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, & @@ -267,36 +268,8 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] do j=ao_integrals_cache_min,ao_integrals_cache_max do i=ao_integrals_cache_min,ao_integrals_cache_max !DIR$ FORCEINLINE - call two_e_integrals_index(i,j,k,l,idx1) - ilek = (i.le.k) - jlel = (j.le.l) - idx1 = 2*idx1 - 1 - if (ilek.eqv.jlel) then !map1 - !TODO: merge these calls using map_get_2 - call map_get(ao_integrals_map,idx1,tmp_re) - call map_get(ao_integrals_map,idx1+1,tmp_im) - if (ilek) then - integral = dcmplx(tmp_re,tmp_im) - else - integral = dcmplx(tmp_re,-tmp_im) - endif - else !map2 - !TODO: merge these calls using map_get_2 - call map_get(ao_integrals_map_2,idx1,tmp_re) - call map_get(ao_integrals_map_2,idx1+1,tmp_im) - p = min(i,k) - r = max(i,k) - ik = p+shiftr(r*r-r,1) - q = min(j,l) - s = max(j,l) - jl = q+shiftr(s*s-s,1) - iklejl = (ik.le.jl) - if (ilek.eqv.iklejl) then - integral = dcmplx(tmp_re,tmp_im) - else - integral = dcmplx(tmp_re,-tmp_im) - endif - endif + integral = get_ao_two_e_integral_periodic_simple(i,j,k,l,& + ao_integrals_map,ao_integrals_map_2) ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) @@ -324,35 +297,61 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) integer(key_kind), intent(out) :: idx logical, intent(out) :: use_map1 double precision, intent(out) :: sign - integer(key_kind) :: p,q,r,s,ik,jl - logical :: ilek, jlel, iklejl, ikeqjl + integer(key_kind) :: p,q,r,s,ik,jl,ij,kl + logical :: iltk, jltl, ikltjl, ieqk, jeql, ikeqjl, ijeqkl ! i.le.k, j.le.l, tri(i,k).le.tri(j,l) !DIR$ FORCEINLINE call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) - ilek = (i.le.k) - jlel = (j.le.l) + p = min(i,j) + r = max(i,j) + ij = p+shiftr(r*r-r,1) + q = min(k,l) + s = max(k,l) + kl = q+shiftr(s*s-s,1) + + idx = 2*idx-1 - ikeqjl = (ik.eq.jl) - if (ilek.eqv.jlel) then !map1 + + if (ij==kl) then !real, map1 + sign=0.d0 use_map1=.True. + else + iltk = (i.lt.k) + jltl = (j.lt.l) + ieqk = (i.eq.k) + jeql = (j.eq.l) + ikltjl = (ik.lt.jl) + ikeqjl = (ik.eq.jl) if (ikeqjl) then - sign=0.d0 - else if (ilek) then - sign=1.d0 - else - sign=-1.d0 - endif - else !map2 - use_map1=.False. - if (ikeqjl) then - sign=0.d0 - else - iklejl = (ik.le.jl) - if (ilek.eqv.iklejl) then - sign=1.d0 + if (iltk) then + sign=1.d0 + use_map1=.False. else sign=-1.d0 + use_map1=.False. endif + else if (ieqk) then + if (jltl) then + sign=1.d0 + use_map1=.True. + else + sign=-1.d0 + use_map1=.True. + endif + else if (jeql) then + if (iltk) then + sign=1.d0 + use_map1=.True. + else + sign=-1.d0 + use_map1=.True. + endif + else if (iltk.eqv.ikltjl) then + sign=1.d0 + use_map1=.False. + else + sign=-1.d0 + use_map1=.False. endif endif end @@ -364,48 +363,33 @@ complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) resu ! Gets one AO bi-electronic integral from the AO map END_DOC integer, intent(in) :: i,j,k,l - integer(key_kind) :: idx1,idx2 + integer(key_kind) :: idx1,idx2,idx real(integral_kind) :: tmp_re, tmp_im integer(key_kind) :: idx_re,idx_im type(map_type), intent(inout) :: map,map2 integer :: ii complex(integral_kind) :: tmp integer(key_kind) :: p,q,r,s,ik,jl - logical :: ilek, jlel, iklejl + logical :: ilek, jlel, iklejl,use_map1 + double precision :: sign ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) - PROVIDE ao_two_e_integrals_in_map - !DIR$ FORCEINLINE - call two_e_integrals_index(i,j,k,l,idx1) - ilek = (i.le.k) - jlel = (j.le.l) - idx1 = idx1*2-1 - if (ilek.eqv.jlel) then !map1 - !TODO: merge these calls using map_get_2 - call map_get(map,idx1,tmp_re) - call map_get(map,idx1+1,tmp_im) - if (ilek) then - tmp = dcmplx(tmp_re,tmp_im) - else - tmp = dcmplx(tmp_re,-tmp_im) - endif - else !map2 - !TODO: merge these calls using map_get_2 - call map_get(map2,idx1,tmp_re) - call map_get(map2,idx1+1,tmp_im) - p = min(i,k) - r = max(i,k) - ik = p+shiftr(r*r-r,1) - q = min(j,l) - s = max(j,l) - jl = q+shiftr(s*s-s,1) - iklejl = (ik.le.jl) - if (ilek.eqv.iklejl) then - tmp = dcmplx(tmp_re,tmp_im) - else - tmp = dcmplx(tmp_re,-tmp_im) - endif - endif - result = tmp + PROVIDE ao_two_e_integrals_in_map + call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + if (use_map1) then + call map_get(map,idx,tmp_re) + if (sign/=0.d0) then + call map_get(map,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif + else + call map_get(map2,idx,tmp_re) + call map_get(map2,idx+1,tmp_im) + tmp_im *= sign + endif + tmp = dcmplx(tmp_re,tmp_im) + result = tmp end @@ -428,11 +412,12 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(resu ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min !DIR$ FORCEINLINE - if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then - tmp = (0.d0,0.d0) - else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then - tmp = (0.d0,0.d0) - else +! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then +! tmp = (0.d0,0.d0) +! else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then +! tmp = (0.d0,0.d0) +! else + if (.True.) then ii = l-ao_integrals_cache_min ii = ior(ii, k-ao_integrals_cache_min) ii = ior(ii, j-ao_integrals_cache_min) diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 73d33901..23713f34 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -280,6 +280,35 @@ subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo) deallocate(T) end +subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the AO basis to the MO basis + ! where A is complex in the AO basis + ! + ! Ct.A_ao.C + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num) + complex*16, intent(out) :: A_mo(LDA_mo,mo_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,mo_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','N', ao_num, mo_num, ao_num, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('C','N', mo_num, mo_num, ao_num, & + (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & + T, ao_num, & + (0.d0,0.d0), A_mo, size(A_mo,1)) + + deallocate(T) +end + subroutine mix_mo_jk(j,k) implicit none diff --git a/src/mo_one_e_ints/ao_to_mo.irp.f b/src/mo_one_e_ints/ao_to_mo.irp.f index a0d8caaa..5279608f 100644 --- a/src/mo_one_e_ints/ao_to_mo.irp.f +++ b/src/mo_one_e_ints/ao_to_mo.irp.f @@ -50,6 +50,61 @@ subroutine mo_to_ao_no_overlap(A_mo,LDA_mo,A_ao,LDA_ao) deallocate(T) end +subroutine mo_to_ao_complex(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis + ! + ! (S.C).A_mo.(S.C)t + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num,ao_num) ) + + call zgemm('N','C', mo_num, ao_num, mo_num, & + (1.d0,0.d0), A_mo,size(A_mo,1), & + S_mo_coef_complex, size(S_mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num, ao_num, mo_num, & + (1.d0,0.d0), S_mo_coef_complex, size(S_mo_coef_complex,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao, size(A_ao,1)) + + deallocate(T) +end + +subroutine mo_to_ao_no_overlap_complex(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the S^-1 AO basis + ! Useful for density matrix + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num,ao_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','C', mo_num, ao_num, mo_num, & + (1.d0,0.d0), A_mo,size(A_mo,1), & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num, ao_num, mo_num, & + (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao, size(A_ao,1)) + + deallocate(T) +end + + BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ] implicit none BEGIN_DOC @@ -63,4 +118,17 @@ BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ] + implicit none + BEGIN_DOC + ! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix. + END_DOC + + call zgemm('N','N',ao_num, mo_num, ao_num, (1.d0,0.d0), & + ao_overlap_complex, size(ao_overlap_complex,1), & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), & + S_mo_coef_complex, size(S_mo_coef_complex,1)) + +END_PROVIDER diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index fc9eaadd..a49d51e5 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -101,18 +101,45 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_mo_alpha, (mo_num,mo_num) ] BEGIN_DOC ! Fock matrix on the MO basis END_DOC - call ao_to_mo(Fock_matrix_ao_alpha,size(Fock_matrix_ao_alpha,1), & + if (is_periodic) then + print*,'error',irp_here + stop -1 + else + call ao_to_mo(Fock_matrix_ao_alpha,size(Fock_matrix_ao_alpha,1), & Fock_matrix_mo_alpha,size(Fock_matrix_mo_alpha,1)) + endif END_PROVIDER +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_alpha_complex,size(Fock_matrix_ao_alpha_complex,1), & + Fock_matrix_mo_alpha_complex,size(Fock_matrix_mo_alpha_complex,1)) +END_PROVIDER BEGIN_PROVIDER [ double precision, Fock_matrix_mo_beta, (mo_num,mo_num) ] implicit none BEGIN_DOC ! Fock matrix on the MO basis END_DOC - call ao_to_mo(Fock_matrix_ao_beta,size(Fock_matrix_ao_beta,1), & + if (is_periodic) then + print*,'error',irp_here + stop -1 + else + call ao_to_mo(Fock_matrix_ao_beta,size(Fock_matrix_ao_beta,1), & Fock_matrix_mo_beta,size(Fock_matrix_mo_beta,1)) + endif +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_beta_complex,size(Fock_matrix_ao_beta_complex,1), & + Fock_matrix_mo_beta_complex,size(Fock_matrix_mo_beta_complex,1)) END_PROVIDER @@ -143,6 +170,33 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num, ao_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Fock matrix in AO basis set + END_DOC + + if(frozen_orb_scf)then + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + else + if ( (elec_alpha_num == elec_beta_num).and. & + (level_shift == 0.) ) & + then + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_complex(i,j) = Fock_matrix_ao_alpha_complex(i,j) + enddo + enddo + else + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + endif + endif +END_PROVIDER + + BEGIN_PROVIDER [ double precision, SCF_energy ] implicit none BEGIN_DOC diff --git a/src/utils_periodic/export_integrals_ao_periodic.irp.f b/src/utils_periodic/export_integrals_ao_periodic.irp.f index 8d60ff49..1f190749 100644 --- a/src/utils_periodic/export_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/export_integrals_ao_periodic.irp.f @@ -153,6 +153,14 @@ provide ao_two_e_integrals_in_map call map_get(ao_integrals_map_2,idx_tmp+1,tmp6) print*,tmp3,tmp4 print*,tmp5,tmp6 + integer*8 :: ii + ii = l-ao_integrals_cache_min + ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) + print*,'cache(pbc)=', ao_integrals_cache_periodic(ii) + print*,'cache(old)=', ao_integrals_cache(ii) + print* ! if (use_map1) then ! n_integrals_1 += 1 ! buffer_i_1(n_integrals_1-1)=idx_tmp From 3b63d807fcff110efac2bb1b4c8754322bf75c67 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Jan 2020 07:57:38 -0600 Subject: [PATCH 004/256] added complex huckel --- src/scf_utils/huckel_complex.irp.f | 42 ++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 src/scf_utils/huckel_complex.irp.f diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_complex.irp.f new file mode 100644 index 00000000..3fa1b4b0 --- /dev/null +++ b/src/scf_utils/huckel_complex.irp.f @@ -0,0 +1,42 @@ +subroutine huckel_guess + implicit none + BEGIN_DOC +! Build the MOs using the extended Huckel model + END_DOC + integer :: i,j + double precision :: accu + double precision :: c + character*(64) :: label + complex*16, allocatable :: A(:,:) + label = "Guess" + c = 0.5d0 * 1.75d0 + + allocate (A(ao_num, ao_num)) + A = 0.d0 + do j=1,ao_num + do i=1,ao_num + A(i,j) = c * ao_overlap_complex(i,j) * (ao_one_e_integrals_diag(i) + ao_one_e_integrals_diag(j)) + enddo + A(j,j) = ao_one_e_integrals_diag(j) + dble(ao_two_e_integral_alpha_complex(j,j)) + if (dabs(dimag(ao_two_e_integral_alpha_complex)) .gt. 1.0d-10) then + stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' + endif + enddo + +! Fock_matrix_ao_alpha(1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) +! Fock_matrix_ao_beta (1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) + call zlacp2('X', ao_num, ao_num, A, size(A,1), & + Fock_matrix_ao_alpha_complex, size(Fock_matrix_ao_alpha_complex,1)) + call zlacp2('X', ao_num, ao_num, A, size(A,1), & + Fock_matrix_ao_beta_complex, size(Fock_matrix_ao_beta_complex, 1)) + + +! TOUCH mo_coef + + TOUCH Fock_matrix_ao_alpha_complex Fock_matrix_ao_beta_complex + mo_coef_complex = eigenvectors_fock_matrix_mo_complex + SOFT_TOUCH mo_coef_complex + call save_mos + deallocate(A) + +end From c050f2859eeb0f79f8394de19aaa9c3d65c442ef Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Jan 2020 07:58:06 -0600 Subject: [PATCH 005/256] minor change in complex huckel --- src/scf_utils/huckel_complex.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_complex.irp.f index 3fa1b4b0..284ba18b 100644 --- a/src/scf_utils/huckel_complex.irp.f +++ b/src/scf_utils/huckel_complex.irp.f @@ -1,4 +1,4 @@ -subroutine huckel_guess +subroutine huckel_guess_complex implicit none BEGIN_DOC ! Build the MOs using the extended Huckel model From 7dfc07215002f59ad0e8c774314da25f9fbabf34 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Jan 2020 08:50:15 -0600 Subject: [PATCH 006/256] working on complex hf --- src/ao_one_e_ints/ao_one_e_ints.irp.f | 26 +++++- src/hartree_fock/fock_matrix_hf_complex.irp.f | 93 +++++++++++++++++++ 2 files changed, 115 insertions(+), 4 deletions(-) create mode 100644 src/hartree_fock/fock_matrix_hf_complex.irp.f diff --git a/src/ao_one_e_ints/ao_one_e_ints.irp.f b/src/ao_one_e_ints/ao_one_e_ints.irp.f index c3084ae2..694f0cdc 100644 --- a/src/ao_one_e_ints/ao_one_e_ints.irp.f +++ b/src/ao_one_e_ints/ao_one_e_ints.irp.f @@ -35,16 +35,34 @@ BEGIN_PROVIDER [ double precision, ao_one_e_integrals_imag,(ao_num,ao_num)] END_DOC IF (read_ao_one_e_integrals) THEN - call ezfio_get_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals_imag) + call ezfio_get_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) ELSE - print *, irp_here, ': Not yet implemented' - stop -1 + ao_one_e_integrals_imag = ao_integrals_n_e_imag + ao_kinetic_integrals_imag + + IF (DO_PSEUDO) THEN + ao_one_e_integrals_imag += ao_pseudo_integrals_imag + ENDIF ENDIF IF (write_ao_one_e_integrals) THEN - call ezfio_set_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals_imag) + call ezfio_set_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) print *, 'AO one-e integrals written to disk' ENDIF END_PROVIDER +BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_complex,(ao_num,ao_num)] + implicit none + integer :: i,j,n,l + BEGIN_DOC + ! One-electron Hamiltonian in the |AO| basis. + END_DOC + + do i=1,ao_num + do j=1,ao_num + ao_one_e_integrals_complex(j,i)=ao_one_e_integrals(j,i)+(0.d0,1.d0)*ao_one_e_integrals_imag(j,i) + enddo + enddo + +END_PROVIDER + diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_complex.irp.f new file mode 100644 index 00000000..0a432850 --- /dev/null +++ b/src/hartree_fock/fock_matrix_hf_complex.irp.f @@ -0,0 +1,93 @@ + + BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_complex , (ao_num, ao_num) ] + use map_module + implicit none + BEGIN_DOC + ! Alpha and Beta Fock matrices in AO basis set + END_DOC + !TODO: finish implementing this: see complex qp1 (different mapping) + + integer :: i,j,k,l,k1,r,s + integer :: i0,j0,k0,l0 + integer*8 :: p,q + double precision :: integral, c0, c1, c2 + double precision :: ao_two_e_integral, local_threshold + double precision, allocatable :: ao_two_e_integral_alpha_tmp(:,:) + double precision, allocatable :: ao_two_e_integral_beta_tmp(:,:) + + ao_two_e_integral_alpha = 0.d0 + ao_two_e_integral_beta = 0.d0 + PROVIDE ao_two_e_integrals_in_map + + integer(omp_lock_kind) :: lck(ao_num) + integer(map_size_kind) :: i8 + integer :: ii(8), jj(8), kk(8), ll(8), k2 + integer(cache_map_size_kind) :: n_elements_max, n_elements + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,& + !$OMP ao_integrals_map, ao_two_e_integral_alpha, ao_two_e_integral_beta) + + call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = 0.d0 + ao_two_e_integral_beta_tmp = 0.d0 + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) + do k1=1,n_elements + call two_e_integrals_index_reverse(kk,ii,ll,jj,keys(k1)) + + do k2=1,8 + if (kk(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = (SCF_density_matrix_ao_alpha(k,l)+SCF_density_matrix_ao_beta(k,l)) * values(k1) + ao_two_e_integral_alpha_tmp(i,j) += integral + ao_two_e_integral_beta_tmp (i,j) += integral + integral = values(k1) + ao_two_e_integral_alpha_tmp(l,j) -= SCF_density_matrix_ao_alpha(k,i) * integral + ao_two_e_integral_beta_tmp (l,j) -= SCF_density_matrix_ao_beta (k,i) * integral + enddo + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Alpha Fock matrix in AO basis set + END_DOC + + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_alpha_complex(i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_alpha_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_beta_complex (i,j) + enddo + enddo + +END_PROVIDER From a67497fba847d8169d6198d964750c7fbf7c064b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 06:18:54 -0600 Subject: [PATCH 007/256] added NEED and readme for utils_periodic --- src/utils_periodic/NEED | 2 ++ src/utils_periodic/README.rst | 6 ++++++ 2 files changed, 8 insertions(+) create mode 100644 src/utils_periodic/NEED create mode 100644 src/utils_periodic/README.rst diff --git a/src/utils_periodic/NEED b/src/utils_periodic/NEED new file mode 100644 index 00000000..173c6966 --- /dev/null +++ b/src/utils_periodic/NEED @@ -0,0 +1,2 @@ +ao_two_e_ints +ao_one_e_ints diff --git a/src/utils_periodic/README.rst b/src/utils_periodic/README.rst new file mode 100644 index 00000000..6bdb2ca7 --- /dev/null +++ b/src/utils_periodic/README.rst @@ -0,0 +1,6 @@ +===== +dummy +===== + +Module necessary to avoid the ``xxx is a root module but does not contain a main file`` message. + From 5eb1c17614e766138bdc19b7ec72acf4fb016312 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 13:36:13 -0600 Subject: [PATCH 008/256] added provider for complex mos; working on saving complex mos --- src/mo_basis/mos.irp.f | 23 +++++++++++++++++++++++ src/mo_basis/utils.irp.f | 27 +++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 23713f34..6cf76c1b 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -146,6 +146,29 @@ BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] endif END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] + implicit none + BEGIN_DOC + ! Molecular orbital coefficients on |AO| basis set + ! + ! mo_coef_complex(i,j) = coefficient of the i-th |AO| on the jth |MO| + ! + ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) + END_DOC + integer :: i, j + double precision, allocatable :: buffer(:,:) + logical :: exists + PROVIDE ezfio_filename + + provide mo_coef mo_coef_imag + + do i=1,mo_num + do j=1,ao_num + mo_coef_complex(j,i) = dcmplx(mo_coef(j,i),mo_coef_imag(j,i)) + enddo + enddo +END_PROVIDER + BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num, mo_num) ] implicit none BEGIN_DOC diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 12c6c79d..fd5c2b33 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -17,6 +17,15 @@ subroutine save_mos call ezfio_set_mo_basis_mo_coef(buffer) call ezfio_set_mo_basis_mo_occ(mo_occ) call ezfio_set_mo_basis_mo_class(mo_class) + if (is_periodic) then + buffer = 0.d0 + do j = 1, mo_num + do i = 1, ao_num + buffer(i,j) = mo_coef_imag(i,j) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_imag(buffer) + endif deallocate (buffer) end @@ -39,6 +48,15 @@ subroutine save_mos_no_occ enddo enddo call ezfio_set_mo_basis_mo_coef(buffer) + if (is_periodic) then + buffer = 0.d0 + do j = 1, mo_num + do i = 1, ao_num + buffer(i,j) = mo_coef_imag(i,j) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_imag(buffer) + endif deallocate (buffer) end @@ -63,6 +81,15 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_coef(buffer) call ezfio_set_mo_basis_mo_occ(mo_occ) call ezfio_set_mo_basis_mo_class(mo_class) + if (is_periodic) then + buffer = 0.d0 + do j = 1, mo_num + do i = 1, ao_num + buffer(i,j) = mo_coef_imag(i,j) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_imag(buffer) + endif deallocate (buffer) end From 394b6ce404385f95c19399d68646f52771f81d97 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 13:38:29 -0600 Subject: [PATCH 009/256] fixed problem with truncated mo_coef_imag save --- src/mo_basis/utils.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index fd5c2b33..b3b52dd7 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -83,7 +83,7 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_class(mo_class) if (is_periodic) then buffer = 0.d0 - do j = 1, mo_num + do j = 1, n do i = 1, ao_num buffer(i,j) = mo_coef_imag(i,j) enddo From 99d6826b89fae819d79c31d4a185d2bcfdf729d4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 15:29:25 -0600 Subject: [PATCH 010/256] added mo utils for periodic --- src/mo_basis/utils_periodic.irp.f | 243 ++++++++++++++++++++++++++++++ 1 file changed, 243 insertions(+) create mode 100644 src/mo_basis/utils_periodic.irp.f diff --git a/src/mo_basis/utils_periodic.irp.f b/src/mo_basis/utils_periodic.irp.f new file mode 100644 index 00000000..dec28945 --- /dev/null +++ b/src/mo_basis/utils_periodic.irp.f @@ -0,0 +1,243 @@ +subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output) + !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + implicit none + integer,intent(in) :: n,m, sign + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(n,m) + logical, intent(in) :: output + + integer :: i,j + double precision, allocatable :: eigvalues(:) + complex*16, allocatable :: mo_coef_new(:,:), R(:,:), A(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + allocate(A(n,m),R(n,m),mo_coef_new(ao_num,m),eigvalues(m)) + if (sign == -1) then + do j=1,m + do i=1,n + A(i,j) = -matrix(i,j) + enddo + enddo + else + do j=1,m + do i=1,n + A(i,j) = matrix(i,j) + enddo + enddo + endif + mo_coef_new = mo_coef_complex + + call lapack_diag_complex(eigvalues,R,A,n,m) + if (output) then + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================' + endif + if (sign == -1) then + do i=1,m + eigvalues(i) = -eigvalues(i) + enddo + endif + if (output) then + do i=1,m + write (6,'(I8,1X,F16.10)') i,eigvalues(i) + enddo + write (6,'(A)') '======== ================' + write (6,'(A)') '' + endif + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) + deallocate(A,mo_coef_new,R,eigvalues) + call write_time(6) + + mo_label = label +end + +subroutine mo_as_svd_vectors_of_mo_matrix_complex(matrix,lda,m,n,label) + !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + implicit none + integer,intent(in) :: lda,m,n + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(lda,n) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_new = mo_coef_complex + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) + deallocate(A,mo_coef_new,U,Vt,D) + call write_time(6) + + mo_label = label +end + + +subroutine mo_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,eig,label) + !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + implicit none + integer,intent(in) :: lda,m,n + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(lda,n) + double precision, intent(out) :: eig(m) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:), work(:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_new = mo_coef_complex + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) + + do i=1,m + eig(i) = D(i) + enddo + + deallocate(A,mo_coef_new,U,Vt,D) + call write_time(6) + + mo_label = label + +end + + +subroutine mo_coef_new_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,mo_coef_before,eig,mo_coef_new) + implicit none + BEGIN_DOC +! You enter with matrix in the MO basis defined with the mo_coef_before. +! +! You SVD the matrix and set the eigenvectors as mo_coef_new ordered by increasing singular values + END_DOC + integer,intent(in) :: lda,m,n + complex*16, intent(in) :: matrix(lda,n),mo_coef_before(ao_num,m) + double precision, intent(out) :: eig(m) + complex*16, intent(out) :: mo_coef_new(ao_num,m) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_tmp(:,:), U(:,:), A(:,:), Vt(:,:), work(:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_tmp = mo_coef_before + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_new,size(mo_coef_new,1)) + + do i=1,m + eig(i) = D(i) + enddo + + deallocate(A,U,Vt,D,mo_coef_tmp) + call write_time(6) + +end + + From b60262b062617114e00751ca954adb3ab91727f0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 16:30:28 -0600 Subject: [PATCH 011/256] added complex ao_ortho_canonical --- .../ao_ortho_canonical_complex.irp.f | 121 ++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100644 src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f diff --git a/src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f b/src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f new file mode 100644 index 00000000..1ff6cba8 --- /dev/null +++ b/src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f @@ -0,0 +1,121 @@ + +BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_complex, (ao_num,ao_cart_to_sphe_num) ] + implicit none + BEGIN_DOC + ! complex version of ao_cart_to_sphe_coef + END_DOC + call zlacp2('A',ao_num,ao_cart_to_sphe_num, & + ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), & + ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1)) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_complex, (ao_cart_to_sphe_num,ao_cart_to_sphe_num) ] + implicit none + BEGIN_DOC + ! AO overlap matrix in the spherical basis set + END_DOC + complex*16, allocatable :: S(:,:) + allocate (S(ao_cart_to_sphe_num,ao_num)) + + call zgemm('T','N',ao_cart_to_sphe_num,ao_num,ao_num, (1.d0,0.d0), & + ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1), & + ao_overlap_complex,size(ao_overlap_complex,1), (0.d0,0.d0), & + S, size(S,1)) + + call zgemm('N','N',ao_cart_to_sphe_num,ao_cart_to_sphe_num,ao_num, (1.d0,0.d0), & + S, size(S,1), & + ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1), (0.d0,0.d0), & + ao_cart_to_sphe_overlap_complex,size(ao_cart_to_sphe_overlap_complex,1)) + + deallocate(S) + +END_PROVIDER + + + + +BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_inv_complex, (ao_num,ao_num)] + implicit none + BEGIN_DOC +! ao_ortho_canonical_coef_complex^(-1) + END_DOC + call get_inverse_complex(ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1),& + ao_num, ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1)) +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_complex, (ao_num,ao_num)] +&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_complex ] + implicit none + BEGIN_DOC +! TODO: ao_ortho_canonical_num_complex should be the same as the real version +! maybe if the providers weren't linked we could avoid making a complex one? +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital + END_DOC + integer :: i + ao_ortho_canonical_coef_complex = (0.d0,0.d0) + do i=1,ao_num + ao_ortho_canonical_coef_complex(i,i) = (1.d0,0.d0) + enddo + +!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num) +!ao_ortho_canonical_num=ao_num +!return + + if (ao_cartesian) then + + ao_ortho_canonical_num_complex = ao_num + call ortho_canonical_complex(ao_overlap,size(ao_overlap,1), & + ao_num,ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1), & + ao_ortho_canonical_num_complex) + + + else + + complex*16, allocatable :: S(:,:) + + allocate(S(ao_cart_to_sphe_num,ao_cart_to_sphe_num)) + S = (0.d0,0.d0) + do i=1,ao_cart_to_sphe_num + S(i,i) = (1.d0,0.d0) + enddo + + ao_ortho_canonical_num_complex = ao_cart_to_sphe_num + call ortho_canonical_complex(ao_cart_to_sphe_overlap_complex, size(ao_cart_to_sphe_overlap_complex,1), & + ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num_complex) + + call zgemm('N','N', ao_num, ao_ortho_canonical_num_complex, ao_cart_to_sphe_num, (1.d0,0.d0), & + ao_cart_to_sphe_coef_complex, size(ao_cart_to_sphe_coef_complex,1), & + S, size(S,1), & + (0.d0,0.d0), ao_ortho_canonical_coef_complex, size(ao_ortho_canonical_coef_complex,1)) + + deallocate(S) + endif +END_PROVIDER + +BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_complex, (ao_ortho_canonical_num_complex,ao_ortho_canonical_num_complex)] + implicit none + BEGIN_DOC +! overlap matrix of the ao_ortho_canonical. +! Expected to be the Identity + END_DOC + integer :: i,j,k,l + complex*16 :: c + do j=1, ao_ortho_canonical_num_complex + do i=1, ao_ortho_canonical_num_complex + ao_ortho_canonical_overlap_complex(i,j) = (0.d0,0.d0) + enddo + enddo + do j=1, ao_ortho_canonical_num_complex + do k=1, ao_num + c = (0.d0,0.d0) + do l=1, ao_num + c += conjg(ao_ortho_canonical_coef_complex(l,j)) * ao_overlap_complex(l,k) + enddo + do i=1, ao_ortho_canonical_num_complex + ao_ortho_canonical_overlap_complex(i,j) += ao_ortho_canonical_coef_complex(k,i) * c + enddo + enddo + enddo +END_PROVIDER From 2a386ffa419bb5f67b7b7bd075cbf3d839f5519b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jan 2020 17:20:50 -0600 Subject: [PATCH 012/256] working on complex HF --- src/scf_utils/diagonalize_fock_complex.irp.f | 53 +++++++ src/scf_utils/fock_matrix.irp.f | 73 +++------ src/scf_utils/fock_matrix_complex.irp.f | 148 +++++++++++++++++++ 3 files changed, 221 insertions(+), 53 deletions(-) create mode 100644 src/scf_utils/diagonalize_fock_complex.irp.f create mode 100644 src/scf_utils/fock_matrix_complex.irp.f diff --git a/src/scf_utils/diagonalize_fock_complex.irp.f b/src/scf_utils/diagonalize_fock_complex.irp.f new file mode 100644 index 00000000..1150b773 --- /dev/null +++ b/src/scf_utils/diagonalize_fock_complex.irp.f @@ -0,0 +1,53 @@ +BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_complex, (ao_num,mo_num) ] + implicit none + BEGIN_DOC + ! Eigenvectors of the Fock matrix in the |MO| basis obtained with level shift. + END_DOC + + integer :: i,j + integer :: n + complex*16, allocatable :: F(:,:) + double precision, allocatable :: diag(:) + + + allocate( F(mo_num,mo_num) ) + allocate (diag(mo_num) ) + + do j=1,mo_num + do i=1,mo_num + F(i,j) = Fock_matrix_mo_complex(i,j) + enddo + enddo + + if(frozen_orb_scf)then + integer :: iorb,jorb + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, n_act_orb + jorb = list_act(j) + F(iorb,jorb) = (0.d0,0.d0) + F(jorb,iorb) = (0.d0,0.d0) + enddo + enddo + endif + + ! Insert level shift here + do i = elec_beta_num+1, elec_alpha_num + F(i,i) += 0.5d0*level_shift + enddo + + do i = elec_alpha_num+1, mo_num + F(i,i) += level_shift + enddo + + n = mo_num + call lapack_diagd_diag_in_place_complex(diag,F,n,n) + + call zgemm('N','N',ao_num,mo_num,mo_num, (1.d0,0.d0), & + mo_coef_complex, size(mo_coef_complex,1), F, size(F,1), & + (0.d0,0.d0), eigenvectors_Fock_matrix_mo_complex, size(eigenvectors_Fock_matrix_mo_complex,1)) + deallocate(F, diag) + + +END_PROVIDER + diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index a49d51e5..0cecd7d4 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -110,15 +110,6 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_mo_alpha, (mo_num,mo_num) ] endif END_PROVIDER -BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] - implicit none - BEGIN_DOC - ! Fock matrix on the MO basis - END_DOC - call ao_to_mo_complex(Fock_matrix_ao_alpha_complex,size(Fock_matrix_ao_alpha_complex,1), & - Fock_matrix_mo_alpha_complex,size(Fock_matrix_mo_alpha_complex,1)) -END_PROVIDER - BEGIN_PROVIDER [ double precision, Fock_matrix_mo_beta, (mo_num,mo_num) ] implicit none BEGIN_DOC @@ -133,16 +124,6 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_mo_beta, (mo_num,mo_num) ] endif END_PROVIDER -BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] - implicit none - BEGIN_DOC - ! Fock matrix on the MO basis - END_DOC - call ao_to_mo_complex(Fock_matrix_ao_beta_complex,size(Fock_matrix_ao_beta_complex,1), & - Fock_matrix_mo_beta_complex,size(Fock_matrix_mo_beta_complex,1)) -END_PROVIDER - - BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num, ao_num) ] implicit none BEGIN_DOC @@ -169,34 +150,6 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num, ao_num) ] endif END_PROVIDER - -BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] - implicit none - BEGIN_DOC - ! Fock matrix in AO basis set - END_DOC - - if(frozen_orb_scf)then - call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & - Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) - else - if ( (elec_alpha_num == elec_beta_num).and. & - (level_shift == 0.) ) & - then - integer :: i,j - do j=1,ao_num - do i=1,ao_num - Fock_matrix_ao_complex(i,j) = Fock_matrix_ao_alpha_complex(i,j) - enddo - enddo - else - call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & - Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) - endif - endif -END_PROVIDER - - BEGIN_PROVIDER [ double precision, SCF_energy ] implicit none BEGIN_DOC @@ -205,13 +158,27 @@ BEGIN_PROVIDER [ double precision, SCF_energy ] SCF_energy = nuclear_repulsion integer :: i,j - do j=1,ao_num - do i=1,ao_num - SCF_energy += 0.5d0 * ( & - (ao_one_e_integrals(i,j) + Fock_matrix_ao_alpha(i,j) ) * SCF_density_matrix_ao_alpha(i,j) +& - (ao_one_e_integrals(i,j) + Fock_matrix_ao_beta (i,j) ) * SCF_density_matrix_ao_beta (i,j) ) + if (is_periodic) then + complex*16 :: scf_e_tmp + scf_e_tmp = (0.d0,0.d0) + do j=1,ao_num + do i=1,ao_num + scf_e_tmp += 0.5d0 * ( & + (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_alpha_complex(i,j) ) * SCF_density_matrix_ao_alpha_complex(i,j) +& + (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) ) * SCF_density_matrix_ao_beta_complex (i,j) ) + enddo enddo - enddo + !TODO: add check for imaginary part? (should be zero) + SCF_energy = dble(scf_e_tmp) + else + do j=1,ao_num + do i=1,ao_num + SCF_energy += 0.5d0 * ( & + (ao_one_e_integrals(i,j) + Fock_matrix_ao_alpha(i,j) ) * SCF_density_matrix_ao_alpha(i,j) +& + (ao_one_e_integrals(i,j) + Fock_matrix_ao_beta (i,j) ) * SCF_density_matrix_ao_beta (i,j) ) + enddo + enddo + endif SCF_energy += extra_e_contrib_density END_PROVIDER diff --git a/src/scf_utils/fock_matrix_complex.irp.f b/src/scf_utils/fock_matrix_complex.irp.f new file mode 100644 index 00000000..290f9b9d --- /dev/null +++ b/src/scf_utils/fock_matrix_complex.irp.f @@ -0,0 +1,148 @@ + BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_complex, (mo_num,mo_num) ] +&BEGIN_PROVIDER [ double precision, Fock_matrix_diag_mo_complex, (mo_num)] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis. + ! For open shells, the ROHF Fock Matrix is :: + ! + ! | F-K | F + K/2 | F | + ! |---------------------------------| + ! | F + K/2 | F | F - K/2 | + ! |---------------------------------| + ! | F | F - K/2 | F + K | + ! + ! + ! F = 1/2 (Fa + Fb) + ! + ! K = Fb - Fa + ! + END_DOC + integer :: i,j,n + if (elec_alpha_num == elec_beta_num) then + Fock_matrix_mo_complex = Fock_matrix_mo_alpha_complex + else + + do j=1,elec_beta_num + ! F-K + do i=1,elec_beta_num !CC + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j))& + - (Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + ! F+K/2 + do i=elec_beta_num+1,elec_alpha_num !CA + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j))& + + 0.5d0*(Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + ! F + do i=elec_alpha_num+1, mo_num !CV + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j)) + enddo + enddo + + do j=elec_beta_num+1,elec_alpha_num + ! F+K/2 + do i=1,elec_beta_num !AC + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j))& + + 0.5d0*(Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + ! F + do i=elec_beta_num+1,elec_alpha_num !AA + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j)) + enddo + ! F-K/2 + do i=elec_alpha_num+1, mo_num !AV + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j))& + - 0.5d0*(Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + enddo + + do j=elec_alpha_num+1, mo_num + ! F + do i=1,elec_beta_num !VC + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j)) + enddo + ! F-K/2 + do i=elec_beta_num+1,elec_alpha_num !VA + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j))& + - 0.5d0*(Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + ! F+K + do i=elec_alpha_num+1,mo_num !VV + Fock_matrix_mo_complex(i,j) = 0.5d0*(Fock_matrix_mo_alpha_complex(i,j)+Fock_matrix_mo_beta_complex(i,j)) & + + (Fock_matrix_mo_beta_complex(i,j) - Fock_matrix_mo_alpha_complex(i,j)) + enddo + enddo + + endif + + do i = 1, mo_num + Fock_matrix_diag_mo_complex(i) = dble(Fock_matrix_mo_complex(i,i)) + if (dabs(dimag(Fock_matrix_mo_complex(i,i))) .gt. 1.0d-12) then + !stop 'diagonal elements of Fock matrix should be real' + print *, 'diagonal elements of Fock matrix should be real',i,Fock_matrix_mo_complex(i,i) + stop -1 + endif + enddo + + + if(frozen_orb_scf)then + integer :: iorb,jorb + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, n_act_orb + jorb = list_act(j) + Fock_matrix_mo_complex(iorb,jorb) = (0.d0,0.d0) + Fock_matrix_mo_complex(jorb,iorb) = (0.d0,0.d0) + enddo + enddo + endif + +END_PROVIDER + + + +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_alpha_complex,size(Fock_matrix_ao_alpha_complex,1), & + Fock_matrix_mo_alpha_complex,size(Fock_matrix_mo_alpha_complex,1)) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_beta_complex,size(Fock_matrix_ao_beta_complex,1), & + Fock_matrix_mo_beta_complex,size(Fock_matrix_mo_beta_complex,1)) +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Fock matrix in AO basis set + END_DOC + + if(frozen_orb_scf)then + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + else + if ( (elec_alpha_num == elec_beta_num).and. & + (level_shift == 0.) ) & + then + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_complex(i,j) = Fock_matrix_ao_alpha_complex(i,j) + enddo + enddo + else + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + endif + endif +END_PROVIDER + From b950e40df4f604f3f1eb7076db052bebce873ea4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 11:46:54 -0600 Subject: [PATCH 013/256] added complex scf density matrix --- src/scf_utils/huckel_complex.irp.f | 2 +- .../scf_density_matrix_ao_complex.irp.f | 41 +++++++++++++++++++ 2 files changed, 42 insertions(+), 1 deletion(-) create mode 100644 src/scf_utils/scf_density_matrix_ao_complex.irp.f diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_complex.irp.f index 284ba18b..52fdef8f 100644 --- a/src/scf_utils/huckel_complex.irp.f +++ b/src/scf_utils/huckel_complex.irp.f @@ -18,7 +18,7 @@ subroutine huckel_guess_complex A(i,j) = c * ao_overlap_complex(i,j) * (ao_one_e_integrals_diag(i) + ao_one_e_integrals_diag(j)) enddo A(j,j) = ao_one_e_integrals_diag(j) + dble(ao_two_e_integral_alpha_complex(j,j)) - if (dabs(dimag(ao_two_e_integral_alpha_complex)) .gt. 1.0d-10) then + if (dabs(dimag(ao_two_e_integral_alpha_complex(j,j))) .gt. 1.0d-10) then stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' endif enddo diff --git a/src/scf_utils/scf_density_matrix_ao_complex.irp.f b/src/scf_utils/scf_density_matrix_ao_complex.irp.f new file mode 100644 index 00000000..2bf7b77e --- /dev/null +++ b/src/scf_utils/scf_density_matrix_ao_complex.irp.f @@ -0,0 +1,41 @@ +BEGIN_PROVIDER [complex*16, SCF_density_matrix_ao_alpha_complex, (ao_num,ao_num) ] + implicit none + BEGIN_DOC + ! $C.C^t$ over $\alpha$ MOs + END_DOC + + call zgemm('N','C',ao_num,ao_num,elec_alpha_num,(1.d0,0.d0), & + mo_coef_complex, size(mo_coef_complex,1), & + mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + SCF_density_matrix_ao_alpha_complex, size(SCF_density_matrix_ao_alpha_complex,1)) + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, SCF_density_matrix_ao_beta_complex, (ao_num,ao_num) ] + implicit none + BEGIN_DOC + ! $C.C^t$ over $\beta$ MOs + END_DOC + + call zgemm('N','C',ao_num,ao_num,elec_beta_num,(1.d0,0.d0), & + mo_coef_complex, size(mo_coef_complex,1), & + mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + SCF_density_matrix_ao_beta_complex, size(SCF_density_matrix_ao_beta_complex,1)) + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, SCF_density_matrix_ao_complex, (ao_num,ao_num) ] + implicit none + BEGIN_DOC + ! Sum of $\alpha$ and $\beta$ density matrices + END_DOC + ASSERT (size(SCF_density_matrix_ao_complex,1) == size(SCF_density_matrix_ao_alpha_complex,1)) + if (elec_alpha_num== elec_beta_num) then + SCF_density_matrix_ao_complex = SCF_density_matrix_ao_alpha_complex + SCF_density_matrix_ao_alpha_complex + else + ASSERT (size(SCF_density_matrix_ao_complex,1) == size(SCF_density_matrix_ao_beta_complex ,1)) + SCF_density_matrix_ao_complex = SCF_density_matrix_ao_alpha_complex + SCF_density_matrix_ao_beta_complex + endif + +END_PROVIDER + From 79b75a11f7635d60ff746875d778173945b3f62d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 15:39:25 -0600 Subject: [PATCH 014/256] more work on complex mos; created separate file for complex mos --- src/mo_basis/mos.irp.f | 140 +++++----------------------- src/mo_basis/mos_complex.irp.f | 163 +++++++++++++++++++++++++++++++++ 2 files changed, 188 insertions(+), 115 deletions(-) create mode 100644 src/mo_basis/mos_complex.irp.f diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 6cf76c1b..04386e6b 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -93,82 +93,6 @@ BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_num) ] endif END_PROVIDER -BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] - implicit none - BEGIN_DOC - ! Molecular orbital coefficients on |AO| basis set - ! - ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| - ! - ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) - END_DOC - integer :: i, j - double precision, allocatable :: buffer(:,:) - logical :: exists - PROVIDE ezfio_filename - - - if (mpi_master) then - ! Coefs - call ezfio_has_mo_basis_mo_coef_imag(exists) - endif - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - IRP_IF MPI - include 'mpif.h' - integer :: ierr - call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_imag with MPI' - endif - IRP_ENDIF - - if (exists) then - if (mpi_master) then - call ezfio_get_mo_basis_mo_coef_imag(mo_coef_imag) - write(*,*) 'Read mo_coef_imag' - endif - IRP_IF MPI - call MPI_BCAST( mo_coef_imag, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_imag with MPI' - endif - IRP_ENDIF - else - ! Orthonormalized AO basis - do i=1,mo_num - do j=1,ao_num - mo_coef_imag(j,i) = 0.d0 - enddo - enddo - endif -END_PROVIDER - -BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] - implicit none - BEGIN_DOC - ! Molecular orbital coefficients on |AO| basis set - ! - ! mo_coef_complex(i,j) = coefficient of the i-th |AO| on the jth |MO| - ! - ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) - END_DOC - integer :: i, j - double precision, allocatable :: buffer(:,:) - logical :: exists - PROVIDE ezfio_filename - - provide mo_coef mo_coef_imag - - do i=1,mo_num - do j=1,ao_num - mo_coef_complex(j,i) = dcmplx(mo_coef(j,i),mo_coef_imag(j,i)) - enddo - enddo -END_PROVIDER - BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num, mo_num) ] implicit none BEGIN_DOC @@ -303,35 +227,6 @@ subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo) deallocate(T) end -subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo) - implicit none - BEGIN_DOC - ! Transform A from the AO basis to the MO basis - ! where A is complex in the AO basis - ! - ! Ct.A_ao.C - END_DOC - integer, intent(in) :: LDA_ao,LDA_mo - complex*16, intent(in) :: A_ao(LDA_ao,ao_num) - complex*16, intent(out) :: A_mo(LDA_mo,mo_num) - complex*16, allocatable :: T(:,:) - - allocate ( T(ao_num,mo_num) ) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T - - call zgemm('N','N', ao_num, mo_num, ao_num, & - (1.d0,0.d0), A_ao,LDA_ao, & - mo_coef_complex, size(mo_coef_complex,1), & - (0.d0,0.d0), T, size(T,1)) - - call zgemm('C','N', mo_num, mo_num, ao_num, & - (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & - T, ao_num, & - (0.d0,0.d0), A_mo, size(A_mo,1)) - - deallocate(T) -end - subroutine mix_mo_jk(j,k) implicit none @@ -347,28 +242,43 @@ subroutine mix_mo_jk(j,k) ! by convention, the '+' |MO| is in the lowest index (min(j,k)) ! by convention, the '-' |MO| is in the highest index (max(j,k)) END_DOC - double precision :: array_tmp(ao_num,2),dsqrt_2 if(j==k)then print*,'You want to mix two orbitals that are the same !' print*,'It does not make sense ... ' print*,'Stopping ...' stop endif - array_tmp = 0.d0 + double precision :: dsqrt_2 dsqrt_2 = 1.d0/dsqrt(2.d0) - do i = 1, ao_num - array_tmp(i,1) = dsqrt_2 * (mo_coef(i,j) + mo_coef(i,k)) - array_tmp(i,2) = dsqrt_2 * (mo_coef(i,j) - mo_coef(i,k)) - enddo i_plus = min(j,k) i_minus = max(j,k) - do i = 1, ao_num - mo_coef(i,i_plus) = array_tmp(i,1) - mo_coef(i,i_minus) = array_tmp(i,2) - enddo + if (is_periodic) then + complex*16 :: array_tmp_c(ao_num,2) + array_tmp_c = (0.d0,0.d0) + do i = 1, ao_num + array_tmp_c(i,1) = dsqrt_2 * (mo_coef_complex(i,j) + mo_coef_complex(i,k)) + array_tmp_c(i,2) = dsqrt_2 * (mo_coef_complex(i,j) - mo_coef_complex(i,k)) + enddo + do i = 1, ao_num + mo_coef_complex(i,i_plus) = array_tmp_c(i,1) + mo_coef_complex(i,i_minus) = array_tmp_c(i,2) + enddo + else + double precision :: array_tmp(ao_num,2) + array_tmp = 0.d0 + do i = 1, ao_num + array_tmp(i,1) = dsqrt_2 * (mo_coef(i,j) + mo_coef(i,k)) + array_tmp(i,2) = dsqrt_2 * (mo_coef(i,j) - mo_coef(i,k)) + enddo + do i = 1, ao_num + mo_coef(i,i_plus) = array_tmp(i,1) + mo_coef(i,i_minus) = array_tmp(i,2) + enddo + endif end + subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA) implicit none BEGIN_DOC diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f new file mode 100644 index 00000000..54f98ef2 --- /dev/null +++ b/src/mo_basis/mos_complex.irp.f @@ -0,0 +1,163 @@ +BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] + implicit none + BEGIN_DOC + ! Molecular orbital coefficients on |AO| basis set + ! + ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| + ! + ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) + END_DOC + integer :: i, j + double precision, allocatable :: buffer(:,:) + logical :: exists + PROVIDE ezfio_filename + + + if (mpi_master) then + ! Coefs + call ezfio_has_mo_basis_mo_coef_imag(exists) + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_coef_imag with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + call ezfio_get_mo_basis_mo_coef_imag(mo_coef_imag) + write(*,*) 'Read mo_coef_imag' + endif + IRP_IF MPI + call MPI_BCAST( mo_coef_imag, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_coef_imag with MPI' + endif + IRP_ENDIF + else + ! Orthonormalized AO basis + do i=1,mo_num + do j=1,ao_num + mo_coef_imag(j,i) = 0.d0 + enddo + enddo + endif +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] + implicit none + BEGIN_DOC + ! Molecular orbital coefficients on |AO| basis set + ! + ! mo_coef_complex(i,j) = coefficient of the i-th |AO| on the jth |MO| + ! + ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) + END_DOC + integer :: i, j + PROVIDE ezfio_filename + + provide mo_coef mo_coef_imag + + do i=1,mo_num + do j=1,ao_num + mo_coef_complex(j,i) = dcmplx(mo_coef(j,i),mo_coef_imag(j,i)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ] + implicit none + BEGIN_DOC + ! |MO| coefficients in orthogonalized |AO| basis + ! + ! $C^{-1}.C_{mo}$ + END_DOC + call zgemm('N','N',ao_num,mo_num,ao_num,(1.d0,0.d0), & + ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1),& + mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + mo_coef_in_ao_ortho_basis_complex, size(mo_coef_in_ao_ortho_basis_complex,1)) + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex, (mo_num,ao_num) ] +&BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex_conjg, (mo_num,ao_num) ] + implicit none + BEGIN_DOC + ! |MO| coefficients on |AO| basis set + END_DOC + integer :: i, j + + do j=1,ao_num + do i=1,mo_num + mo_coef_transp_complex(i,j) = mo_coef_complex(j,i) + mo_coef_transp_complex_conjg(i,j) = dconjg(mo_coef_complex(j,i)) + enddo + enddo + +END_PROVIDER + +subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the AO basis to the MO basis + ! where A is complex in the AO basis + ! + ! Ct.A_ao.C + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num) + complex*16, intent(out) :: A_mo(LDA_mo,mo_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,mo_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','N', ao_num, mo_num, ao_num, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('C','N', mo_num, mo_num, ao_num, & + (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & + T, ao_num, & + (0.d0,0.d0), A_mo, size(A_mo,1)) + + deallocate(T) +end + + +subroutine ao_ortho_cano_to_ao_complex(A_ao,LDA_ao,A,LDA) + implicit none + BEGIN_DOC + ! Transform A from the |AO| basis to the orthogonal |AO| basis + ! + ! $C^{-1}.A_{ao}.C^{\dagger-1}$ + END_DOC + integer, intent(in) :: LDA_ao,LDA + complex*16, intent(in) :: A_ao(LDA_ao,*) + complex*16, intent(out) :: A(LDA,*) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,ao_num) ) + + call zgemm('C','N', ao_num, ao_num, ao_num, & + (1.d0,0.d0), & + ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1),& + A_ao,size(A_ao,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num, ao_num, ao_num, (1.d0,0.d0), & + T, size(T,1), & + ao_ortho_canonical_coef_inv_complex,size(ao_ortho_canonical_coef_inv_complex,1),& + (0.d0,0.d0), A, size(A,1)) + + deallocate(T) +end + From 73f24c31300c621a81920de14b32d7c7ad91d225 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 15:40:00 -0600 Subject: [PATCH 015/256] complex mo overlap --- src/mo_one_e_ints/mo_overlap.irp.f | 37 ++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/src/mo_one_e_ints/mo_overlap.irp.f b/src/mo_one_e_ints/mo_overlap.irp.f index 4ce83fcd..1301d473 100644 --- a/src/mo_one_e_ints/mo_overlap.irp.f +++ b/src/mo_one_e_ints/mo_overlap.irp.f @@ -37,3 +37,40 @@ BEGIN_PROVIDER [ double precision, mo_overlap,(mo_num,mo_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_overlap_complex,(mo_num,mo_num) ] + implicit none + BEGIN_DOC +! Provider to check that the MOs are indeed orthonormal. + END_DOC + integer :: i,j,n,l + integer :: lmax + + + lmax = (ao_num/4) * 4 + !$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(NONE) & + !$OMP PRIVATE(i,j,n,l) & + !$OMP SHARED(mo_overlap_complex,mo_coef_complex,ao_overlap_complex, & + !$OMP mo_num,ao_num,lmax) + do j=1,mo_num + do i= 1,mo_num + mo_overlap(i,j) = (0.d0,0.d0) + do n = 1, lmax,4 + do l = 1, ao_num + mo_overlap_complex(i,j) = mo_overlap_complex(i,j) + dconjg(mo_coef_complex(l,i)) * & + ( mo_coef_complex(n ,j) * ao_overlap_complex(l,n ) & + + mo_coef_complex(n+1,j) * ao_overlap_complex(l,n+1) & + + mo_coef_complex(n+2,j) * ao_overlap_complex(l,n+2) & + + mo_coef_complex(n+3,j) * ao_overlap_complex(l,n+3) ) + enddo + enddo + do n = lmax+1, ao_num + do l = 1, ao_num + mo_overlap_complex(i,j) = mo_overlap_complex(i,j) + mo_coef_complex(n,j) * dconjg(mo_coef_complex(l,i)) * ao_overlap_complex(l,n) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + From 25d041379b795e90621a8ddc7d2698dbadf305a3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 15:43:40 -0600 Subject: [PATCH 016/256] complex cleanup --- src/mo_one_e_ints/ao_to_mo.irp.f | 69 ------------------------ src/mo_one_e_ints/ao_to_mo_complex.irp.f | 68 +++++++++++++++++++++++ 2 files changed, 68 insertions(+), 69 deletions(-) create mode 100644 src/mo_one_e_ints/ao_to_mo_complex.irp.f diff --git a/src/mo_one_e_ints/ao_to_mo.irp.f b/src/mo_one_e_ints/ao_to_mo.irp.f index 5279608f..f388119b 100644 --- a/src/mo_one_e_ints/ao_to_mo.irp.f +++ b/src/mo_one_e_ints/ao_to_mo.irp.f @@ -50,61 +50,6 @@ subroutine mo_to_ao_no_overlap(A_mo,LDA_mo,A_ao,LDA_ao) deallocate(T) end -subroutine mo_to_ao_complex(A_mo,LDA_mo,A_ao,LDA_ao) - implicit none - BEGIN_DOC - ! Transform A from the MO basis to the AO basis - ! - ! (S.C).A_mo.(S.C)t - END_DOC - integer, intent(in) :: LDA_ao,LDA_mo - complex*16, intent(in) :: A_mo(LDA_mo,mo_num) - complex*16, intent(out) :: A_ao(LDA_ao,ao_num) - complex*16, allocatable :: T(:,:) - - allocate ( T(mo_num,ao_num) ) - - call zgemm('N','C', mo_num, ao_num, mo_num, & - (1.d0,0.d0), A_mo,size(A_mo,1), & - S_mo_coef_complex, size(S_mo_coef_complex,1), & - (0.d0,0.d0), T, size(T,1)) - - call zgemm('N','N', ao_num, ao_num, mo_num, & - (1.d0,0.d0), S_mo_coef_complex, size(S_mo_coef_complex,1), & - T, size(T,1), & - (0.d0,0.d0), A_ao, size(A_ao,1)) - - deallocate(T) -end - -subroutine mo_to_ao_no_overlap_complex(A_mo,LDA_mo,A_ao,LDA_ao) - implicit none - BEGIN_DOC - ! Transform A from the MO basis to the S^-1 AO basis - ! Useful for density matrix - END_DOC - integer, intent(in) :: LDA_ao,LDA_mo - complex*16, intent(in) :: A_mo(LDA_mo,mo_num) - complex*16, intent(out) :: A_ao(LDA_ao,ao_num) - complex*16, allocatable :: T(:,:) - - allocate ( T(mo_num,ao_num) ) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T - - call zgemm('N','C', mo_num, ao_num, mo_num, & - (1.d0,0.d0), A_mo,size(A_mo,1), & - mo_coef_complex, size(mo_coef_complex,1), & - (0.d0,0.d0), T, size(T,1)) - - call zgemm('N','N', ao_num, ao_num, mo_num, & - (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & - T, size(T,1), & - (0.d0,0.d0), A_ao, size(A_ao,1)) - - deallocate(T) -end - - BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ] implicit none BEGIN_DOC @@ -118,17 +63,3 @@ BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ] END_PROVIDER -BEGIN_PROVIDER [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ] - implicit none - BEGIN_DOC - ! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix. - END_DOC - - call zgemm('N','N',ao_num, mo_num, ao_num, (1.d0,0.d0), & - ao_overlap_complex, size(ao_overlap_complex,1), & - mo_coef_complex, size(mo_coef_complex,1), & - (0.d0,0.d0), & - S_mo_coef_complex, size(S_mo_coef_complex,1)) - -END_PROVIDER - diff --git a/src/mo_one_e_ints/ao_to_mo_complex.irp.f b/src/mo_one_e_ints/ao_to_mo_complex.irp.f new file mode 100644 index 00000000..2530caf0 --- /dev/null +++ b/src/mo_one_e_ints/ao_to_mo_complex.irp.f @@ -0,0 +1,68 @@ +subroutine mo_to_ao_complex(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis + ! + ! (S.C).A_mo.(S.C)t + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num,ao_num) ) + + call zgemm('N','C', mo_num, ao_num, mo_num, & + (1.d0,0.d0), A_mo,size(A_mo,1), & + S_mo_coef_complex, size(S_mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num, ao_num, mo_num, & + (1.d0,0.d0), S_mo_coef_complex, size(S_mo_coef_complex,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao, size(A_ao,1)) + + deallocate(T) +end + +subroutine mo_to_ao_no_overlap_complex(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the S^-1 AO basis + ! Useful for density matrix + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num,ao_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','C', mo_num, ao_num, mo_num, & + (1.d0,0.d0), A_mo,size(A_mo,1), & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num, ao_num, mo_num, & + (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao, size(A_ao,1)) + + deallocate(T) +end + +BEGIN_PROVIDER [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ] + implicit none + BEGIN_DOC + ! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix. + END_DOC + + call zgemm('N','N',ao_num, mo_num, ao_num, (1.d0,0.d0), & + ao_overlap_complex, size(ao_overlap_complex,1), & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), & + S_mo_coef_complex, size(S_mo_coef_complex,1)) + +END_PROVIDER + From 648e157db9ccd7a0632447449a9c724d750be4d7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 16:37:30 -0600 Subject: [PATCH 017/256] added complex mo_one_e_ints; maybe should be structured differently? --- src/ao_one_e_ints/ao_one_e_ints.irp.f | 3 +- src/ao_one_e_ints/kin_ao_ints.irp.f | 16 +++++ src/ao_one_e_ints/pot_ao_ints.irp.f | 15 +++++ src/mo_one_e_ints/kin_mo_ints.irp.f | 64 ++++++++++++++----- src/mo_one_e_ints/mo_one_e_ints.irp.f | 43 +++++++++++++ src/mo_one_e_ints/pot_mo_ints.irp.f | 63 ++++++++++++++----- src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f | 71 +++++++++++++++++----- 7 files changed, 229 insertions(+), 46 deletions(-) diff --git a/src/ao_one_e_ints/ao_one_e_ints.irp.f b/src/ao_one_e_ints/ao_one_e_ints.irp.f index 694f0cdc..b5e8872e 100644 --- a/src/ao_one_e_ints/ao_one_e_ints.irp.f +++ b/src/ao_one_e_ints/ao_one_e_ints.irp.f @@ -60,7 +60,8 @@ BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_complex,(ao_num,ao_num)] do i=1,ao_num do j=1,ao_num - ao_one_e_integrals_complex(j,i)=ao_one_e_integrals(j,i)+(0.d0,1.d0)*ao_one_e_integrals_imag(j,i) + ao_one_e_integrals_complex(j,i)=dcmplx(ao_one_e_integrals(j,i), & + ao_one_e_integrals_imag(j,i)) enddo enddo diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f index 442c1f88..ca50114c 100644 --- a/src/ao_one_e_ints/kin_ao_ints.irp.f +++ b/src/ao_one_e_ints/kin_ao_ints.irp.f @@ -171,3 +171,19 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals_imag, (ao_num,ao_num)] endif END_PROVIDER +BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_complex, (ao_num,ao_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the |AO| basis. + ! + ! $\langle \chi_i |\hat{T}| \chi_j \rangle$ + ! + END_DOC + integer :: i,j + do i=1,ao_num + do j=1,ao_num + ao_kinetic_integrals_complex(j,i) = dcmplx(ao_kinetic_integrals(j,i), & + ao_kinetic_integrals_imag(j,i)) + enddo + enddo +END_PROVIDER diff --git a/src/ao_one_e_ints/pot_ao_ints.irp.f b/src/ao_one_e_ints/pot_ao_ints.irp.f index 1d4cab7d..63c02dd2 100644 --- a/src/ao_one_e_ints/pot_ao_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_ints.irp.f @@ -105,6 +105,21 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)] endif END_PROVIDER +BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)] + implicit none + BEGIN_DOC + ! Nucleus-electron interaction, in the |AO| basis set. + ! + ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` + END_DOC + integer :: i,j + do i=1,ao_num + do j=1,ao_num + ao_integrals_n_e_complex(j,i) = dcmplx(ao_integrals_n_e(j,i), & + ao_integrals_n_e_imag(j,i)) + enddo + enddo +END_PROVIDER BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)] BEGIN_DOC diff --git a/src/mo_one_e_ints/kin_mo_ints.irp.f b/src/mo_one_e_ints/kin_mo_ints.irp.f index 216628bb..d1a2f0cf 100644 --- a/src/mo_one_e_ints/kin_mo_ints.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints.irp.f @@ -1,23 +1,57 @@ -BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] + BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_kinetic_integrals_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Kinetic energy integrals in the MO basis END_DOC - - if (read_mo_integrals_kinetic) then - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - print *, 'MO kinetic integrals read from disk' + if (is_periodic) then + integer :: i,j + if (read_mo_integrals_kinetic) then + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + print *, 'MO kinetic integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_kinetic_integrals_complex(j,i) = dcmplx(mo_kinetic_integrals(j,i), & + mo_kinetic_integrals_imag(j,i)) + enddo + enddo + else + call ao_to_mo_complex( & + ao_kinetic_integrals_complex, & + size(ao_kinetic_integrals_complex,1), & + mo_kinetic_integrals_complex, & + size(mo_kinetic_integrals_complex,1) & + ) + do i=1,mo_num + do j=1,mo_num + mo_kinetic_integrals(j,i)=dble(mo_kinetic_integrals_complex(j,i)) + mo_kinetic_integrals_imag(j,i)=dimag(mo_kinetic_integrals_complex(j,i)) + enddo + enddo + endif + if (write_mo_integrals_kinetic) then + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + print *, 'MO kinetic integrals written to disk' + endif else - call ao_to_mo( & - ao_kinetic_integrals, & - size(ao_kinetic_integrals,1), & - mo_kinetic_integrals, & - size(mo_kinetic_integrals,1) & - ) - endif - if (write_mo_integrals_kinetic) then - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - print *, 'MO kinetic integrals written to disk' + if (read_mo_integrals_kinetic) then + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + print *, 'MO kinetic integrals read from disk' + else + call ao_to_mo( & + ao_kinetic_integrals, & + size(ao_kinetic_integrals,1), & + mo_kinetic_integrals, & + size(mo_kinetic_integrals,1) & + ) + endif + if (write_mo_integrals_kinetic) then + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + print *, 'MO kinetic integrals written to disk' + endif endif END_PROVIDER diff --git a/src/mo_one_e_ints/mo_one_e_ints.irp.f b/src/mo_one_e_ints/mo_one_e_ints.irp.f index ac4b4e3b..4db21e46 100644 --- a/src/mo_one_e_ints/mo_one_e_ints.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints.irp.f @@ -24,3 +24,46 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)] ENDIF END_PROVIDER + +BEGIN_PROVIDER [ double precision, mo_one_e_integrals_imag,(mo_num,mo_num)] + implicit none + integer :: i,j,n,l + BEGIN_DOC + ! array of the one-electron Hamiltonian on the |MO| basis : + ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed) + END_DOC + print*,'Providing the one-electron integrals' + + IF (read_mo_one_e_integrals) THEN + call ezfio_get_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + ELSE + mo_one_e_integrals_imag = mo_integrals_n_e_imag + mo_kinetic_integrals_imag + + IF (DO_PSEUDO) THEN + mo_one_e_integrals_imag += mo_pseudo_integrals_imag + ENDIF + + ENDIF + + IF (write_mo_one_e_integrals) THEN + call ezfio_set_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + print *, 'MO one-e integrals written to disk' + ENDIF + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] + implicit none + integer :: i,j,n,l + BEGIN_DOC + ! One-electron Hamiltonian in the |AO| basis. + END_DOC + + do i=1,mo_num + do j=1,mo_num + mo_one_e_integrals_complex(j,i)=dcmplx(mo_one_e_integrals(j,i), & + mo_one_e_integrals_imag(j,i)) + enddo + enddo + +END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_ints.irp.f b/src/mo_one_e_ints/pot_mo_ints.irp.f index 90f7b06c..69ba26bc 100644 --- a/src/mo_one_e_ints/pot_mo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints.irp.f @@ -1,23 +1,58 @@ -BEGIN_PROVIDER [double precision, mo_integrals_n_e, (mo_num,mo_num)] + BEGIN_PROVIDER [double precision, mo_integrals_n_e, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_integrals_n_e_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Nucleus-electron interaction on the |MO| basis END_DOC - if (read_mo_integrals_e_n) then - call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - print *, 'MO N-e integrals read from disk' + if (is_periodic) then + integer :: i,j + if (read_mo_integrals_e_n) then + call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + call ezfio_get_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + print *, 'MO N-e integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_integrals_n_e_complex(j,i) = dcmplx(mo_integrals_n_e(j,i), & + mo_integrals_n_e_imag(j,i)) + enddo + enddo + else + call ao_to_mo_complex( & + ao_integrals_n_e_complex, & + size(ao_integrals_n_e_complex,1), & + mo_integrals_n_e_complex, & + size(mo_integrals_n_e_complex,1) & + ) + do i=1,mo_num + do j=1,mo_num + mo_integrals_n_e(j,i)=dble(mo_integrals_n_e_complex(j,i)) + mo_integrals_n_e_imag(j,i)=dimag(mo_integrals_n_e_complex(j,i)) + enddo + enddo + endif + if (write_mo_integrals_e_n) then + call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + call ezfio_set_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + print *, 'MO N-e integrals written to disk' + endif else - call ao_to_mo( & - ao_integrals_n_e, & - size(ao_integrals_n_e,1), & - mo_integrals_n_e, & - size(mo_integrals_n_e,1) & - ) - endif - if (write_mo_integrals_e_n) then - call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - print *, 'MO N-e integrals written to disk' + if (read_mo_integrals_e_n) then + call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + print *, 'MO N-e integrals read from disk' + else + call ao_to_mo( & + ao_integrals_n_e, & + size(ao_integrals_n_e,1), & + mo_integrals_n_e, & + size(mo_integrals_n_e,1) & + ) + endif + if (write_mo_integrals_e_n) then + call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + print *, 'MO N-e integrals written to disk' + endif endif END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f index 179b33ed..3c4674dc 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f @@ -1,26 +1,65 @@ -BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] + BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_pseudo_integrals_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Pseudopotential integrals in |MO| basis END_DOC - if (read_mo_integrals_pseudo) then - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - print *, 'MO pseudopotential integrals read from disk' - else if (do_pseudo) then - call ao_to_mo( & - ao_pseudo_integrals, & - size(ao_pseudo_integrals,1), & - mo_pseudo_integrals, & - size(mo_pseudo_integrals,1) & - ) - else + if (is_periodic) then + integer :: i,j + if (read_mo_integrals_pseudo) then + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + print *, 'MO pseudopotential integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_pseudo_integrals_complex(j,i) = dcmplx(mo_pseudo_integrals(j,i), & + mo_pseudo_integrals_imag(j,i)) + enddo + enddo + else if (do_pseudo) then + call ao_to_mo_complex( & + ao_pseudo_integrals_complex, & + size(ao_pseudo_integrals_complex,1), & + mo_pseudo_integrals_complex, & + size(mo_pseudo_integrals_complex,1) & + ) + do i=1,mo_num + do j=1,mo_num + mo_pseudo_integrals(j,i)=dble(mo_pseudo_integrals_complex(j,i)) + mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) + enddo + enddo + else mo_pseudo_integrals = 0.d0 - endif + mo_pseudo_integrals_imag = 0.d0 + mo_pseudo_integrals_complex = (0.d0,0.d0) + endif + if (write_mo_integrals_pseudo) then + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + print *, 'MO pseudopotential integrals written to disk' + endif + else + if (read_mo_integrals_pseudo) then + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + print *, 'MO pseudopotential integrals read from disk' + else if (do_pseudo) then + call ao_to_mo( & + ao_pseudo_integrals, & + size(ao_pseudo_integrals,1), & + mo_pseudo_integrals, & + size(mo_pseudo_integrals,1) & + ) + else + mo_pseudo_integrals = 0.d0 + endif - if (write_mo_integrals_pseudo) then - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - print *, 'MO pseudopotential integrals written to disk' + if (write_mo_integrals_pseudo) then + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + print *, 'MO pseudopotential integrals written to disk' + endif endif END_PROVIDER From 92c2a3961ed306d494e96c155c3be3e2f0844311 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 16:41:22 -0600 Subject: [PATCH 018/256] mo ints ezfio --- src/mo_one_e_ints/EZFIO.cfg | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/mo_one_e_ints/EZFIO.cfg b/src/mo_one_e_ints/EZFIO.cfg index 79a3b351..23a6008e 100644 --- a/src/mo_one_e_ints/EZFIO.cfg +++ b/src/mo_one_e_ints/EZFIO.cfg @@ -4,6 +4,12 @@ doc: Nucleus-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_e_n_imag] +type: double precision +doc: Imaginary part of the nucleus-electron integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [io_mo_integrals_e_n] type: Disk_access doc: Read/Write |MO| electron-nucleus attraction integrals from/to disk [ Write | Read | None ] @@ -17,6 +23,12 @@ doc: Kinetic energy integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_kinetic_imag] +type: double precision +doc: Imaginary part of the kinetic energy integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [io_mo_integrals_kinetic] type: Disk_access doc: Read/Write |MO| one-electron kinetic integrals from/to disk [ Write | Read | None ] @@ -31,6 +43,12 @@ doc: Pseudopotential integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_pseudo_imag] +type: double precision +doc: Imaginary part of the pseudopotential integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [io_mo_integrals_pseudo] type: Disk_access doc: Read/Write |MO| pseudopotential integrals from/to disk [ Write | Read | None ] @@ -43,6 +61,12 @@ doc: One-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_one_e_integrals_imag] +type: double precision +doc: Imaginary part of the one-electron integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [io_mo_one_e_integrals] type: Disk_access doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ] From 1dc9c3ed0ba1f65fadf3ee036e76ee72a146a050 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 16:44:16 -0600 Subject: [PATCH 019/256] complex orthonormalize mos --- src/mo_one_e_ints/orthonormalize.irp.f | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/mo_one_e_ints/orthonormalize.irp.f b/src/mo_one_e_ints/orthonormalize.irp.f index cffc1993..aa8d85bc 100644 --- a/src/mo_one_e_ints/orthonormalize.irp.f +++ b/src/mo_one_e_ints/orthonormalize.irp.f @@ -1,11 +1,20 @@ subroutine orthonormalize_mos implicit none integer :: m,p,s - m = size(mo_coef,1) - p = size(mo_overlap,1) - call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num) - mo_label = 'Orthonormalized' - SOFT_TOUCH mo_coef mo_label + if (is_periodic) then + m = size(mo_coef_complex,1) + p = size(mo_overlap_complex,1) + call ortho_lowdin_complex(mo_overlap_complex,p,mo_num,mo_coef_complex,m,ao_num) + mo_label = 'Orthonormalized' + SOFT_TOUCH mo_coef_complex mo_label + !TODO: should we do anything with the separate real/imag parts of mo_coef_complex? + else + m = size(mo_coef,1) + p = size(mo_overlap,1) + call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num) + mo_label = 'Orthonormalized' + SOFT_TOUCH mo_coef mo_label + endif end From aa23ecc6a649cc9c7e154cc3aad124477cdfb816 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 16:46:42 -0600 Subject: [PATCH 020/256] minor fix --- src/mo_one_e_ints/mo_overlap.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mo_one_e_ints/mo_overlap.irp.f b/src/mo_one_e_ints/mo_overlap.irp.f index 1301d473..796c9fde 100644 --- a/src/mo_one_e_ints/mo_overlap.irp.f +++ b/src/mo_one_e_ints/mo_overlap.irp.f @@ -53,7 +53,7 @@ BEGIN_PROVIDER [ complex*16, mo_overlap_complex,(mo_num,mo_num) ] !$OMP mo_num,ao_num,lmax) do j=1,mo_num do i= 1,mo_num - mo_overlap(i,j) = (0.d0,0.d0) + mo_overlap_complex(i,j) = (0.d0,0.d0) do n = 1, lmax,4 do l = 1, ao_num mo_overlap_complex(i,j) = mo_overlap_complex(i,j) + dconjg(mo_coef_complex(l,i)) * & From 60ea669d06da27ba67a2f37342b12eed3aad7b89 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 17:25:34 -0600 Subject: [PATCH 021/256] complex mo guess --- src/mo_guess/h_core_guess_routine.irp.f | 20 ++++++-- src/mo_guess/mo_ortho_lowdin_complex.irp.f | 48 +++++++++++++++++++ .../pot_mo_ortho_canonical_ints.irp.f | 26 ++++++++++ src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f | 26 ++++++++++ 4 files changed, 115 insertions(+), 5 deletions(-) create mode 100644 src/mo_guess/mo_ortho_lowdin_complex.irp.f diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index 8fc3f6f2..429f77ec 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -5,9 +5,19 @@ subroutine hcore_guess implicit none character*(64) :: label label = "Guess" - call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & - size(mo_one_e_integrals,1), & - size(mo_one_e_integrals,2),label,1,.false.) - call save_mos - SOFT_TOUCH mo_coef mo_label + if (is_periodic) then + call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_complex, & + size(mo_one_e_integrals_complex,1), & + size(mo_one_e_integrals_complex,2),label,1,.false.) + call save_mos + !TODO: is this correct? decide how to handle separate real/imag parts of mo_coef + SOFT_TOUCH mo_coef_complex mo_label + + else + call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & + size(mo_one_e_integrals,1), & + size(mo_one_e_integrals,2),label,1,.false.) + call save_mos + SOFT_TOUCH mo_coef mo_label + endif end diff --git a/src/mo_guess/mo_ortho_lowdin_complex.irp.f b/src/mo_guess/mo_ortho_lowdin_complex.irp.f new file mode 100644 index 00000000..5e1dacbe --- /dev/null +++ b/src/mo_guess/mo_ortho_lowdin_complex.irp.f @@ -0,0 +1,48 @@ +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_complex, (ao_num,ao_num)] + implicit none + BEGIN_DOC +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital + END_DOC + integer :: i,j,k,l + complex*16, allocatable :: tmp_matrix(:,:) + allocate (tmp_matrix(ao_num,ao_num)) + tmp_matrix(:,:) = (0.d0,0.d0) + do j=1, ao_num + tmp_matrix(j,j) = (1.d0,0.d0) + enddo + call ortho_lowdin_complex(ao_overlap_complex,ao_num,ao_num,tmp_matrix,ao_num,ao_num) + do i=1, ao_num + do j=1, ao_num + ao_ortho_lowdin_coef_complex(j,i) = tmp_matrix(i,j) + enddo + enddo + deallocate(tmp_matrix) +END_PROVIDER + +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_complex, (ao_num,ao_num)] + implicit none + BEGIN_DOC +! overlap matrix of the ao_ortho_lowdin +! supposed to be the Identity + END_DOC + integer :: i,j,k,l + complex*16 :: c + do j=1, ao_num + do i=1, ao_num + ao_ortho_lowdin_overlap_complex(i,j) = (0.d0,0.d0) + enddo + enddo + do k=1, ao_num + do j=1, ao_num + c = (0.d0,0.d0) + do l=1, ao_num + c += dconjg(ao_ortho_lowdin_coef_complex(j,l)) * ao_overlap_complex(k,l) + enddo + do i=1, ao_num + ao_ortho_lowdin_overlap_complex(i,j) += ao_ortho_lowdin_coef_complex(i,k) * c + enddo + enddo + enddo +END_PROVIDER diff --git a/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f b/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f index 984d45a5..10363a00 100644 --- a/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f @@ -23,3 +23,29 @@ BEGIN_PROVIDER [double precision, ao_ortho_canonical_nucl_elec_integrals, (mo_nu !$OMP END PARALLEL DO END_PROVIDER +BEGIN_PROVIDER [complex*16, ao_ortho_canonical_nucl_elec_integrals_complex, (mo_num,mo_num)] + implicit none + integer :: i1,j1,i,j + complex*16 :: c_i1,c_j1 + + ao_ortho_canonical_nucl_elec_integrals_complex = (0.d0,0.d0) + !$OMP PARALLEL DO DEFAULT(none) & + !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & + !$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef_complex, & + !$OMP ao_ortho_canonical_nucl_elec_integrals_complex, ao_integrals_n_e_complex) + do i = 1, mo_num + do j = 1, mo_num + do i1 = 1,ao_num + c_i1 = ao_ortho_canonical_coef_complex(i1,i) + do j1 = 1,ao_num + c_j1 = c_i1*dconjg(ao_ortho_canonical_coef_complex(j1,j)) + ao_ortho_canonical_nucl_elec_integrals_complex(j,i) = & + ao_ortho_canonical_nucl_elec_integrals_complex(j,i) + & + c_j1 * ao_integrals_n_e_complex(j1,i1) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO +END_PROVIDER + diff --git a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f index 5a9f9978..7ec94296 100644 --- a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f @@ -23,3 +23,29 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_nucl_elec_integrals, (mo_num,m !$OMP END PARALLEL DO END_PROVIDER +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num,mo_num)] + implicit none + integer :: i1,j1,i,j + complex*16 :: c_i1,c_j1 + + ao_ortho_lowdin_nucl_elec_integrals = (0.d0,0.d0) + !$OMP PARALLEL DO DEFAULT(none) & + !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & + !$OMP SHARED(mo_num,ao_num,ao_ortho_lowdin_coef_complex, & + !$OMP ao_ortho_lowdin_nucl_elec_integrals_complex, ao_integrals_n_e_complex) + do i = 1, mo_num + do j = 1, mo_num + do i1 = 1,ao_num + c_i1 = ao_ortho_lowdin_coef_complex(i1,i) + do j1 = 1,ao_num + c_j1 = c_i1*dconjg(ao_ortho_lowdin_coef_complex(j1,j)) + ao_ortho_lowdin_nucl_elec_integrals_complex(j,i) = & + ao_ortho_lowdin_nucl_elec_integrals_complex(j,i) + & + c_j1 * ao_integrals_n_e_complex(j1,i1) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO +END_PROVIDER + From e805c52cab54acf7831b4a277887e588f85da81c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 17:26:22 -0600 Subject: [PATCH 022/256] reminder to revisit save_mos for complex --- src/mo_basis/utils.irp.f | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index b3b52dd7..5ffcb34f 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -2,7 +2,10 @@ subroutine save_mos implicit none double precision, allocatable :: buffer(:,:) integer :: i,j - + !TODO: change this for periodic? + ! save real/imag parts of mo_coef_complex + ! otherwise need to make sure mo_coef and mo_coef_imag + ! are updated whenever mo_coef_complex changes call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename)) call ezfio_set_mo_basis_mo_num(mo_num) call ezfio_set_mo_basis_mo_label(mo_label) From a63ee551ef0f319f8dacb30b1dc52c723e458ff5 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 17:32:52 -0600 Subject: [PATCH 023/256] working on complex scf --- src/hartree_fock/scf.irp.f | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 6ebb1b80..dd85bba8 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -48,16 +48,31 @@ subroutine create_guess call ezfio_has_mo_basis_mo_coef(exists) if (.not.exists) then if (mo_guess_type == "HCore") then - mo_coef = ao_ortho_lowdin_coef - TOUCH mo_coef - mo_label = 'Guess' - call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & - size(mo_one_e_integrals,1), & - size(mo_one_e_integrals,2), & - mo_label,1,.false.) - SOFT_TOUCH mo_coef mo_label + if (is_periodic) then + mo_coef_complex = ao_ortho_lowdin_coef_complex + TOUCH mo_coef_complex + mo_label = 'Guess' + call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_complex, & + size(mo_one_e_integrals_complex,1), & + size(mo_one_e_integrals_complex,2), & + mo_label,1,.false.) + SOFT_TOUCH mo_coef_complex mo_label + else + mo_coef = ao_ortho_lowdin_coef + TOUCH mo_coef + mo_label = 'Guess' + call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & + size(mo_one_e_integrals,1), & + size(mo_one_e_integrals,2), & + mo_label,1,.false.) + SOFT_TOUCH mo_coef mo_label + endif else if (mo_guess_type == "Huckel") then - call huckel_guess + if (is_periodic) then + call huckel_guess_complex + else + call huckel_guess + endif else print *, 'Unrecognized MO guess type : '//mo_guess_type stop 1 @@ -78,7 +93,7 @@ subroutine run mo_label = "Orthonormalized" - call Roothaan_Hall_SCF + call roothaan_hall_scf call ezfio_set_hartree_fock_energy(SCF_energy) end From 8bfcfe8f21762aacd95bbeccb1c3c1d2f847cca3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 28 Jan 2020 18:06:00 -0600 Subject: [PATCH 024/256] more work on complex SCF --- src/bitmask/track_orb.irp.f | 16 +- src/scf_utils/diis_complex.irp.f | 126 +++++++ src/scf_utils/roothaan_hall_scf_complex.irp.f | 321 ++++++++++++++++++ 3 files changed, 462 insertions(+), 1 deletion(-) create mode 100644 src/scf_utils/diis_complex.irp.f create mode 100644 src/scf_utils/roothaan_hall_scf_complex.irp.f diff --git a/src/bitmask/track_orb.irp.f b/src/bitmask/track_orb.irp.f index 1cdde9cb..e907f73d 100644 --- a/src/bitmask/track_orb.irp.f +++ b/src/bitmask/track_orb.irp.f @@ -7,18 +7,32 @@ BEGIN_PROVIDER [ double precision, mo_coef_begin_iteration, (ao_num,mo_num) ] END_DOC END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_coef_begin_iteration_complex, (ao_num,mo_num) ] + implicit none + BEGIN_DOC + ! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration + ! + ! Useful to track some orbitals + END_DOC +END_PROVIDER + subroutine initialize_mo_coef_begin_iteration implicit none BEGIN_DOC ! ! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef` END_DOC - mo_coef_begin_iteration = mo_coef + if (is_periodic) then + mo_coef_begin_iteration_complex = mo_coef_complex + else + mo_coef_begin_iteration = mo_coef + endif end subroutine reorder_core_orb implicit none BEGIN_DOC + ! TODO: modify for complex ! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration` END_DOC integer :: i,j,iorb diff --git a/src/scf_utils/diis_complex.irp.f b/src/scf_utils/diis_complex.irp.f new file mode 100644 index 00000000..8bba5725 --- /dev/null +++ b/src/scf_utils/diis_complex.irp.f @@ -0,0 +1,126 @@ + +BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_AO_complex, (AO_num, AO_num)] + implicit none + BEGIN_DOC + ! Commutator FPS - SPF + END_DOC + complex*16, allocatable :: scratch(:,:) + allocate( & + scratch(AO_num, AO_num) & + ) + + ! Compute FP + + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & + Fock_Matrix_AO_complex,Size(Fock_Matrix_AO_complex,1), & + SCF_Density_Matrix_AO_complex,Size(SCF_Density_Matrix_AO_complex,1), & + (0.d0,0.d0), & + scratch,Size(scratch,1)) + + ! Compute FPS + + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & + scratch,Size(scratch,1), & + AO_Overlap_complex,Size(AO_Overlap_complex,1), & + (0.d0,0.d0), & + FPS_SPF_Matrix_AO_complex,Size(FPS_SPF_Matrix_AO_complex,1)) + + ! Compute SP + + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & + AO_Overlap_complex,Size(AO_Overlap_complex,1), & + SCF_Density_Matrix_AO_complex,Size(SCF_Density_Matrix_AO_complex,1), & + (0.d0,0.d0), & + scratch,Size(scratch,1)) + + ! Compute FPS - SPF + + call zgemm('N','N',AO_num,AO_num,AO_num, & + (-1.d0,0.d0), & + scratch,Size(scratch,1), & + Fock_Matrix_AO_complex,Size(Fock_Matrix_AO_complex,1), & + (1.d0,0.d0), & + FPS_SPF_Matrix_AO_complex,Size(FPS_SPF_Matrix_AO_complex,1)) + +END_PROVIDER + +BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_MO, (mo_num, mo_num)] + implicit none + begin_doc +! Commutator FPS - SPF in MO basis + end_doc + call ao_to_mo_complex(FPS_SPF_Matrix_AO_complex, size(FPS_SPF_Matrix_AO_complex,1), & + FPS_SPF_Matrix_MO_complex, size(FPS_SPF_Matrix_MO_complex,1)) +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, eigenvalues_Fock_matrix_AO_complex, (AO_num) ] +&BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_AO_complex, (AO_num,AO_num) ] + !TODO: finish this provider; write provider for S_half_inv_complex + BEGIN_DOC + ! Eigenvalues and eigenvectors of the Fock matrix over the AO basis + END_DOC + + implicit none + + double precision, allocatable :: scratch(:,:),work(:),Xt(:,:) + integer :: lwork,info + integer :: i,j + + lwork = 3*AO_num - 1 + allocate( & + scratch(AO_num,AO_num), & + work(lwork), & + Xt(AO_num,AO_num) & + ) + +! Calculate Xt + + do i=1,AO_num + do j=1,AO_num + Xt(i,j) = S_half_inv(j,i) + enddo + enddo + +! Calculate Fock matrix in orthogonal basis: F' = Xt.F.X + + call dgemm('N','N',AO_num,AO_num,AO_num, & + 1.d0, & + Fock_matrix_AO,size(Fock_matrix_AO,1), & + S_half_inv,size(S_half_inv,1), & + 0.d0, & + eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1)) + + call dgemm('N','N',AO_num,AO_num,AO_num, & + 1.d0, & + Xt,size(Xt,1), & + eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1), & + 0.d0, & + scratch,size(scratch,1)) + +! Diagonalize F' to obtain eigenvectors in orthogonal basis C' and eigenvalues + + call dsyev('V','U',AO_num, & + scratch,size(scratch,1), & + eigenvalues_Fock_matrix_AO, & + work,lwork,info) + + if(info /= 0) then + print *, irp_here//' failed : ', info + stop 1 + endif + +! Back-transform eigenvectors: C =X.C' + + call dgemm('N','N',AO_num,AO_num,AO_num, & + 1.d0, & + S_half_inv,size(S_half_inv,1), & + scratch,size(scratch,1), & + 0.d0, & + eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1)) + +END_PROVIDER + diff --git a/src/scf_utils/roothaan_hall_scf_complex.irp.f b/src/scf_utils/roothaan_hall_scf_complex.irp.f new file mode 100644 index 00000000..e5f0e27b --- /dev/null +++ b/src/scf_utils/roothaan_hall_scf_complex.irp.f @@ -0,0 +1,321 @@ +subroutine Roothaan_Hall_SCF_complex + +BEGIN_DOC +! Roothaan-Hall algorithm for SCF Hartree-Fock calculation +END_DOC + + implicit none + + double precision :: energy_SCF,energy_SCF_previous,Delta_energy_SCF + double precision :: max_error_DIIS,max_error_DIIS_alpha,max_error_DIIS_beta + complex*16, allocatable :: Fock_matrix_DIIS(:,:,:),error_matrix_DIIS(:,:,:) + + integer :: iteration_SCF,dim_DIIS,index_dim_DIIS + + integer :: i,j + logical, external :: qp_stop + complex*16, allocatable :: mo_coef_save(:,:) + + PROVIDE ao_md5 mo_occ level_shift + + allocate(mo_coef_save(ao_num,mo_num), & + Fock_matrix_DIIS (ao_num,ao_num,max_dim_DIIS), & + error_matrix_DIIS(ao_num,ao_num,max_dim_DIIS) & + ) + + call write_time(6) + + print*,'Energy of the guess = ',SCF_energy + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + ' N ', 'Energy ', 'Energy diff ', 'DIIS error ', 'Level shift ' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + +! Initialize energies and density matrices + energy_SCF_previous = SCF_energy + Delta_energy_SCF = 1.d0 + iteration_SCF = 0 + dim_DIIS = 0 + max_error_DIIS = 1.d0 + + +! +! Start of main SCF loop +! + PROVIDE FPS_SPF_matrix_AO_complex Fock_matrix_AO_complex + + do while ( & + ( (max_error_DIIS > threshold_DIIS_nonzero) .or. & + (dabs(Delta_energy_SCF) > thresh_SCF) & + ) .and. (iteration_SCF < n_it_SCF_max) ) + +! Increment cycle number + + iteration_SCF += 1 + if(frozen_orb_scf)then + call initialize_mo_coef_begin_iteration + endif + +! Current size of the DIIS space + + dim_DIIS = min(dim_DIIS+1,max_dim_DIIS) + + if (scf_algorithm == 'DIIS') then + + ! Store Fock and error matrices at each iteration + do j=1,ao_num + do i=1,ao_num + index_dim_DIIS = mod(dim_DIIS-1,max_dim_DIIS)+1 + Fock_matrix_DIIS (i,j,index_dim_DIIS) = Fock_matrix_AO_complex(i,j) + error_matrix_DIIS(i,j,index_dim_DIIS) = FPS_SPF_matrix_AO_complex(i,j) + enddo + enddo + + ! Compute the extrapolated Fock matrix + + call extrapolate_Fock_matrix_complex( & + error_matrix_DIIS,Fock_matrix_DIIS, & + Fock_matrix_AO_complex,size(Fock_matrix_AO_complex,1), & + iteration_SCF,dim_DIIS & + ) + + Fock_matrix_AO_alpha_complex = Fock_matrix_AO_complex*0.5d0 + Fock_matrix_AO_beta_complex = Fock_matrix_AO_complex*0.5d0 + TOUCH Fock_matrix_AO_alpha_complex Fock_matrix_AO_beta_complex + + endif + + mo_coef_complex = eigenvectors_fock_matrix_mo_complex + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + + TOUCH mo_coef_complex + +! Calculate error vectors + + max_error_DIIS = maxval(cdabs(FPS_SPF_Matrix_MO_complex)) + +! SCF energy + + energy_SCF = SCF_energy + Delta_Energy_SCF = energy_SCF - energy_SCF_previous + if ( (SCF_algorithm == 'DIIS').and.(Delta_Energy_SCF > 0.d0) ) then + Fock_matrix_AO_complex(1:ao_num,1:ao_num) = Fock_matrix_DIIS (1:ao_num,1:ao_num,index_dim_DIIS) + Fock_matrix_AO_alpha_complex = Fock_matrix_AO_complex*0.5d0 + Fock_matrix_AO_beta_complex = Fock_matrix_AO_complex*0.5d0 + TOUCH Fock_matrix_AO_alpha_complex Fock_matrix_AO_beta_complex + endif + + double precision :: level_shift_save + level_shift_save = level_shift + mo_coef_save(1:ao_num,1:mo_num) = mo_coef_complex(1:ao_num,1:mo_num) + do while (Delta_energy_SCF > 0.d0) + mo_coef_complex(1:ao_num,1:mo_num) = mo_coef_save + if (level_shift <= .1d0) then + level_shift = 1.d0 + else + level_shift = level_shift * 3.0d0 + endif + TOUCH mo_coef_complex level_shift + mo_coef_complex(1:ao_num,1:mo_num) = eigenvectors_Fock_matrix_MO_complex(1:ao_num,1:mo_num) + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + TOUCH mo_coef_complex + Delta_Energy_SCF = SCF_energy - energy_SCF_previous + energy_SCF = SCF_energy + if (level_shift-level_shift_save > 40.d0) then + level_shift = level_shift_save * 4.d0 + SOFT_TOUCH level_shift + exit + endif + dim_DIIS=0 + enddo + level_shift = level_shift * 0.5d0 + SOFT_TOUCH level_shift + energy_SCF_previous = energy_SCF + +! Print results at the end of each iteration + + write(6,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') & + iteration_SCF, energy_SCF, Delta_energy_SCF, max_error_DIIS, level_shift, dim_DIIS + + if (Delta_energy_SCF < 0.d0) then + call save_mos + endif + if (qp_stop()) exit + + enddo + + if (iteration_SCF < n_it_SCF_max) then + mo_label = "Canonical" + endif +! +! End of Main SCF loop +! + + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,*) + + if(.not.frozen_orb_scf)then + call mo_as_eigvectors_of_mo_matrix_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1),size(Fock_matrix_mo_complex,2),mo_label,1,.true.) + call save_mos + endif + + call write_double(6, Energy_SCF, 'SCF energy') + + call write_time(6) + +end + +subroutine extrapolate_Fock_matrix_complex( & + error_matrix_DIIS,Fock_matrix_DIIS, & + Fock_matrix_AO_,size_Fock_matrix_AO, & + iteration_SCF,dim_DIIS & + ) + +BEGIN_DOC +! Compute the extrapolated Fock matrix using the DIIS procedure +END_DOC + + implicit none + + complex*16,intent(in) :: Fock_matrix_DIIS(ao_num,ao_num,*),error_matrix_DIIS(ao_num,ao_num,*) + integer,intent(in) :: iteration_SCF, size_Fock_matrix_AO + complex*16,intent(inout):: Fock_matrix_AO_(size_Fock_matrix_AO,ao_num) + integer,intent(inout) :: dim_DIIS + + double precision,allocatable :: B_matrix_DIIS(:,:),X_vector_DIIS(:) + double precision,allocatable :: C_vector_DIIS(:) + double precision :: accum_im, thr_im + complex*16,allocatable :: scratch(:,:) + integer :: i,j,k,i_DIIS,j_DIIS + thr_im = 1.0d-10 + allocate( & + B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), & + X_vector_DIIS(dim_DIIS+1), & + C_vector_DIIS(dim_DIIS+1), & + scratch(ao_num,ao_num) & + ) + +! Compute the matrices B and X + do j=1,dim_DIIS + do i=1,dim_DIIS + + j_DIIS = mod(iteration_SCF-j,max_dim_DIIS)+1 + i_DIIS = mod(iteration_SCF-i,max_dim_DIIS)+1 + +! Compute product of two errors vectors + + call zgemm('N','N',ao_num,ao_num,ao_num, & + (1.d0,0.d0), & + error_matrix_DIIS(1,1,i_DIIS),size(error_matrix_DIIS,1), & + error_matrix_DIIS(1,1,j_DIIS),size(error_matrix_DIIS,1), & + (0.d0,0.d0), & + scratch,size(scratch,1)) + +! Compute Trace + + B_matrix_DIIS(i,j) = 0.d0 + accum_im = 0.d0 + do k=1,ao_num + B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + dble(scratch(k,k)) + accum_im = accum_im + dimag(scratch(k,k)) + enddo + if (dabs(accum_im) .gt. thr_im) then + !stop 'problem with imaginary parts in DIIS B_matrix?' + print*, 'problem with imaginary parts in DIIS B_matrix?',accum_im + endif + enddo + enddo + +! Pad B matrix and build the X matrix + + do i=1,dim_DIIS + B_matrix_DIIS(i,dim_DIIS+1) = -1.d0 + B_matrix_DIIS(dim_DIIS+1,i) = -1.d0 + C_vector_DIIS(i) = 0.d0 + enddo + B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0 + C_vector_DIIS(dim_DIIS+1) = -1.d0 + +! Solve the linear system C = B.X + + integer :: info + integer,allocatable :: ipiv(:) + + allocate( & + ipiv(dim_DIIS+1) & + ) + + double precision, allocatable :: AF(:,:) + allocate (AF(dim_DIIS+1,dim_DIIS+1)) + double precision :: rcond, ferr, berr + integer :: iwork(dim_DIIS+1), lwork + + call dsysvx('N','U',dim_DIIS+1,1, & + B_matrix_DIIS,size(B_matrix_DIIS,1), & + AF, size(AF,1), & + ipiv, & + C_vector_DIIS,size(C_vector_DIIS,1), & + X_vector_DIIS,size(X_vector_DIIS,1), & + rcond, & + ferr, & + berr, & + scratch,-1, & + iwork, & + info & + ) + lwork = int(scratch(1,1)) + deallocate(scratch) + allocate(scratch(lwork,1)) + + call dsysvx('N','U',dim_DIIS+1,1, & + B_matrix_DIIS,size(B_matrix_DIIS,1), & + AF, size(AF,1), & + ipiv, & + C_vector_DIIS,size(C_vector_DIIS,1), & + X_vector_DIIS,size(X_vector_DIIS,1), & + rcond, & + ferr, & + berr, & + scratch,size(scratch), & + iwork, & + info & + ) + deallocate(scratch,ipiv) + + if(info < 0) then + stop 'bug in DIIS' + endif + + if (rcond > 1.d-12) then + + ! Compute extrapolated Fock matrix + + + !$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num > 200) + do j=1,ao_num + do i=1,ao_num + Fock_matrix_AO_(i,j) = (0.d0,0.d0) + enddo + do k=1,dim_DIIS + do i=1,ao_num + Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + & + X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + else + dim_DIIS = 0 + endif + +end From afdad3cdf9b25a20781e7c9badfc65855fd887c0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 11:50:54 -0600 Subject: [PATCH 025/256] added file to summarize changes for periodic --- src/utils_periodic/qp2-pbc-diff.txt | 226 ++++++++++++++++++++++++++++ 1 file changed, 226 insertions(+) create mode 100644 src/utils_periodic/qp2-pbc-diff.txt diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt new file mode 100644 index 00000000..44cf1438 --- /dev/null +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -0,0 +1,226 @@ +changed, but not by me +ocaml/Input_determinants_by_hand.ml +ocaml/qp_set_mo_class.ml +src/cipsi/run_pt2_slave.irp.f +src/cipsi/selection.irp.f +src/cipsi/slave_cipsi.irp.f +src/davidson/EZFIO.cfg +src/davidson/davidson_parallel.irp.f +src/davidson/diagonalization_hs2_dressed.irp.f +src/davidson/input.irp.f +src/davidson/parameters.irp.f +src/davidson/u0_h_u0.irp.f +src/determinants/EZFIO.cfg +src/determinants/single_excitations.irp.f + +src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f + no {dump,load}_ao_integrals + +periodic: +ocaml/Input_mo_basis.ml + added mo_coef_imag array (real) + still needs mo_coef_to_string and to_string? + + + +src/ao_one_e_ints/EZFIO.cfg + [ao_integrals_n_e_imag] + [ao_integrals_kinetic_imag] + [ao_integrals_pseudo_imag] + [ao_integrals_overlap_imag] + [ao_one_e_integrals_imag] + + +src/ao_one_e_ints/ao_one_e_ints.irp.f + ao_one_e_integrals_imag + can only be read (not calculated) + ao_one_e_integrals_complex + formed from dcmplx(ao_one_e_integrals,ao_one_e_integrals_imag) + +src/ao_one_e_ints/ao_overlap.irp.f +src/ao_one_e_ints/kin_ao_ints.irp.f +src/ao_one_e_ints/pot_ao_ints.irp.f +src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f + added _imag and _complex versions of all AO 1-e ints + each complex array is formed by combining real and imag arrays + imag arrays can only be read from disk + no complex/imag versions of ao_integrals_n_e_per_atom, but this should be straightforward if we need it later? + changed ao_overlap_abs so that it is set to cdabs(ao_overlap_complex) if (is_periodic) + (maybe not the behavior we want) + added S_inv_complex + (no S_half_inv_complex yet) + +src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f + ao_cart_to_sphe_coef_complex + just a copy of ao_cart_to_sphe_coef_complex with complex type for easier zgemm + (with different size if ao_cart_to_sphe_num is less than ao_num) + depends on ao_cart_to_sphe_coef_complex + ao_cart_to_sphe_overlap_complex + similar to real version, but uses ao_overlap_complex instead of ao_overlap + ao_ortho_canonical_coef_inv_complex + self-explanatory + ao_ortho_canonical_coef_complex + ao_ortho_canonical_num_complex + similar to real version + providers are linked, so easier to just make num_complex instead of using original num (even though they will both have the same value) + need to make sure this doesn't require any other downstream changes (i.e. replace ao_ortho_canonical_num with complex version if (is_periodic)) + ao_ortho_canonical_overlap_complex + similar to real version + + +src/ao_two_e_ints/map_integrals.irp.f + added ao_integrals_map_2 (provider linked to ao_integrals_map) + double size of both maps if (is_periodic) + subroutine two_e_integrals_index_periodic + same as real version, but return compound (2) indices to avoid recomputing + ao_integrals_cache_periodic + similar to real version + subroutine ao_two_e_integral_periodic_map_idx_sign + from i,j,k,l, return which map to use (T->1, F->2), location of real part of integral, sign of imaginary part of integral + complex*16 function get_ao_two_e_integral_periodic_simple + args i,j,k,l,map1,map2 + return complex integral composed of correct elements from one of the maps + complex*16 function get_ao_two_e_integral_periodic + same behavior as _simple version, but checks cache first + returns integral from cache if possible, otherwise retrieves from map + subroutine get_ao_two_e_integrals_periodic + same functionality as real version + subroutine insert_into_ao_integrals_map_2 + needed for second map + get_ao_map_size, clear_ao_map + no new functions, but now these also handle map2 + not implemented for periodic: + subroutine get_ao_two_e_integrals_non_zero + subroutine get_ao_two_e_integrals_non_zero_jl + subroutine get_ao_two_e_integrals_non_zero_jl_from_list + + +src/ao_two_e_ints/two_e_integrals.irp.f + + + not implemented for periodic: + double precision function ao_two_e_integral + double precision function ao_two_e_integral_schwartz_accel + subroutine compute_ao_two_e_integrals + [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] + subroutine compute_ao_integrals_jl + (and other integral calculation functions) + modified for periodic: + [ logical, ao_two_e_integrals_in_map ] + complex AO ints can only be read from disk (not calculated) + + +src/mo_basis/track_orb.irp.f → src/bitmask/track_orb.irp.f + not implemented for periodic: + subroutine reorder_core_orb (should be modified for periodic) + modified for periodic: + subroutine initialize_mo_coef_begin_iteration + added for periodic: + [ complex*16, mo_coef_begin_iteration_complex, (ao_num,mo_num) ] + similar to real version + + +src/hartree_fock/fock_matrix_hf_complex.irp.f + TODO for periodic: + [ complex*16, ao_two_e_integral_{alpha,beta}_complex, (ao_num, ao_num) ] + finish implementation (might need new version of two_e_integrals_index_reverse) + added for periodic: + [ complex*16, Fock_matrix_ao_{alpha,beta}_complex, (ao_num, ao_num) ] + + +src/hartree_fock/scf.irp.f + modified for periodic: + subroutine create_guess + should work for periodic + TODO: decide what to do about mo_coef_complex and imag/real parts for touch/save!!! + +src/mo_basis/EZFIO.cfg + [mo_coef_imag] + + +src/mo_basis/mos.irp.f + modifieed for periodic: + subroutine mix_mo_jk + +src/mo_basis/mos_complex.irp.f + added for periodic: + [ double precision, mo_coef_imag, (ao_num,mo_num) ] + [ complex*16, mo_coef_complex, (ao_num,mo_num) ] + [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ] + [ complex*16, mo_coef_transp_complex, (mo_num,ao_num) ] + [ complex*16, mo_coef_transp_complex_conjg, (mo_num,ao_num) ] + maybe not necessary? + might cause confusion having both of these? + maybe should add _noconjg to name of _transp so it's clear that it's just the transpose, and not the adjoint + subroutine ao_to_mo_complex + subroutine ao_ortho_cano_to_ao_complex + +src/mo_basis/utils.irp.f + not modified: + subroutine save_mos_no_occ (should be changed for periodic) + + subroutine save_mos_truncated(n) + subroutine save_mos + modified to write mo_coef_imag to disk + need to make sure this is handled correctly + either update mo_coef{,_imag} whenever mo_coef_complex changes, or just make sure they're updated before writing to disk + (or just put real/imag parts of mo_coef_complex into buffer to save and avoid directly working with mo_coef{,_imag}) + + +src/mo_basis/utils_periodic.irp.f + complex versions of functions from utils + mo_as_eigvectors_of_mo_matrix_complex + mo_as_svd_vectors_of_mo_matrix_complex + mo_as_svd_vectors_of_mo_matrix_eig_complex + these three subroutines modify mo_coef_complex, decide whether to update mo_coef{,_imag} here or elsewhere + mo_coef_new_as_svd_vectors_of_mo_matrix_eig_complex + + +src/mo_guess/h_core_guess_routine.irp.f + subroutine hcore_guess + modified for periodic, but need to decide how to handle separate parts of mo_coef_complex when updated + (also has soft_touch mo_coef_complex) + +src/mo_guess/mo_ortho_lowdin_complex.irp.f + [complex*16, ao_ortho_lowdin_coef_complex, (ao_num,ao_num)] + [complex*16, ao_ortho_lowdin_overlap_complex, (ao_num,ao_num)] + +src/mo_guess/pot_mo_ortho_canonical_ints.irp.f + [complex*16, ao_ortho_canonical_nucl_elec_integrals_complex, (mo_num,mo_num)] +src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f + [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num,mo_num)] + + +src/mo_one_e_ints/EZFIO.cfg + [mo_integrals_e_n_imag] + [mo_integrals_kinetic_imag] + [mo_integrals_pseudo_imag] + [mo_integrals_pseudo_imag] + +src/mo_one_e_ints/ao_to_mo_complex.irp.f + mo_to_ao_complex + mo_to_ao_no_overlap_complex + [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ] + +src/mo_one_e_ints/orthonormalize.irp.f + subroutine orthonormalize_mos + same issue as above with modification of mo_coef_complex + +src/mo_one_e_ints/mo_one_e_ints.irp.f +src/mo_one_e_ints/kin_mo_ints.irp.f +src/mo_one_e_ints/mo_overlap.irp.f +src/mo_one_e_ints/pot_mo_ints.irp.f +src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f + TODO: decide how to handle these providers + + + +src/mo_one_e_ints/mo_overlap.irp.f + [ complex*16, mo_overlap_complex,(mo_num,mo_num) ] + TODO: add option to read from disk? + typical workflow from pyscf might include reading MO 1,2-e ints, ovlp, mo_coef + maybe just add check to converter to ensure they're orthonormal, and don't save them after that? + + + + From 1f353e6ca044390e01d5e27eaf7c62e2961c3b40 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 11:55:32 -0600 Subject: [PATCH 026/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 44cf1438..b00dc055 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -212,6 +212,14 @@ src/mo_one_e_ints/mo_overlap.irp.f src/mo_one_e_ints/pot_mo_ints.irp.f src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f TODO: decide how to handle these providers + for periodic AOs, we always read (can't compute) + for MOs, we can either read from disk or transform from AOs + simplest way might be to link all three providers (integrals{,_imag,_complex}) + if (.not.is_periodic), just ignore imag and complex arrays? + if (is_periodic) + either read real/imag from disk and combine to form complex + or transform complex MO ints from complex AO ints and also assign real/imag parts to separate arrays? + From 56cc1c6b404c729aa42f45eb7e8d881afa713bd0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 13:15:44 -0600 Subject: [PATCH 027/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 200 ++++++++++++++++++++++------ 1 file changed, 161 insertions(+), 39 deletions(-) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index b00dc055..8e7e0bd6 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -1,27 +1,77 @@ -changed, but not by me -ocaml/Input_determinants_by_hand.ml -ocaml/qp_set_mo_class.ml -src/cipsi/run_pt2_slave.irp.f -src/cipsi/selection.irp.f -src/cipsi/slave_cipsi.irp.f -src/davidson/EZFIO.cfg -src/davidson/davidson_parallel.irp.f -src/davidson/diagonalization_hs2_dressed.irp.f -src/davidson/input.irp.f -src/davidson/parameters.irp.f -src/davidson/u0_h_u0.irp.f -src/determinants/EZFIO.cfg -src/determinants/single_excitations.irp.f +compare master-features_periodic +694df1d6498767c9b130dadf0e0cbd585d10d348 +8bfcfe8f21762aacd95bbeccb1c3c1d2f847cca3 -src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f - no {dump,load}_ao_integrals +TODO: +ao_ints + reverse index + s_half_inv_complex + ao_overlap_abs for complex + ao_integrals_n_e_per_atom_complex? + not implemented for periodic: + ao_two_e_integral + ao_two_e_integral_schwartz_accel + compute_ao_two_e_integrals + [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] + compute_ao_integrals_jl + +mo_one_e_ints + make separate providers for real/imag/complex parts for periodic + +mo_basis + decide how to handle real/imag/complex parts of mo_coef (maybe just need to chage save_mos?) + reorder_core_orb: implement for periodic + save_mos_no_occ: implement for periodic + +scf + finish complex DIIS + finish ao_two_e_integral_{alpha,beta}_complex (need reverse index?) + finish extrapolate_Fock_matrix_complex + finish eigenvectors_Fock_matrix_AO_complex + +mo_two_e_ints + not started + + + + +############################ +# utils, ezfio, ... # +############################ -periodic: ocaml/Input_mo_basis.ml added mo_coef_imag array (real) still needs mo_coef_to_string and to_string? +src/nuclei/EZFIO.cfg + [is_periodic] + if true use periodic parts of code +src/utils/linear_algebra.irp.f + complex versions of utils + (maybe put in separate file?) + +src/utils/map_module.f90 + subroutine map_get_2 + get two neighboring values from map + not tested or used + + +src/utils_periodic/export_integrals_ao_periodic.irp.f + dump ints for testing + +src/utils_periodic/import_integrals_ao_periodic.irp.f + read ints from pyscf + TODO: don't read ao_num from stdin + +src/utils_periodic/import_mo_coef_periodic.irp.f + read mo_coef from pyscf + + + +####################### +# ao_one_e_ints # +####################### src/ao_one_e_ints/EZFIO.cfg [ao_integrals_n_e_imag] @@ -46,9 +96,9 @@ src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f imag arrays can only be read from disk no complex/imag versions of ao_integrals_n_e_per_atom, but this should be straightforward if we need it later? changed ao_overlap_abs so that it is set to cdabs(ao_overlap_complex) if (is_periodic) - (maybe not the behavior we want) + TODO: (maybe not the behavior we want) added S_inv_complex - (no S_half_inv_complex yet) + TODO: (no S_half_inv_complex yet) src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f ao_cart_to_sphe_coef_complex @@ -68,6 +118,11 @@ src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f similar to real version +####################### +# ao_two_e_ints # +####################### + + src/ao_two_e_ints/map_integrals.irp.f added ao_integrals_map_2 (provider linked to ao_integrals_map) double size of both maps if (is_periodic) @@ -96,8 +151,6 @@ src/ao_two_e_ints/map_integrals.irp.f src/ao_two_e_ints/two_e_integrals.irp.f - - not implemented for periodic: double precision function ao_two_e_integral double precision function ao_two_e_integral_schwartz_accel @@ -109,7 +162,13 @@ src/ao_two_e_ints/two_e_integrals.irp.f [ logical, ao_two_e_integrals_in_map ] complex AO ints can only be read from disk (not calculated) - + + +####################### +# mo_basis # +####################### + + src/mo_basis/track_orb.irp.f → src/bitmask/track_orb.irp.f not implemented for periodic: subroutine reorder_core_orb (should be modified for periodic) @@ -119,27 +178,13 @@ src/mo_basis/track_orb.irp.f → src/bitmask/track_orb.irp.f [ complex*16, mo_coef_begin_iteration_complex, (ao_num,mo_num) ] similar to real version - -src/hartree_fock/fock_matrix_hf_complex.irp.f - TODO for periodic: - [ complex*16, ao_two_e_integral_{alpha,beta}_complex, (ao_num, ao_num) ] - finish implementation (might need new version of two_e_integrals_index_reverse) - added for periodic: - [ complex*16, Fock_matrix_ao_{alpha,beta}_complex, (ao_num, ao_num) ] - - -src/hartree_fock/scf.irp.f - modified for periodic: - subroutine create_guess - should work for periodic - TODO: decide what to do about mo_coef_complex and imag/real parts for touch/save!!! src/mo_basis/EZFIO.cfg [mo_coef_imag] src/mo_basis/mos.irp.f - modifieed for periodic: + modified for periodic: subroutine mix_mo_jk src/mo_basis/mos_complex.irp.f @@ -191,6 +236,10 @@ src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num,mo_num)] +####################### +# mo_one_e_ints # +####################### + src/mo_one_e_ints/EZFIO.cfg [mo_integrals_e_n_imag] [mo_integrals_kinetic_imag] @@ -221,8 +270,6 @@ src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f or transform complex MO ints from complex AO ints and also assign real/imag parts to separate arrays? - - src/mo_one_e_ints/mo_overlap.irp.f [ complex*16, mo_overlap_complex,(mo_num,mo_num) ] TODO: add option to read from disk? @@ -230,5 +277,80 @@ src/mo_one_e_ints/mo_overlap.irp.f maybe just add check to converter to ensure they're orthonormal, and don't save them after that? + +####################### +# SCF # +####################### + +src/hartree_fock/fock_matrix_hf_complex.irp.f + TODO for periodic: + [ complex*16, ao_two_e_integral_{alpha,beta}_complex, (ao_num, ao_num) ] + finish implementation (might need new version of two_e_integrals_index_reverse) + added for periodic: + [ complex*16, Fock_matrix_ao_{alpha,beta}_complex, (ao_num, ao_num) ] + + +src/hartree_fock/scf.irp.f + modified for periodic: + subroutine create_guess + should work for periodic + TODO: decide what to do about mo_coef_complex and imag/real parts for touch/save!!! + TODO: call roothaan_hall_scf_complex if (is_periodic) + + +src/scf_utils/diagonalize_fock_complex.irp.f + [ complex*16, eigenvectors_Fock_matrix_mo_complex, (ao_num,mo_num) ] + similar to real version + make separate function in utils for lapack calls + +src/scf_utils/diis_complex.irp.f + [complex*16, FPS_SPF_Matrix_AO_complex, (AO_num, AO_num)] + [complex*16, FPS_SPF_Matrix_MO, (mo_num, mo_num)] + linked providers: + [ double precision, eigenvalues_Fock_matrix_AO_complex, (AO_num) ] + [ complex*16, eigenvectors_Fock_matrix_AO_complex, (AO_num,AO_num) ] + TODO: finish implementing (need s_half_inv_complex) + note: eigvals is same type/size as real version + + +src/scf_utils/fock_matrix.irp.f + added checks to make sure we don't end up in real providers if (is_periodic) + probably not necessary? + [ double precision, SCF_energy ] + modified for periodic + could also add check to ensure imaginary part is zero? + +src/scf_utils/fock_matrix_complex.irp.f + [ complex*16, Fock_matrix_mo_complex, (mo_num,mo_num) ] + [ double precision, Fock_matrix_diag_mo_complex, (mo_num)] + similar to real versions + added check to make sure diagonal elements of fock matrix are real + [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] + [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] + [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] + + +src/scf_utils/huckel_complex.irp.f + similar to real version + could just put if (is_periodic) branch in real version? (instead of making separate subroutine) + has soft_touch mo_coef_complex and call to save_mos (see other notes on real/imag parts) + + +src/scf_utils/roothaan_hall_scf_complex.irp.f + subroutine Roothaan_Hall_SCF_complex + similar to real + has soft_touch mo_coef_complex and call to save_mos (see other notes on real/imag parts) + subroutine extrapolate_Fock_matrix_complex + TODO: check variable types? + complex scratch is being used in dsysvx, should be real + +src/scf_utils/scf_density_matrix_ao_complex.irp.f + complex versions of providers + [complex*16, SCF_density_matrix_ao_alpha_complex, (ao_num,ao_num) ] + [ complex*16, SCF_density_matrix_ao_beta_complex, (ao_num,ao_num) ] + [ complex*16, SCF_density_matrix_ao_complex, (ao_num,ao_num) ] + + + From 17ac52d2d50423bbd23ba8d6493f88ea2c688e73 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 14:15:48 -0600 Subject: [PATCH 028/256] restructured complex mo_one_e_ints --- src/mo_one_e_ints/EZFIO.cfg | 24 +++++++ src/mo_one_e_ints/kin_mo_ints.irp.f | 64 ++++------------- src/mo_one_e_ints/kin_mo_ints_complex.irp.f | 45 ++++++++++++ src/mo_one_e_ints/mo_one_e_ints.irp.f | 43 ----------- src/mo_one_e_ints/mo_one_e_ints_complex.irp.f | 39 ++++++++++ src/mo_one_e_ints/pot_mo_ints.irp.f | 63 ++++------------ src/mo_one_e_ints/pot_mo_ints_complex.irp.f | 46 ++++++++++++ src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f | 71 +++++-------------- .../pot_mo_pseudo_ints_complex.irp.f | 56 +++++++++++++++ 9 files changed, 255 insertions(+), 196 deletions(-) create mode 100644 src/mo_one_e_ints/kin_mo_ints_complex.irp.f create mode 100644 src/mo_one_e_ints/mo_one_e_ints_complex.irp.f create mode 100644 src/mo_one_e_ints/pot_mo_ints_complex.irp.f create mode 100644 src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f diff --git a/src/mo_one_e_ints/EZFIO.cfg b/src/mo_one_e_ints/EZFIO.cfg index 23a6008e..fbbd378a 100644 --- a/src/mo_one_e_ints/EZFIO.cfg +++ b/src/mo_one_e_ints/EZFIO.cfg @@ -4,6 +4,12 @@ doc: Nucleus-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_e_n_real] +type: double precision +doc: Real part of the nucleus-electron integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [mo_integrals_e_n_imag] type: double precision doc: Imaginary part of the nucleus-electron integrals in |MO| basis set @@ -23,6 +29,12 @@ doc: Kinetic energy integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_kinetic_real] +type: double precision +doc: Real part of the kinetic energy integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [mo_integrals_kinetic_imag] type: double precision doc: Imaginary part of the kinetic energy integrals in |MO| basis set @@ -43,6 +55,12 @@ doc: Pseudopotential integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_pseudo_real] +type: double precision +doc: Real part of the pseudopotential integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [mo_integrals_pseudo_imag] type: double precision doc: Imaginary part of the pseudopotential integrals in |MO| basis set @@ -61,6 +79,12 @@ doc: One-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_one_e_integrals_real] +type: double precision +doc: Real part of the one-electron integrals in |MO| basis set +size: (mo_basis.mo_num,mo_basis.mo_num) +interface: ezfio + [mo_one_e_integrals_imag] type: double precision doc: Imaginary part of the one-electron integrals in |MO| basis set diff --git a/src/mo_one_e_ints/kin_mo_ints.irp.f b/src/mo_one_e_ints/kin_mo_ints.irp.f index d1a2f0cf..216628bb 100644 --- a/src/mo_one_e_ints/kin_mo_ints.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints.irp.f @@ -1,57 +1,23 @@ - BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_kinetic_integrals_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] implicit none BEGIN_DOC ! Kinetic energy integrals in the MO basis END_DOC - if (is_periodic) then - integer :: i,j - if (read_mo_integrals_kinetic) then - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) - print *, 'MO kinetic integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_kinetic_integrals_complex(j,i) = dcmplx(mo_kinetic_integrals(j,i), & - mo_kinetic_integrals_imag(j,i)) - enddo - enddo - else - call ao_to_mo_complex( & - ao_kinetic_integrals_complex, & - size(ao_kinetic_integrals_complex,1), & - mo_kinetic_integrals_complex, & - size(mo_kinetic_integrals_complex,1) & - ) - do i=1,mo_num - do j=1,mo_num - mo_kinetic_integrals(j,i)=dble(mo_kinetic_integrals_complex(j,i)) - mo_kinetic_integrals_imag(j,i)=dimag(mo_kinetic_integrals_complex(j,i)) - enddo - enddo - endif - if (write_mo_integrals_kinetic) then - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) - print *, 'MO kinetic integrals written to disk' - endif + + if (read_mo_integrals_kinetic) then + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + print *, 'MO kinetic integrals read from disk' else - if (read_mo_integrals_kinetic) then - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - print *, 'MO kinetic integrals read from disk' - else - call ao_to_mo( & - ao_kinetic_integrals, & - size(ao_kinetic_integrals,1), & - mo_kinetic_integrals, & - size(mo_kinetic_integrals,1) & - ) - endif - if (write_mo_integrals_kinetic) then - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) - print *, 'MO kinetic integrals written to disk' - endif + call ao_to_mo( & + ao_kinetic_integrals, & + size(ao_kinetic_integrals,1), & + mo_kinetic_integrals, & + size(mo_kinetic_integrals,1) & + ) + endif + if (write_mo_integrals_kinetic) then + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(mo_kinetic_integrals) + print *, 'MO kinetic integrals written to disk' endif END_PROVIDER diff --git a/src/mo_one_e_ints/kin_mo_ints_complex.irp.f b/src/mo_one_e_ints/kin_mo_ints_complex.irp.f new file mode 100644 index 00000000..10cecc85 --- /dev/null +++ b/src/mo_one_e_ints/kin_mo_ints_complex.irp.f @@ -0,0 +1,45 @@ + BEGIN_PROVIDER [double precision, mo_kinetic_integrals_real, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_kinetic_integrals_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the MO basis + END_DOC + integer :: i,j + + if (read_mo_integrals_kinetic) then + mo_kinetic_integrals_real = 0.d0 + mo_kinetic_integrals_imag = 0.d0 + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_real(mo_kinetic_integrals_real) + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + print *, 'MO kinetic integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_kinetic_integrals_complex(j,i) = dcmplx(mo_kinetic_integrals_real(j,i), & + mo_kinetic_integrals_imag(j,i)) + enddo + enddo + else + call ao_to_mo_complex( & + ao_kinetic_integrals_complex, & + size(ao_kinetic_integrals_complex,1), & + mo_kinetic_integrals_complex, & + size(mo_kinetic_integrals_complex,1) & + ) + endif + if (write_mo_integrals_kinetic) then + !mo_kinetic_integrals_real = 0.d0 + !mo_kinetic_integrals_imag = 0.d0 + do i=1,mo_num + do j=1,mo_num + mo_kinetic_integrals_real(j,i)=dble(mo_kinetic_integrals_complex(j,i)) + mo_kinetic_integrals_imag(j,i)=dimag(mo_kinetic_integrals_complex(j,i)) + enddo + enddo + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_real(mo_kinetic_integrals_real) + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + print *, 'MO kinetic integrals written to disk' + endif + +END_PROVIDER + diff --git a/src/mo_one_e_ints/mo_one_e_ints.irp.f b/src/mo_one_e_ints/mo_one_e_ints.irp.f index 4db21e46..ac4b4e3b 100644 --- a/src/mo_one_e_ints/mo_one_e_ints.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints.irp.f @@ -24,46 +24,3 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)] ENDIF END_PROVIDER - -BEGIN_PROVIDER [ double precision, mo_one_e_integrals_imag,(mo_num,mo_num)] - implicit none - integer :: i,j,n,l - BEGIN_DOC - ! array of the one-electron Hamiltonian on the |MO| basis : - ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed) - END_DOC - print*,'Providing the one-electron integrals' - - IF (read_mo_one_e_integrals) THEN - call ezfio_get_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) - ELSE - mo_one_e_integrals_imag = mo_integrals_n_e_imag + mo_kinetic_integrals_imag - - IF (DO_PSEUDO) THEN - mo_one_e_integrals_imag += mo_pseudo_integrals_imag - ENDIF - - ENDIF - - IF (write_mo_one_e_integrals) THEN - call ezfio_set_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) - print *, 'MO one-e integrals written to disk' - ENDIF - -END_PROVIDER - -BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] - implicit none - integer :: i,j,n,l - BEGIN_DOC - ! One-electron Hamiltonian in the |AO| basis. - END_DOC - - do i=1,mo_num - do j=1,mo_num - mo_one_e_integrals_complex(j,i)=dcmplx(mo_one_e_integrals(j,i), & - mo_one_e_integrals_imag(j,i)) - enddo - enddo - -END_PROVIDER diff --git a/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f b/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f new file mode 100644 index 00000000..a5463c12 --- /dev/null +++ b/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f @@ -0,0 +1,39 @@ + BEGIN_PROVIDER [ double precision, mo_one_e_integrals_real,(mo_num,mo_num)] +&BEGIN_PROVIDER [ double precision, mo_one_e_integrals_imag,(mo_num,mo_num)] +&BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] + implicit none + integer :: i,j,n,l + BEGIN_DOC + ! array of the one-electron Hamiltonian on the |MO| basis : + ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed) + END_DOC + print*,'Providing the one-electron integrals' + + IF (read_mo_one_e_integrals) THEN + call ezfio_get_mo_one_e_ints_mo_one_e_integrals_real(mo_one_e_integrals_real) + call ezfio_get_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + ELSE + mo_one_e_integrals_real = mo_integrals_n_e_real + mo_kinetic_integrals_real + mo_one_e_integrals_imag = mo_integrals_n_e_imag + mo_kinetic_integrals_imag + + IF (DO_PSEUDO) THEN + mo_one_e_integrals_real += mo_pseudo_integrals_real + mo_one_e_integrals_imag += mo_pseudo_integrals_imag + ENDIF + + ENDIF + do i=1,mo_num + do j=1,mo_num + mo_one_e_integrals_complex(j,i)=dcmplx(mo_one_e_integrals_real(j,i), & + mo_one_e_integrals_imag(j,i)) + enddo + enddo + + IF (write_mo_one_e_integrals) THEN + call ezfio_set_mo_one_e_ints_mo_one_e_integrals_real(mo_one_e_integrals_real) + call ezfio_set_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + print *, 'MO one-e integrals written to disk' + ENDIF + +END_PROVIDER + diff --git a/src/mo_one_e_ints/pot_mo_ints.irp.f b/src/mo_one_e_ints/pot_mo_ints.irp.f index 69ba26bc..90f7b06c 100644 --- a/src/mo_one_e_ints/pot_mo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints.irp.f @@ -1,58 +1,23 @@ - BEGIN_PROVIDER [double precision, mo_integrals_n_e, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_integrals_n_e_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [double precision, mo_integrals_n_e, (mo_num,mo_num)] implicit none BEGIN_DOC ! Nucleus-electron interaction on the |MO| basis END_DOC - if (is_periodic) then - integer :: i,j - if (read_mo_integrals_e_n) then - call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - call ezfio_get_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) - print *, 'MO N-e integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_integrals_n_e_complex(j,i) = dcmplx(mo_integrals_n_e(j,i), & - mo_integrals_n_e_imag(j,i)) - enddo - enddo - else - call ao_to_mo_complex( & - ao_integrals_n_e_complex, & - size(ao_integrals_n_e_complex,1), & - mo_integrals_n_e_complex, & - size(mo_integrals_n_e_complex,1) & - ) - do i=1,mo_num - do j=1,mo_num - mo_integrals_n_e(j,i)=dble(mo_integrals_n_e_complex(j,i)) - mo_integrals_n_e_imag(j,i)=dimag(mo_integrals_n_e_complex(j,i)) - enddo - enddo - endif - if (write_mo_integrals_e_n) then - call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - call ezfio_set_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) - print *, 'MO N-e integrals written to disk' - endif + if (read_mo_integrals_e_n) then + call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + print *, 'MO N-e integrals read from disk' else - if (read_mo_integrals_e_n) then - call ezfio_get_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - print *, 'MO N-e integrals read from disk' - else - call ao_to_mo( & - ao_integrals_n_e, & - size(ao_integrals_n_e,1), & - mo_integrals_n_e, & - size(mo_integrals_n_e,1) & - ) - endif - if (write_mo_integrals_e_n) then - call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) - print *, 'MO N-e integrals written to disk' - endif + call ao_to_mo( & + ao_integrals_n_e, & + size(ao_integrals_n_e,1), & + mo_integrals_n_e, & + size(mo_integrals_n_e,1) & + ) + endif + if (write_mo_integrals_e_n) then + call ezfio_set_mo_one_e_ints_mo_integrals_e_n(mo_integrals_n_e) + print *, 'MO N-e integrals written to disk' endif END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_ints_complex.irp.f new file mode 100644 index 00000000..3110f305 --- /dev/null +++ b/src/mo_one_e_ints/pot_mo_ints_complex.irp.f @@ -0,0 +1,46 @@ + BEGIN_PROVIDER [double precision, mo_integrals_n_e_real, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_integrals_n_e_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the MO basis + END_DOC + integer :: i,j + + if (read_mo_integrals_e_n) then + mo_integrals_n_e_real = 0.d0 + mo_integrals_n_e_imag = 0.d0 + call ezfio_get_mo_one_e_ints_mo_integrals_e_n_real(mo_integrals_n_e_real) + call ezfio_get_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + print *, 'MO N-e integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_integrals_n_e_complex(j,i) = dcmplx(mo_integrals_n_e_real(j,i), & + mo_integrals_n_e_imag(j,i)) + enddo + enddo + else + call ao_to_mo_complex( & + ao_integrals_n_e_complex, & + size(ao_integrals_n_e_complex,1), & + mo_integrals_n_e_complex, & + size(mo_integrals_n_e_complex,1) & + ) + endif + if (write_mo_integrals_e_n) then + !mo_integrals_n_e_real = 0.d0 + !mo_integrals_n_e_imag = 0.d0 + do i=1,mo_num + do j=1,mo_num + mo_integrals_n_e_real(j,i)=dble(mo_integrals_n_e_complex(j,i)) + mo_integrals_n_e_imag(j,i)=dimag(mo_integrals_n_e_complex(j,i)) + enddo + enddo + call ezfio_set_mo_one_e_ints_mo_integrals_e_n_real(mo_integrals_n_e_real) + call ezfio_set_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + print *, 'MO N-e integrals written to disk' + endif + +END_PROVIDER + + diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f index 3c4674dc..179b33ed 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f @@ -1,65 +1,26 @@ - BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_pseudo_integrals_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] implicit none BEGIN_DOC ! Pseudopotential integrals in |MO| basis END_DOC - if (is_periodic) then - integer :: i,j - if (read_mo_integrals_pseudo) then - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) - print *, 'MO pseudopotential integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_pseudo_integrals_complex(j,i) = dcmplx(mo_pseudo_integrals(j,i), & - mo_pseudo_integrals_imag(j,i)) - enddo - enddo - else if (do_pseudo) then - call ao_to_mo_complex( & - ao_pseudo_integrals_complex, & - size(ao_pseudo_integrals_complex,1), & - mo_pseudo_integrals_complex, & - size(mo_pseudo_integrals_complex,1) & - ) - do i=1,mo_num - do j=1,mo_num - mo_pseudo_integrals(j,i)=dble(mo_pseudo_integrals_complex(j,i)) - mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) - enddo - enddo - else - mo_pseudo_integrals = 0.d0 - mo_pseudo_integrals_imag = 0.d0 - mo_pseudo_integrals_complex = (0.d0,0.d0) - endif - if (write_mo_integrals_pseudo) then - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) - print *, 'MO pseudopotential integrals written to disk' - endif + if (read_mo_integrals_pseudo) then + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + print *, 'MO pseudopotential integrals read from disk' + else if (do_pseudo) then + call ao_to_mo( & + ao_pseudo_integrals, & + size(ao_pseudo_integrals,1), & + mo_pseudo_integrals, & + size(mo_pseudo_integrals,1) & + ) else - if (read_mo_integrals_pseudo) then - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - print *, 'MO pseudopotential integrals read from disk' - else if (do_pseudo) then - call ao_to_mo( & - ao_pseudo_integrals, & - size(ao_pseudo_integrals,1), & - mo_pseudo_integrals, & - size(mo_pseudo_integrals,1) & - ) - else - mo_pseudo_integrals = 0.d0 - endif + mo_pseudo_integrals = 0.d0 + endif - if (write_mo_integrals_pseudo) then - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) - print *, 'MO pseudopotential integrals written to disk' - endif + if (write_mo_integrals_pseudo) then + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(mo_pseudo_integrals) + print *, 'MO pseudopotential integrals written to disk' endif END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f new file mode 100644 index 00000000..9ad6a831 --- /dev/null +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f @@ -0,0 +1,56 @@ + BEGIN_PROVIDER [double precision, mo_pseudo_integrals_real, (mo_num,mo_num)] +&BEGIN_PROVIDER [double precision, mo_pseudo_integrals_imag, (mo_num,mo_num)] +&BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] + implicit none + BEGIN_DOC + ! Pseudopotential integrals in |MO| basis + END_DOC + integer :: i,j + + if (read_mo_integrals_pseudo) then + mo_pseudo_integrals_real = 0.d0 + mo_pseudo_integrals_imag = 0.d0 + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_real(mo_pseudo_integrals_real) + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + print *, 'MO pseudopotential integrals read from disk' + do i=1,mo_num + do j=1,mo_num + mo_pseudo_integrals_complex(j,i) = dcmplx(mo_pseudo_integrals_real(j,i), & + mo_pseudo_integrals_imag(j,i)) + enddo + enddo + else if (do_pseudo) then + call ao_to_mo_complex( & + ao_pseudo_integrals_complex, & + size(ao_pseudo_integrals_complex,1), & + mo_pseudo_integrals_complex, & + size(mo_pseudo_integrals_complex,1) & + ) + do i=1,mo_num + do j=1,mo_num + mo_pseudo_integrals_real(j,i)=dble(mo_pseudo_integrals_complex(j,i)) + mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) + enddo + enddo + else + mo_pseudo_integrals_real = 0.d0 + mo_pseudo_integrals_imag = 0.d0 + mo_pseudo_integrals_complex = (0.d0,0.d0) + endif + if (write_mo_integrals_pseudo) then + !mo_pseudo_integrals_real = 0.d0 + !mo_pseudo_integrals_imag = 0.d0 + do i=1,mo_num + do j=1,mo_num + mo_pseudo_integrals_real(j,i)=dble(mo_pseudo_integrals_complex(j,i)) + mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) + enddo + enddo + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_real(mo_pseudo_integrals_real) + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + print *, 'MO pseudopotential integrals written to disk' + endif + +END_PROVIDER + + From c48654f5508148fd627168e676676e638e077c56 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 14:17:46 -0600 Subject: [PATCH 029/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 8e7e0bd6..70f44c7d 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -15,9 +15,6 @@ ao_ints [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] compute_ao_integrals_jl -mo_one_e_ints - make separate providers for real/imag/complex parts for periodic - mo_basis decide how to handle real/imag/complex parts of mo_coef (maybe just need to chage save_mos?) reorder_core_orb: implement for periodic @@ -32,6 +29,10 @@ scf mo_two_e_ints not started +done: +mo_one_e_ints + make separate providers for real/imag/complex parts for periodic + From 40abfb368ac27680a3fb4c4fcd81f698cfcb61fc Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 14:51:48 -0600 Subject: [PATCH 030/256] minor fix in scf --- src/scf_utils/roothaan_hall_scf_complex.irp.f | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/scf_utils/roothaan_hall_scf_complex.irp.f b/src/scf_utils/roothaan_hall_scf_complex.irp.f index e5f0e27b..e52daba9 100644 --- a/src/scf_utils/roothaan_hall_scf_complex.irp.f +++ b/src/scf_utils/roothaan_hall_scf_complex.irp.f @@ -234,7 +234,7 @@ END_DOC endif enddo enddo - + deallocate(scratch) ! Pad B matrix and build the X matrix do i=1,dim_DIIS @@ -254,8 +254,8 @@ END_DOC ipiv(dim_DIIS+1) & ) - double precision, allocatable :: AF(:,:) - allocate (AF(dim_DIIS+1,dim_DIIS+1)) + double precision, allocatable :: AF(:,:),scratch_d1(:) + allocate (AF(dim_DIIS+1,dim_DIIS+1),scratch_d1(1)) double precision :: rcond, ferr, berr integer :: iwork(dim_DIIS+1), lwork @@ -268,13 +268,13 @@ END_DOC rcond, & ferr, & berr, & - scratch,-1, & + scratch_d1,-1, & iwork, & info & ) - lwork = int(scratch(1,1)) - deallocate(scratch) - allocate(scratch(lwork,1)) + lwork = int(scratch_d1(1)) + deallocate(scratch_d1) + allocate(scratch_d1(lwork)) call dsysvx('N','U',dim_DIIS+1,1, & B_matrix_DIIS,size(B_matrix_DIIS,1), & @@ -285,11 +285,11 @@ END_DOC rcond, & ferr, & berr, & - scratch,size(scratch), & + scratch_d1,size(scratch_d1), & iwork, & info & ) - deallocate(scratch,ipiv) + deallocate(scratch_d1,ipiv) if(info < 0) then stop 'bug in DIIS' From 15f441819e8861f4975394ec22edf101c8c179a7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 14:55:04 -0600 Subject: [PATCH 031/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 70f44c7d..c03d9b91 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -23,16 +23,11 @@ mo_basis scf finish complex DIIS finish ao_two_e_integral_{alpha,beta}_complex (need reverse index?) - finish extrapolate_Fock_matrix_complex finish eigenvectors_Fock_matrix_AO_complex mo_two_e_ints not started -done: -mo_one_e_ints - make separate providers for real/imag/complex parts for periodic - @@ -341,9 +336,6 @@ src/scf_utils/roothaan_hall_scf_complex.irp.f subroutine Roothaan_Hall_SCF_complex similar to real has soft_touch mo_coef_complex and call to save_mos (see other notes on real/imag parts) - subroutine extrapolate_Fock_matrix_complex - TODO: check variable types? - complex scratch is being used in dsysvx, should be real src/scf_utils/scf_density_matrix_ao_complex.irp.f complex versions of providers From 4e5cae41d2407cabf60a088803dd376b35ab3e3b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 15:20:11 -0600 Subject: [PATCH 032/256] call complex roothaan-hall scf --- src/hartree_fock/scf.irp.f | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index dd85bba8..7a24bf97 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -92,8 +92,11 @@ subroutine run integer :: i_it, i, j, k mo_label = "Orthonormalized" - - call roothaan_hall_scf + if (is_periodic) then + call roothan_hall_scf_complex + else + call roothaan_hall_scf + endif call ezfio_set_hartree_fock_energy(SCF_energy) end From e64faf28454e1ca1ecab67f7e27c44eceefd00fc Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 15:39:20 -0600 Subject: [PATCH 033/256] added s_half_inv_complex and s_half_complex --- src/ao_one_e_ints/ao_overlap.irp.f | 93 ++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 6510fd23..49b75731 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -239,6 +239,65 @@ BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ] enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, S_half_inv_complex, (AO_num,AO_num) ] + + BEGIN_DOC +! :math:`X = S^{-1/2}` obtained by SVD + END_DOC + + implicit none + + integer :: num_linear_dependencies + integer :: LDA, LDC + double precision, allocatable :: D(:) + complex*16, allocatable :: U(:,:),Vt(:,:) + integer :: info, i, j, k + double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6 + + LDA = size(AO_overlap,1) + LDC = size(S_half_inv_complex,1) + + allocate( & + U(LDC,AO_num), & + Vt(LDA,AO_num), & + D(AO_num)) + + call svd_complex( & + ao_overlap_complex,LDA, & + U,LDC, & + D, & + Vt,LDA, & + AO_num,AO_num) + + num_linear_dependencies = 0 + do i=1,AO_num + print*,D(i) + if(abs(D(i)) <= threshold_overlap_AO_eigenvalues) then + D(i) = 0.d0 + num_linear_dependencies += 1 + else + ASSERT (D(i) > 0.d0) + D(i) = 1.d0/sqrt(D(i)) + endif + do j=1,AO_num + S_half_inv_complex(j,i) = 0.d0 + enddo + enddo + write(*,*) 'linear dependencies',num_linear_dependencies + + do k=1,AO_num + if(D(k) /= 0.d0) then + do j=1,AO_num + do i=1,AO_num + S_half_inv_complex(i,j) = S_half_inv_complex(i,j) + U(i,k)*D(k)*Vt(k,j) + enddo + enddo + endif + enddo + + END_PROVIDER @@ -276,3 +335,37 @@ BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, S_half_complex, (ao_num,ao_num) ] + implicit none + BEGIN_DOC + ! :math:`S^{1/2}` + END_DOC + + integer :: i,j,k + complex*16, allocatable :: U(:,:) + complex*16, allocatable :: Vt(:,:) + double precision, allocatable :: D(:) + + allocate(U(ao_num,ao_num),Vt(ao_num,ao_num),D(ao_num)) + + call svd_complex(ao_overlap_complex,size(ao_overlap_complex,1),U,size(U,1),D,Vt,size(Vt,1),ao_num,ao_num) + + do i=1,ao_num + D(i) = dsqrt(D(i)) + do j=1,ao_num + S_half_complex(j,i) = (0.d0,0.d0) + enddo + enddo + + do k=1,ao_num + do j=1,ao_num + do i=1,ao_num + S_half_complex(i,j) = S_half_complex(i,j) + U(i,k)*D(k)*Vt(k,j) + enddo + enddo + enddo + + deallocate(U,Vt,D) + +END_PROVIDER + From b0d27f85034bee81640a46097025f4ca60dd3140 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 15:41:23 -0600 Subject: [PATCH 034/256] complex diis --- src/scf_utils/diis_complex.irp.f | 68 ++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 26 deletions(-) diff --git a/src/scf_utils/diis_complex.irp.f b/src/scf_utils/diis_complex.irp.f index 8bba5725..721a9751 100644 --- a/src/scf_utils/diis_complex.irp.f +++ b/src/scf_utils/diis_complex.irp.f @@ -47,7 +47,7 @@ BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_AO_complex, (AO_num, AO_num)] END_PROVIDER -BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_MO, (mo_num, mo_num)] +BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_MO_complex, (mo_num, mo_num)] implicit none begin_doc ! Commutator FPS - SPF in MO basis @@ -66,14 +66,13 @@ END_PROVIDER implicit none - double precision, allocatable :: scratch(:,:),work(:),Xt(:,:) - integer :: lwork,info + double precision, allocatable :: rwork(:) + integer :: lwork,info,lrwork + complex*16, allocatable :: scratch(:,:),Xt(:,:),work(:) integer :: i,j - lwork = 3*AO_num - 1 allocate( & scratch(AO_num,AO_num), & - work(lwork), & Xt(AO_num,AO_num) & ) @@ -81,46 +80,63 @@ END_PROVIDER do i=1,AO_num do j=1,AO_num - Xt(i,j) = S_half_inv(j,i) + Xt(i,j) = dconjg(S_half_inv_complex(j,i)) enddo enddo ! Calculate Fock matrix in orthogonal basis: F' = Xt.F.X - call dgemm('N','N',AO_num,AO_num,AO_num, & - 1.d0, & - Fock_matrix_AO,size(Fock_matrix_AO,1), & - S_half_inv,size(S_half_inv,1), & - 0.d0, & - eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1)) + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & + Fock_matrix_AO_complex,size(Fock_matrix_AO_complex,1), & + S_half_inv_complex,size(s_half_inv_complex,1), & + (0.d0,0.d0), & + eigenvectors_Fock_matrix_AO_complex, & + size(eigenvectors_Fock_matrix_AO_complex,1)) - call dgemm('N','N',AO_num,AO_num,AO_num, & - 1.d0, & + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & Xt,size(Xt,1), & - eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1), & - 0.d0, & + eigenvectors_Fock_matrix_AO_complex, & + size(eigenvectors_Fock_matrix_AO_complex,1), & + (0.d0,0.d0), & scratch,size(scratch,1)) ! Diagonalize F' to obtain eigenvectors in orthogonal basis C' and eigenvalues + lrwork = 3*ao_num - 2 + allocate(rwork(lrwork), work(1)) + lwork = -1 - call dsyev('V','U',AO_num, & - scratch,size(scratch,1), & - eigenvalues_Fock_matrix_AO, & - work,lwork,info) + call zheev('V','U',ao_num, & + scratch,size(scratch,1), & + eigenvalues_Fock_matrix_AO_complex, & + work,lwork,rwork,info) + + lwork = int(work(1)) + deallocate(work) + allocate(work(lwork)) + + call zheev('V','U',ao_num, & + scratch,size(scratch,1), & + eigenvalues_Fock_matrix_AO_complex, & + work,lwork,rwork,info) if(info /= 0) then print *, irp_here//' failed : ', info stop 1 endif - + + deallocate(work,rwork) ! Back-transform eigenvectors: C =X.C' - call dgemm('N','N',AO_num,AO_num,AO_num, & - 1.d0, & - S_half_inv,size(S_half_inv,1), & + call zgemm('N','N',AO_num,AO_num,AO_num, & + (1.d0,0.d0), & + S_half_inv_complex,size(S_half_inv_complex,1), & scratch,size(scratch,1), & - 0.d0, & - eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1)) + (0.d0,0.d0), & + eigenvectors_Fock_matrix_AO_complex, & + size(eigenvectors_Fock_matrix_AO_complex,1)) + deallocate(scratch) END_PROVIDER From cc840cdbc1111eb7549768ff0dbbe65d912616b1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 16:23:00 -0600 Subject: [PATCH 035/256] restructured mo_coef_complex provider; added mo_coef_real; maybe need to change ocaml? --- src/mo_basis/EZFIO.cfg | 6 ++ src/mo_basis/mos_complex.irp.f | 117 +++++++++++++++++++++------- src/mo_basis/utils.irp.f | 97 +++++++++++++---------- src/utils_periodic/qp2-pbc-diff.txt | 5 -- 4 files changed, 151 insertions(+), 74 deletions(-) diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index 874af46a..7a1c3a0a 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -9,6 +9,12 @@ doc: Coefficient of the i-th |AO| on the j-th |MO| interface: ezfio size: (ao_basis.ao_num,mo_basis.mo_num) +[mo_coef_real] +type: double precision +doc: Imaginary part of the MO coefficient of the i-th |AO| on the j-th |MO| +interface: ezfio +size: (ao_basis.ao_num,mo_basis.mo_num) + [mo_coef_imag] type: double precision doc: Imaginary part of the MO coefficient of the i-th |AO| on the j-th |MO| diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index 54f98ef2..7a4361b7 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -1,4 +1,4 @@ -BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] +BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] implicit none BEGIN_DOC ! Molecular orbital coefficients on |AO| basis set @@ -8,14 +8,16 @@ BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) END_DOC integer :: i, j - double precision, allocatable :: buffer(:,:) - logical :: exists + double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) + logical :: exists_re,exists_im,exists PROVIDE ezfio_filename if (mpi_master) then ! Coefs - call ezfio_has_mo_basis_mo_coef_imag(exists) + call ezfio_has_mo_basis_mo_coef_real(exists_re) + call ezfio_has_mo_basis_mo_coef_imag(exists_im) + exists = (exists_re.and.exists_im) endif IRP_IF MPI_DEBUG print *, irp_here, mpi_rank @@ -26,51 +28,106 @@ BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] integer :: ierr call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_imag with MPI' + stop 'Unable to read mo_coef_real/imag with MPI' endif IRP_ENDIF - + if (exists) then if (mpi_master) then - call ezfio_get_mo_basis_mo_coef_imag(mo_coef_imag) - write(*,*) 'Read mo_coef_imag' + allocate(buffer_re(ao_num,mo_num),buffer_im(ao_num,mo_num)) + call ezfio_get_mo_basis_mo_coef_real(buffer_re) + call ezfio_get_mo_basis_mo_coef_imag(buffer_im) + write(*,*) 'Read mo_coef_real/imag' + do i=1,mo_num + do j=1,ao_num + mo_coef_complex(j,i) = dcmplx(buffer_re(j,i),buffer_im(j,i)) + enddo + enddo + deallocate(buffer_re,buffer_im) endif IRP_IF MPI - call MPI_BCAST( mo_coef_imag, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST( mo_coef_complex, mo_num*ao_num, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_imag with MPI' + stop 'Unable to read mo_coef_real with MPI' endif IRP_ENDIF else ! Orthonormalized AO basis do i=1,mo_num do j=1,ao_num - mo_coef_imag(j,i) = 0.d0 + mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i) enddo enddo endif END_PROVIDER -BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] - implicit none - BEGIN_DOC - ! Molecular orbital coefficients on |AO| basis set - ! - ! mo_coef_complex(i,j) = coefficient of the i-th |AO| on the jth |MO| - ! - ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) - END_DOC - integer :: i, j - PROVIDE ezfio_filename +! BEGIN_PROVIDER [ double precision, mo_coef_real, (ao_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] +!&BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] +! implicit none +! BEGIN_DOC +! ! Molecular orbital coefficients on |AO| basis set +! ! +! ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| +! ! +! ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) +! END_DOC +! integer :: i, j +! double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) +! logical :: exists_re,exists_im,exists +! PROVIDE ezfio_filename +! +! +! if (mpi_master) then +! ! Coefs +! call ezfio_has_mo_basis_mo_coef_real(exists_re) +! call ezfio_has_mo_basis_mo_coef_imag(exists_im) +! exists = (exists_re.and.exists_im) +! endif +! IRP_IF MPI_DEBUG +! print *, irp_here, mpi_rank +! call MPI_BARRIER(MPI_COMM_WORLD, ierr) +! IRP_ENDIF +! IRP_IF MPI +! include 'mpif.h' +! integer :: ierr +! call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read mo_coef_real/imag with MPI' +! endif +! IRP_ENDIF +! +! if (exists) then +! if (mpi_master) then +! call ezfio_get_mo_basis_mo_coef_real(mo_coef_real) +! call ezfio_get_mo_basis_mo_coef_imag(mo_coef_imag) +! write(*,*) 'Read mo_coef_real/imag' +! endif +! IRP_IF MPI +! call MPI_BCAST( mo_coef_real, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read mo_coef_real with MPI' +! endif +! call MPI_BCAST( mo_coef_imag, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read mo_coef_imag with MPI' +! endif +! IRP_ENDIF +! do i=1,mo_num +! do j=1,ao_num +! mo_coef_complex(j,i) = dcmplx(mo_coef_real(j,i),mo_coef_imag(j,i)) +! enddo +! enddo +! else +! ! Orthonormalized AO basis +! do i=1,mo_num +! do j=1,ao_num +! mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i) +! enddo +! enddo +! endif +!END_PROVIDER - provide mo_coef mo_coef_imag - - do i=1,mo_num - do j=1,ao_num - mo_coef_complex(j,i) = dcmplx(mo_coef(j,i),mo_coef_imag(j,i)) - enddo - enddo -END_PROVIDER BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ] implicit none diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 5ffcb34f..466d5f27 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -1,6 +1,6 @@ subroutine save_mos implicit none - double precision, allocatable :: buffer(:,:) + double precision, allocatable :: buffer(:,:),buffer_im(:,:) integer :: i,j !TODO: change this for periodic? ! save real/imag parts of mo_coef_complex @@ -10,62 +10,75 @@ subroutine save_mos call ezfio_set_mo_basis_mo_num(mo_num) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) - allocate ( buffer(ao_num,mo_num) ) - buffer = 0.d0 - do j = 1, mo_num - do i = 1, ao_num - buffer(i,j) = mo_coef(i,j) - enddo - enddo - call ezfio_set_mo_basis_mo_coef(buffer) - call ezfio_set_mo_basis_mo_occ(mo_occ) - call ezfio_set_mo_basis_mo_class(mo_class) if (is_periodic) then + allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) + buffer = 0.d0 + buffer_im = 0.d0 + do j = 1, mo_num + do i = 1, ao_num + buffer(i,j) = dble(mo_coef_complex(i,j)) + buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_real(buffer) + call ezfio_set_mo_basis_mo_coef_imag(buffer_im) + deallocate (buffer,buffer_im) + else + allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 do j = 1, mo_num do i = 1, ao_num - buffer(i,j) = mo_coef_imag(i,j) + buffer(i,j) = mo_coef(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_imag(buffer) + call ezfio_set_mo_basis_mo_coef(buffer) + deallocate (buffer) endif - deallocate (buffer) + call ezfio_set_mo_basis_mo_occ(mo_occ) + call ezfio_set_mo_basis_mo_class(mo_class) end subroutine save_mos_no_occ implicit none - double precision, allocatable :: buffer(:,:) + double precision, allocatable :: buffer(:,:),buffer_im(:,:) integer :: i,j call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename)) !call ezfio_set_mo_basis_mo_num(mo_num) !call ezfio_set_mo_basis_mo_label(mo_label) !call ezfio_set_mo_basis_ao_md5(ao_md5) - allocate ( buffer(ao_num,mo_num) ) - buffer = 0.d0 - do j = 1, mo_num - do i = 1, ao_num - buffer(i,j) = mo_coef(i,j) - enddo - enddo - call ezfio_set_mo_basis_mo_coef(buffer) if (is_periodic) then + allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) + buffer = 0.d0 + buffer_im = 0.d0 + do j = 1, mo_num + do i = 1, ao_num + buffer(i,j) = dble(mo_coef_complex(i,j)) + buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_real(buffer) + call ezfio_set_mo_basis_mo_coef_imag(buffer_im) + deallocate (buffer,buffer_im) + else + allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 do j = 1, mo_num do i = 1, ao_num - buffer(i,j) = mo_coef_imag(i,j) + buffer(i,j) = mo_coef(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_imag(buffer) + call ezfio_set_mo_basis_mo_coef(buffer) + deallocate (buffer) endif - deallocate (buffer) end subroutine save_mos_truncated(n) implicit none + double precision, allocatable :: buffer(:,:),buffer_im(:,:) double precision, allocatable :: buffer(:,:) integer :: i,j,n @@ -74,26 +87,32 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_num(n) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) - allocate ( buffer(ao_num,n) ) - buffer = 0.d0 - do j = 1, n - do i = 1, ao_num - buffer(i,j) = mo_coef(i,j) - enddo - enddo - call ezfio_set_mo_basis_mo_coef(buffer) - call ezfio_set_mo_basis_mo_occ(mo_occ) - call ezfio_set_mo_basis_mo_class(mo_class) if (is_periodic) then + allocate ( buffer(ao_num,n),buffer_im(ao_num,n)) + buffer = 0.d0 + buffer_im = 0.d0 + do j = 1, n + do i = 1, ao_num + buffer(i,j) = dble(mo_coef_complex(i,j)) + buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + enddo + enddo + call ezfio_set_mo_basis_mo_coef_real(buffer) + call ezfio_set_mo_basis_mo_coef_imag(buffer_im) + deallocate (buffer,buffer_im) + else + allocate ( buffer(ao_num,n) ) buffer = 0.d0 do j = 1, n do i = 1, ao_num - buffer(i,j) = mo_coef_imag(i,j) + buffer(i,j) = mo_coef(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_imag(buffer) + call ezfio_set_mo_basis_mo_coef(buffer) + deallocate (buffer) endif - deallocate (buffer) + call ezfio_set_mo_basis_mo_occ(mo_occ) + call ezfio_set_mo_basis_mo_class(mo_class) end diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index c03d9b91..75693491 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -5,7 +5,6 @@ compare master-features_periodic TODO: ao_ints reverse index - s_half_inv_complex ao_overlap_abs for complex ao_integrals_n_e_per_atom_complex? not implemented for periodic: @@ -16,14 +15,10 @@ ao_ints compute_ao_integrals_jl mo_basis - decide how to handle real/imag/complex parts of mo_coef (maybe just need to chage save_mos?) reorder_core_orb: implement for periodic - save_mos_no_occ: implement for periodic scf - finish complex DIIS finish ao_two_e_integral_{alpha,beta}_complex (need reverse index?) - finish eigenvectors_Fock_matrix_AO_complex mo_two_e_ints not started From 0722e12882be0d087cbebc7260eb1fbf1e173a08 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jan 2020 16:56:27 -0600 Subject: [PATCH 036/256] modified reorder_core_orb for periodic --- src/bitmask/track_orb.irp.f | 116 ++++++++++++++++++---------- src/utils_periodic/qp2-pbc-diff.txt | 3 - 2 files changed, 75 insertions(+), 44 deletions(-) diff --git a/src/bitmask/track_orb.irp.f b/src/bitmask/track_orb.irp.f index e907f73d..9c430467 100644 --- a/src/bitmask/track_orb.irp.f +++ b/src/bitmask/track_orb.irp.f @@ -30,47 +30,81 @@ subroutine initialize_mo_coef_begin_iteration end subroutine reorder_core_orb - implicit none - BEGIN_DOC - ! TODO: modify for complex -! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration` - END_DOC - integer :: i,j,iorb - integer :: k,l - double precision, allocatable :: accu(:) - integer, allocatable :: index_core_orb(:),iorder(:) - double precision, allocatable :: mo_coef_tmp(:,:) - allocate(accu(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) - allocate(mo_coef_tmp(ao_num,mo_num)) - - do i = 1, n_core_orb - iorb = list_core(i) - do j = 1, mo_num - accu(j) = 0.d0 - iorder(j) = j - do k = 1, ao_num - do l = 1, ao_num - accu(j) += mo_coef_begin_iteration(k,iorb) * mo_coef(l,j) * ao_overlap(k,l) + implicit none + BEGIN_DOC + ! TODO: test for complex + ! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration` + END_DOC + integer :: i,j,iorb + integer :: k,l + integer, allocatable :: index_core_orb(:),iorder(:) + double precision, allocatable :: accu(:) + integer :: i1,i2 + if (is_periodic) then + complex*16, allocatable :: accu_c(:) + allocate(accu(mo_num),accu_c(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, mo_num + accu(j) = 0.d0 + accu_c(j) = (0.d0,0.d0) + iorder(j) = j + do k = 1, ao_num + do l = 1, ao_num + accu_c(j) += dconjg(mo_coef_begin_iteration_complex(k,iorb)) * & + mo_coef_complex(l,j) * ao_overlap_complex(k,l) + enddo + enddo + accu(j) = -cdabs(accu_c(j)) + enddo + call dsort(accu,iorder,mo_num) + index_core_orb(i) = iorder(1) enddo - enddo - accu(j) = -dabs(accu(j)) - enddo - call dsort(accu,iorder,mo_num) - index_core_orb(i) = iorder(1) - enddo - double precision :: x - integer :: i1,i2 - do j = 1, n_core_orb - i1 = list_core(j) - i2 = index_core_orb(j) - do i=1,ao_num - x = mo_coef(i,i1) - mo_coef(i,i1) = mo_coef(i,i2) - mo_coef(i,i2) = x - enddo - enddo -!call loc_cele_routine - - deallocate(accu,index_core_orb, iorder) + complex*16 :: x_c + do j = 1, n_core_orb + i1 = list_core(j) + i2 = index_core_orb(j) + do i=1,ao_num + x_c = mo_coef_complex(i,i1) + mo_coef_complex(i,i1) = mo_coef_complex(i,i2) + mo_coef_complex(i,i2) = x_c + enddo + enddo + !call loc_cele_routine + + deallocate(accu,accu_c,index_core_orb, iorder) + else + allocate(accu(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) + + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, mo_num + accu(j) = 0.d0 + iorder(j) = j + do k = 1, ao_num + do l = 1, ao_num + accu(j) += mo_coef_begin_iteration(k,iorb) * mo_coef(l,j) * ao_overlap(k,l) + enddo + enddo + accu(j) = -dabs(accu(j)) + enddo + call dsort(accu,iorder,mo_num) + index_core_orb(i) = iorder(1) + enddo + + double precision :: x + do j = 1, n_core_orb + i1 = list_core(j) + i2 = index_core_orb(j) + do i=1,ao_num + x = mo_coef(i,i1) + mo_coef(i,i1) = mo_coef(i,i2) + mo_coef(i,i2) = x + enddo + enddo + !call loc_cele_routine + + deallocate(accu,index_core_orb, iorder) + endif end diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 75693491..dd8e69c2 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -14,9 +14,6 @@ ao_ints [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] compute_ao_integrals_jl -mo_basis - reorder_core_orb: implement for periodic - scf finish ao_two_e_integral_{alpha,beta}_complex (need reverse index?) From a632b6af56134cb25a91a6d95180327f59d62360 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 11:16:04 -0600 Subject: [PATCH 037/256] integral testing --- src/mo_basis/utils.irp.f | 1 - .../export_integrals_ao_periodic.irp.f | 24 ++++++++++++------- .../import_mo_coef_periodic.irp.f | 3 ++- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 466d5f27..4db5d3e9 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -79,7 +79,6 @@ end subroutine save_mos_truncated(n) implicit none double precision, allocatable :: buffer(:,:),buffer_im(:,:) - double precision, allocatable :: buffer(:,:) integer :: i,j,n call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename)) diff --git a/src/utils_periodic/export_integrals_ao_periodic.irp.f b/src/utils_periodic/export_integrals_ao_periodic.irp.f index 1f190749..8f268c3e 100644 --- a/src/utils_periodic/export_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/export_integrals_ao_periodic.irp.f @@ -130,8 +130,10 @@ provide ao_two_e_integrals_in_map ! call ezfio_set_ao_one_e_ints_ao_integrals_n_e(A(1:ao_num, 1:ao_num)) ! call ezfio_set_ao_one_e_ints_ao_integrals_n_e_imag(B(1:ao_num, 1:ao_num)) ! call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e("Read") - complex*16 :: int2e_tmp1,int2e_tmp2,get_ao_two_e_integral_periodic_simple,get_ao_two_e_integral_periodic + complex*16 :: int2e_tmp1,int2e_tmp2,get_ao_two_e_integral_periodic_simple,get_ao_two_e_integral_periodic, tmp_cmplx double precision :: tmp3,tmp4,tmp5,tmp6 + double precision :: thr0 + thr0 = 1.d-10 allocate(buffer_i_1(ao_num**3), buffer_values_1(ao_num**3)) allocate(buffer_i_2(ao_num**3), buffer_values_2(ao_num**3)) iunit = getunitandopen('W.qp','r') @@ -141,26 +143,30 @@ provide ao_two_e_integrals_in_map buffer_values_2 = 0.d0 do read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im + tmp_cmplx = dcmplx(tmp_re,tmp_im) int2e_tmp1 = get_ao_two_e_integral_periodic_simple(i,j,k,l,ao_integrals_map,ao_integrals_map_2) int2e_tmp2 = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) - print'(4(I4),3(E15.7))',i,j,k,l,tmp_re,real(int2e_tmp1),real(int2e_tmp2) - print'(4(I4),3(E15.7))',i,j,k,l,tmp_im,imag(int2e_tmp1),imag(int2e_tmp2) + ! print'(4(I4),3(E15.7))',i,j,k,l,tmp_re,real(int2e_tmp1),real(int2e_tmp2) + ! print'(4(I4),3(E15.7))',i,j,k,l,tmp_im,imag(int2e_tmp1),imag(int2e_tmp2) call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) - print*,use_map1,idx_tmp,sign +! print*,use_map1,idx_tmp,sign call map_get(ao_integrals_map,idx_tmp,tmp3) call map_get(ao_integrals_map_2,idx_tmp,tmp4) call map_get(ao_integrals_map,idx_tmp+1,tmp5) call map_get(ao_integrals_map_2,idx_tmp+1,tmp6) - print*,tmp3,tmp4 - print*,tmp5,tmp6 + ! print*,tmp3,tmp4 + ! print*,tmp5,tmp6 + if (cdabs(tmp_cmplx-int2e_tmp1).gt.thr0) then + print'(4(I4),4(E15.7))',i,j,k,l,tmp_cmplx,int2e_tmp1 + endif integer*8 :: ii ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - print*,'cache(pbc)=', ao_integrals_cache_periodic(ii) - print*,'cache(old)=', ao_integrals_cache(ii) - print* +! print*,'cache(pbc)=', ao_integrals_cache_periodic(ii) +! print*,'cache(old)=', ao_integrals_cache(ii) +! print* ! if (use_map1) then ! n_integrals_1 += 1 ! buffer_i_1(n_integrals_1-1)=idx_tmp diff --git a/src/utils_periodic/import_mo_coef_periodic.irp.f b/src/utils_periodic/import_mo_coef_periodic.irp.f index bd41f776..8cff838c 100644 --- a/src/utils_periodic/import_mo_coef_periodic.irp.f +++ b/src/utils_periodic/import_mo_coef_periodic.irp.f @@ -17,7 +17,8 @@ subroutine run iunit = getunitandopen('C.qp','r') do - read (iunit,*,end=10) i,j, mo_coef(i,j), mo_coef_imag(i,j) + read (iunit,*,end=10) i,j, int_re, int_im + mo_coef_complex(i,j) = dcmplx(int_re,int_im) enddo 10 continue close(iunit) From 240c58c84fd1f202bd069b9a31bc35b1bb61b6bc Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 11:25:19 -0600 Subject: [PATCH 038/256] fixed problem with 2e int mapping --- src/ao_two_e_ints/map_integrals.irp.f | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 4c30c4df..40c35644 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -346,12 +346,22 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) sign=-1.d0 use_map1=.True. endif - else if (iltk.eqv.ikltjl) then - sign=1.d0 - use_map1=.False. + else if (iltk.eqv.jltl) then + if (iltk) then + sign=1.d0 + use_map1=.True. + else + sign=-1.d0 + use_map1=.True. + endif else - sign=-1.d0 - use_map1=.False. + if (jltl.eqv.ikltjl) then + sign=1.d0 + use_map1=.False. + else + sign=-1.d0 + use_map1=.False. + endif endif endif end From 948b16d4c578157135ceefdd0ef9ef8f0311fe8e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 14:52:58 -0600 Subject: [PATCH 039/256] cleaned up mapping function --- src/ao_two_e_ints/map_integrals.irp.f | 61 +++++++++++++++------------ 1 file changed, 35 insertions(+), 26 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 40c35644..10357b78 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -292,14 +292,30 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) ! use_map1: true if integral is in first ao map, false if integral is in second ao map ! idx: position of real part of integral in map (imag part is at idx+1) ! sign: sign of imaginary part + ! + ! + ! for , conditionals are [a | | | | | | | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | m1 | m1* | m2 | m2* | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | TTT | TTF | FFT | FFF | FTT | TFF | TFT | FTF | + ! | | 0TT | T0F | 0FT | F0F | | | | | + ! | | T0T | 0TF | F0T | 0FF | | | | | + ! | | | | | | TT0 | | FF0 | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | FT0 | TF0 | | | | | | | + ! | | 00T | 00F | | | | | | | + ! | | 000 | | | | | | | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ END_DOC integer, intent(in) :: i,j,k,l integer(key_kind), intent(out) :: idx logical, intent(out) :: use_map1 double precision, intent(out) :: sign integer(key_kind) :: p,q,r,s,ik,jl,ij,kl - logical :: iltk, jltl, ikltjl, ieqk, jeql, ikeqjl, ijeqkl - ! i.le.k, j.le.l, tri(i,k).le.tri(j,l) !DIR$ FORCEINLINE call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) p = min(i,j) @@ -309,45 +325,38 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) s = max(k,l) kl = q+shiftr(s*s-s,1) - idx = 2*idx-1 if (ij==kl) then !real, map1 sign=0.d0 use_map1=.True. else - iltk = (i.lt.k) - jltl = (j.lt.l) - ieqk = (i.eq.k) - jeql = (j.eq.l) - ikltjl = (ik.lt.jl) - ikeqjl = (ik.eq.jl) - if (ikeqjl) then - if (iltk) then + if (ik.eq.jl) then + if (i.lt.k) then !TT0 sign=1.d0 - use_map1=.False. - else + use_map1=.False. + else !FF0 sign=-1.d0 use_map1=.False. endif - else if (ieqk) then - if (jltl) then + else if (i.eq.k) then + if (j.lt.l) then !0T* + sign=1.d0 + use_map1=.True. + else !0F* + sign=-1.d0 + use_map1=.True. + endif + else if (j.eq.l) then + if (i.lt.k) then sign=1.d0 use_map1=.True. else sign=-1.d0 use_map1=.True. endif - else if (jeql) then - if (iltk) then - sign=1.d0 - use_map1=.True. - else - sign=-1.d0 - use_map1=.True. - endif - else if (iltk.eqv.jltl) then - if (iltk) then + else if ((i.lt.k).eqv.(j.lt.l)) then + if (i.lt.k) then sign=1.d0 use_map1=.True. else @@ -355,7 +364,7 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) use_map1=.True. endif else - if (jltl.eqv.ikltjl) then + if ((j.lt.l).eqv.(ik.lt.jl)) then sign=1.d0 use_map1=.False. else From aac2c60971f81e277c08d132d13e12170e6be240 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 14:57:49 -0600 Subject: [PATCH 040/256] cleanup integral import --- src/utils_periodic/import_integrals_ao_periodic.irp.f | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/utils_periodic/import_integrals_ao_periodic.irp.f b/src/utils_periodic/import_integrals_ao_periodic.irp.f index 039af101..e352cabd 100644 --- a/src/utils_periodic/import_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/import_integrals_ao_periodic.irp.f @@ -1,7 +1,4 @@ -program print_integrals - print *, 'Number of AOs?' - read(*,*) ao_num - TOUCH ao_num +program import_ao_integrals_periodic call run end @@ -25,7 +22,7 @@ subroutine run double precision :: sign - call ezfio_set_ao_basis_ao_num(ao_num) +! call ezfio_set_ao_basis_ao_num(ao_num) allocate (A(ao_num,ao_num), B(ao_num,ao_num) ) From 5f37d50f236ed9c78132257db0adb7aed66a6f7d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 16:53:49 -0600 Subject: [PATCH 041/256] first complex reverse compound index function --- src/ao_two_e_ints/map_integrals.irp.f | 69 +++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 10357b78..5ad63c6a 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -159,6 +159,75 @@ subroutine two_e_integrals_index_reverse(i,j,k,l,i1) end +subroutine two_e_integrals_index_reverse_periodic_1(i,j,k,l,i1) + use map_module + implicit none + BEGIN_DOC +! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. +! For 2 indices $i,j$ and $i \le j$, we have +! $p = i(i-1)/2 + j$. +! The key point is that because $j < i$, +! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving +! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ +! and $j = p - i(i-1)/2$. +! This rule is applied 3 times. First for the symmetry of the +! pairs (i,k) and (j,l), and then for the symmetry within each pair. +! always returns first set such that i<=k, j<=l, ik<=jl + END_DOC + integer, intent(out) :: i(4),j(4),k(4),l(4) + integer(key_kind), intent(in) :: i1 + integer(key_kind) :: i2,i3 + i = 0 + i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) + l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) + i3 = i1 - shiftr(i2*i2-i2,1) + k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) + j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) + i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4) + + !ijkl a+ib + i(2) = j(1) !jilk a+ib + j(2) = i(1) + k(2) = l(1) + l(2) = k(1) + + i(3) = i(1) !ilkj a-ib + j(3) = l(1) + k(3) = k(1) + l(3) = j(1) + + i(4) = l(1) !lijk a-ib + j(4) = i(1) + k(4) = j(1) + l(4) = k(1) + + integer :: ii, jj + do ii=2,4 + do jj=1,ii-1 + if ( (i(ii) == i(jj)).and. & + (j(ii) == j(jj)).and. & + (k(ii) == k(jj)).and. & + (l(ii) == l(jj)) ) then + i(ii) = 0 + exit + endif + enddo + enddo +! This has been tested with up to 1000 AOs, and all the reverse indices are +! correct ! We can remove the test +! do ii=1,8 +! if (i(ii) /= 0) then +! call two_e_integrals_index(i(ii),j(ii),k(ii),l(ii),i2) +! if (i1 /= i2) then +! print *, i1, i2 +! print *, i(ii), j(ii), k(ii), l(ii) +! stop 'two_e_integrals_index_reverse failed' +! endif +! endif +! enddo + + +end From d7bc6088205ee678b34cbc946b79b6f6f62b5964 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 17:00:44 -0600 Subject: [PATCH 042/256] minor change to complex integral maps --- src/ao_two_e_ints/map_integrals.irp.f | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 5ad63c6a..ac32382d 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -364,18 +364,17 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) ! ! ! for , conditionals are [a | | | | | | | | + ! | NEW | | | | | | | | | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ ! | | m1 | m1* | m2 | m2* | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ ! | | TTT | TTF | FFT | FFF | FTT | TFF | TFT | FTF | ! | | 0TT | T0F | 0FT | F0F | | | | | ! | | T0T | 0TF | F0T | 0FF | | | | | - ! | | | | | | TT0 | | FF0 | | + ! | | TT0 | | FF0 | | FT0(r) | TF0(r) | | | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - ! | | FT0 | TF0 | | | | | | | ! | | 00T | 00F | | | | | | | ! | | 000 | | | | | | | | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ @@ -396,17 +395,21 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) idx = 2*idx-1 - if (ij==kl) then !real, map1 + if (ij==kl) then !real, J -> map1, K -> map2 sign=0.d0 - use_map1=.True. + if (i==k) then + use_map1=.True. + else + use_map1=.False. + endif else if (ik.eq.jl) then if (i.lt.k) then !TT0 sign=1.d0 - use_map1=.False. + use_map1=.True. else !FF0 sign=-1.d0 - use_map1=.False. + use_map1=.True. endif else if (i.eq.k) then if (j.lt.l) then !0T* From 559c17cfaa998342eb439e3e54f03d6bae4a8256 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 17:11:10 -0600 Subject: [PATCH 043/256] complex reverse compound index --- src/ao_two_e_ints/map_integrals.irp.f | 78 ++++++++++++++++++++------- 1 file changed, 60 insertions(+), 18 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index ac32382d..bf284841 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -159,7 +159,7 @@ subroutine two_e_integrals_index_reverse(i,j,k,l,i1) end -subroutine two_e_integrals_index_reverse_periodic_1(i,j,k,l,i1) +subroutine two_e_integrals_index_reverse_complex_1(i,j,k,l,i1) use map_module implicit none BEGIN_DOC @@ -191,15 +191,15 @@ subroutine two_e_integrals_index_reverse_periodic_1(i,j,k,l,i1) k(2) = l(1) l(2) = k(1) - i(3) = i(1) !ilkj a-ib + i(3) = k(1) !klij a-ib j(3) = l(1) - k(3) = k(1) + k(3) = i(1) l(3) = j(1) - i(4) = l(1) !lijk a-ib - j(4) = i(1) + i(4) = l(1) !lkji a-ib + j(4) = k(1) k(4) = j(1) - l(4) = k(1) + l(4) = i(1) integer :: ii, jj do ii=2,4 @@ -213,20 +213,62 @@ subroutine two_e_integrals_index_reverse_periodic_1(i,j,k,l,i1) endif enddo enddo -! This has been tested with up to 1000 AOs, and all the reverse indices are -! correct ! We can remove the test -! do ii=1,8 -! if (i(ii) /= 0) then -! call two_e_integrals_index(i(ii),j(ii),k(ii),l(ii),i2) -! if (i1 /= i2) then -! print *, i1, i2 -! print *, i(ii), j(ii), k(ii), l(ii) -! stop 'two_e_integrals_index_reverse failed' -! endif -! endif -! enddo +end +subroutine two_e_integrals_index_reverse_complex_2(i,j,k,l,i1) + use map_module + implicit none + BEGIN_DOC +! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. +! For 2 indices $i,j$ and $i \le j$, we have +! $p = i(i-1)/2 + j$. +! The key point is that because $j < i$, +! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving +! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ +! and $j = p - i(i-1)/2$. +! This rule is applied 3 times. First for the symmetry of the +! pairs (i,k) and (j,l), and then for the symmetry within each pair. +! always returns first set such that k<=i, j<=l, ik<=jl + END_DOC + integer, intent(out) :: i(4),j(4),k(4),l(4) + integer(key_kind), intent(in) :: i1 + integer(key_kind) :: i2,i3 + i = 0 + i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) + l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) + i3 = i1 - shiftr(i2*i2-i2,1) + i(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) + j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) + k(1) = int(i3 - shiftr(i(1)*i(1)-i(1),1),4) + !kjil a+ib + i(2) = j(1) !jkli a+ib + j(2) = i(1) + k(2) = l(1) + l(2) = k(1) + + i(3) = k(1) !ilkj a-ib + j(3) = l(1) + k(3) = i(1) + l(3) = j(1) + + i(4) = l(1) !lijk a-ib + j(4) = k(1) + k(4) = j(1) + l(4) = i(1) + + integer :: ii, jj + do ii=2,4 + do jj=1,ii-1 + if ( (i(ii) == i(jj)).and. & + (j(ii) == j(jj)).and. & + (k(ii) == k(jj)).and. & + (l(ii) == l(jj)) ) then + i(ii) = 0 + exit + endif + enddo + enddo end From af74694cabab27ed7ab936ab00da8de2ca3a5063 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 18:16:25 -0600 Subject: [PATCH 044/256] fixed typo --- src/hartree_fock/scf.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 7a24bf97..fabe9dd1 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -93,7 +93,7 @@ subroutine run mo_label = "Orthonormalized" if (is_periodic) then - call roothan_hall_scf_complex + call roothaan_hall_scf_complex else call roothaan_hall_scf endif From 0b0a7520afbc8089e6e3a4a1c93bb7f428cdec84 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 30 Jan 2020 18:16:51 -0600 Subject: [PATCH 045/256] complex hf framework done, but still has bug somewhere --- src/hartree_fock/fock_matrix_hf_complex.irp.f | 154 +++++++++++++++--- 1 file changed, 128 insertions(+), 26 deletions(-) diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_complex.irp.f index 0a432850..5a19141b 100644 --- a/src/hartree_fock/fock_matrix_hf_complex.irp.f +++ b/src/hartree_fock/fock_matrix_hf_complex.irp.f @@ -11,27 +11,31 @@ integer :: i,j,k,l,k1,r,s integer :: i0,j0,k0,l0 integer*8 :: p,q - double precision :: integral, c0, c1, c2 + double precision :: integral, c0 double precision :: ao_two_e_integral, local_threshold double precision, allocatable :: ao_two_e_integral_alpha_tmp(:,:) double precision, allocatable :: ao_two_e_integral_beta_tmp(:,:) - ao_two_e_integral_alpha = 0.d0 - ao_two_e_integral_beta = 0.d0 + ao_two_e_integral_alpha_complex = (0.d0,0.d0) + ao_two_e_integral_beta_complex = (0.d0,0.d0) PROVIDE ao_two_e_integrals_in_map integer(omp_lock_kind) :: lck(ao_num) integer(map_size_kind) :: i8 - integer :: ii(8), jj(8), kk(8), ll(8), k2 + integer :: ii(4), jj(4), kk(4), ll(4), k2 integer(cache_map_size_kind) :: n_elements_max, n_elements integer(key_kind), allocatable :: keys(:) double precision, allocatable :: values(:) + complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) + integer(key_kind) :: key1 !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & - !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp)& - !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,& - !$OMP ao_integrals_map, ao_two_e_integral_alpha, ao_two_e_integral_beta) + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex,i_sign, & + !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) allocate(keys(n_elements_max), values(n_elements_max)) @@ -45,29 +49,127 @@ n_elements = n_elements_max call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) do k1=1,n_elements - call two_e_integrals_index_reverse(kk,ii,ll,jj,keys(k1)) - - do k2=1,8 - if (kk(k2)==0) then - cycle - endif - i = ii(k2) - j = jj(k2) - k = kk(k2) - l = ll(k2) - integral = (SCF_density_matrix_ao_alpha(k,l)+SCF_density_matrix_ao_beta(k,l)) * values(k1) - ao_two_e_integral_alpha_tmp(i,j) += integral - ao_two_e_integral_beta_tmp (i,j) += integral - integral = values(k1) - ao_two_e_integral_alpha_tmp(l,j) -= SCF_density_matrix_ao_alpha(k,i) * integral - ao_two_e_integral_beta_tmp (l,j) -= SCF_density_matrix_ao_beta (k,i) * integral - enddo + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) + if (shiftl(key1,1)==keys(k1)) then !imaginary part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif enddo enddo !$OMP END DO NOWAIT !$OMP CRITICAL - ao_two_e_integral_alpha += ao_two_e_integral_alpha_tmp - ao_two_e_integral_beta += ao_two_e_integral_beta_tmp + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex,i_sign, & + !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + + call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = 0.d0 + ao_two_e_integral_beta_tmp = 0.d0 + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map_2%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) + do k1=1,n_elements + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) + if (shiftl(key1,1)==keys(k1)) then !imaginary part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp !$OMP END CRITICAL deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) !$OMP END PARALLEL From 5e83a2a853dff6b00f42b3db3df06ddd675b625e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 31 Jan 2020 12:00:23 -0600 Subject: [PATCH 046/256] fixed bug with Enuc in SCF energy --- src/scf_utils/fock_matrix.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index 0cecd7d4..9c4d54e7 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -160,7 +160,7 @@ BEGIN_PROVIDER [ double precision, SCF_energy ] integer :: i,j if (is_periodic) then complex*16 :: scf_e_tmp - scf_e_tmp = (0.d0,0.d0) + scf_e_tmp = dcmplx(SCF_energy,0.d0) do j=1,ao_num do i=1,ao_num scf_e_tmp += 0.5d0 * ( & From dd7b3131b8a56c454bc1bd0af62effd4ec6efae3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 31 Jan 2020 12:01:24 -0600 Subject: [PATCH 047/256] looking for bug in scf --- src/hartree_fock/fock_matrix_hf_complex.irp.f | 39 ++++++++++++++----- src/mo_basis/utils_periodic.irp.f | 5 +++ 2 files changed, 34 insertions(+), 10 deletions(-) diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_complex.irp.f index 5a19141b..a2d5a572 100644 --- a/src/hartree_fock/fock_matrix_hf_complex.irp.f +++ b/src/hartree_fock/fock_matrix_hf_complex.irp.f @@ -11,7 +11,7 @@ integer :: i,j,k,l,k1,r,s integer :: i0,j0,k0,l0 integer*8 :: p,q - double precision :: integral, c0 + complex*16 :: integral, c0 double precision :: ao_two_e_integral, local_threshold double precision, allocatable :: ao_two_e_integral_alpha_tmp(:,:) double precision, allocatable :: ao_two_e_integral_beta_tmp(:,:) @@ -41,18 +41,23 @@ allocate(keys(n_elements_max), values(n_elements_max)) allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & ao_two_e_integral_beta_tmp(ao_num,ao_num)) - ao_two_e_integral_alpha_tmp = 0.d0 - ao_two_e_integral_beta_tmp = 0.d0 + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) !$OMP DO SCHEDULE(static,1) do i8=0_8,ao_integrals_map%map_size n_elements = n_elements_max call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) key1 = shiftr(keys(k1)+1,1) call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) - if (shiftl(key1,1)==keys(k1)) then !imaginary part + ! i<=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + + if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) do k2=1,4 if (ii(k2)==0) then cycle @@ -61,7 +66,12 @@ j = jj(k2) k = kk(k2) l = ll(k2) - integral = i_sign(k2)*values(k1) + integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral @@ -71,7 +81,7 @@ ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral enddo - else + else ! real part do k2=1,4 if (ii(k2)==0) then cycle @@ -114,17 +124,21 @@ allocate(keys(n_elements_max), values(n_elements_max)) allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & ao_two_e_integral_beta_tmp(ao_num,ao_num)) - ao_two_e_integral_alpha_tmp = 0.d0 - ao_two_e_integral_beta_tmp = 0.d0 + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) !$OMP DO SCHEDULE(static,1) do i8=0_8,ao_integrals_map_2%map_size n_elements = n_elements_max call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) key1 = shiftr(keys(k1)+1,1) call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) + ! i>=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* if (shiftl(key1,1)==keys(k1)) then !imaginary part do k2=1,4 if (ii(k2)==0) then @@ -134,7 +148,12 @@ j = jj(k2) k = kk(k2) l = ll(k2) - integral = i_sign(k2)*values(k1) + integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral @@ -144,7 +163,7 @@ ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral enddo - else + else ! real part do k2=1,4 if (ii(k2)==0) then cycle diff --git a/src/mo_basis/utils_periodic.irp.f b/src/mo_basis/utils_periodic.irp.f index dec28945..7f79f042 100644 --- a/src/mo_basis/utils_periodic.irp.f +++ b/src/mo_basis/utils_periodic.irp.f @@ -52,6 +52,11 @@ subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output) enddo write (6,'(A)') '======== ================' write (6,'(A)') '' + write (6,'(A)') 'Fock Matrix' + write (6,'(A)') '-----------' + do i=1,n + write(*,'(200(E24.15))') A(i,:) + enddo endif call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) From 3f0f71be22c6b1c93852159586089778b853a95a Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 11:06:34 -0600 Subject: [PATCH 048/256] minor fix --- src/hartree_fock/fock_matrix_hf_complex.irp.f | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_complex.irp.f index a2d5a572..d4b3194d 100644 --- a/src/hartree_fock/fock_matrix_hf_complex.irp.f +++ b/src/hartree_fock/fock_matrix_hf_complex.irp.f @@ -12,9 +12,8 @@ integer :: i0,j0,k0,l0 integer*8 :: p,q complex*16 :: integral, c0 - double precision :: ao_two_e_integral, local_threshold - double precision, allocatable :: ao_two_e_integral_alpha_tmp(:,:) - double precision, allocatable :: ao_two_e_integral_beta_tmp(:,:) + complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:) + complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:) ao_two_e_integral_alpha_complex = (0.d0,0.d0) ao_two_e_integral_beta_complex = (0.d0,0.d0) From a6a4e8ecac5c7e810a0a8bcd0319819accb789c0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 13:55:14 -0600 Subject: [PATCH 049/256] fixed incorrect lapack copy call --- src/scf_utils/huckel_complex.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_complex.irp.f index 52fdef8f..8f448d42 100644 --- a/src/scf_utils/huckel_complex.irp.f +++ b/src/scf_utils/huckel_complex.irp.f @@ -25,9 +25,9 @@ subroutine huckel_guess_complex ! Fock_matrix_ao_alpha(1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) ! Fock_matrix_ao_beta (1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) - call zlacp2('X', ao_num, ao_num, A, size(A,1), & + call zlacpy('X', ao_num, ao_num, A, size(A,1), & Fock_matrix_ao_alpha_complex, size(Fock_matrix_ao_alpha_complex,1)) - call zlacp2('X', ao_num, ao_num, A, size(A,1), & + call zlacpy('X', ao_num, ao_num, A, size(A,1), & Fock_matrix_ao_beta_complex, size(Fock_matrix_ao_beta_complex, 1)) From 8b33c2b4b58a03ca8becf3650b9ea220e16a30a4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 13:58:08 -0600 Subject: [PATCH 050/256] more printing for debugging --- src/scf_utils/diagonalize_fock_complex.irp.f | 2 +- src/scf_utils/print_debug_scf_complex.irp.f | 44 +++++++ src/scf_utils/roothaan_hall_scf_complex.irp.f | 8 +- src/utils_periodic/dump_2e_from_map.irp.f | 118 ++++++++++++++++++ src/utils_periodic/dump_ao_1e_complex.irp.f | 41 ++++++ src/utils_periodic/dump_ao_2e_complex.irp.f | 33 +++++ 6 files changed, 241 insertions(+), 5 deletions(-) create mode 100644 src/scf_utils/print_debug_scf_complex.irp.f create mode 100644 src/utils_periodic/dump_2e_from_map.irp.f create mode 100644 src/utils_periodic/dump_ao_1e_complex.irp.f create mode 100644 src/utils_periodic/dump_ao_2e_complex.irp.f diff --git a/src/scf_utils/diagonalize_fock_complex.irp.f b/src/scf_utils/diagonalize_fock_complex.irp.f index 1150b773..645dbcf9 100644 --- a/src/scf_utils/diagonalize_fock_complex.irp.f +++ b/src/scf_utils/diagonalize_fock_complex.irp.f @@ -15,7 +15,7 @@ BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_complex, (ao_num,mo_num do j=1,mo_num do i=1,mo_num - F(i,j) = Fock_matrix_mo_complex(i,j) + F(i,j) = fock_matrix_mo_complex(i,j) enddo enddo diff --git a/src/scf_utils/print_debug_scf_complex.irp.f b/src/scf_utils/print_debug_scf_complex.irp.f new file mode 100644 index 00000000..91311c58 --- /dev/null +++ b/src/scf_utils/print_debug_scf_complex.irp.f @@ -0,0 +1,44 @@ +subroutine print_debug_scf_complex + implicit none + BEGIN_DOC +! Build the MOs using the extended Huckel model + END_DOC + integer :: i,j + + write(*,'(A)') 'mo_coef_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') mo_coef_complex(i,:) + enddo + write(*,'(A)') 'scf_density_matrix_ao_alpha_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') scf_density_matrix_ao_alpha_complex(i,:) + enddo + write(*,'(A)') 'scf_density_matrix_ao_beta_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') scf_density_matrix_ao_beta_complex(i,:) + enddo + write(*,'(A)') 'ao_two_e_integral_alpha_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_two_e_integral_alpha_complex(i,:) + enddo + write(*,'(A)') 'ao_two_e_integral_beta_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_two_e_integral_beta_complex(i,:) + enddo + write(*,'(A)') 'fock_matrix_ao_alpha_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') fock_matrix_ao_alpha_complex(i,:) + enddo + write(*,'(A)') 'fock_matrix_ao_beta_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') fock_matrix_ao_beta_complex(i,:) + enddo + +end diff --git a/src/scf_utils/roothaan_hall_scf_complex.irp.f b/src/scf_utils/roothaan_hall_scf_complex.irp.f index e52daba9..2a68a282 100644 --- a/src/scf_utils/roothaan_hall_scf_complex.irp.f +++ b/src/scf_utils/roothaan_hall_scf_complex.irp.f @@ -100,8 +100,8 @@ END_DOC max_error_DIIS = maxval(cdabs(FPS_SPF_Matrix_MO_complex)) ! SCF energy - - energy_SCF = SCF_energy +! call print_debug_scf_complex + energy_SCF = scf_energy Delta_Energy_SCF = energy_SCF - energy_SCF_previous if ( (SCF_algorithm == 'DIIS').and.(Delta_Energy_SCF > 0.d0) ) then Fock_matrix_AO_complex(1:ao_num,1:ao_num) = Fock_matrix_DIIS (1:ao_num,1:ao_num,index_dim_DIIS) @@ -121,7 +121,7 @@ END_DOC level_shift = level_shift * 3.0d0 endif TOUCH mo_coef_complex level_shift - mo_coef_complex(1:ao_num,1:mo_num) = eigenvectors_Fock_matrix_MO_complex(1:ao_num,1:mo_num) + mo_coef_complex(1:ao_num,1:mo_num) = eigenvectors_fock_matrix_mo_complex(1:ao_num,1:mo_num) if(frozen_orb_scf)then call reorder_core_orb call initialize_mo_coef_begin_iteration @@ -143,7 +143,7 @@ END_DOC ! Print results at the end of each iteration write(6,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') & - iteration_SCF, energy_SCF, Delta_energy_SCF, max_error_DIIS, level_shift, dim_DIIS + iteration_SCF, energy_scf, Delta_energy_SCF, max_error_DIIS, level_shift, dim_DIIS if (Delta_energy_SCF < 0.d0) then call save_mos diff --git a/src/utils_periodic/dump_2e_from_map.irp.f b/src/utils_periodic/dump_2e_from_map.irp.f new file mode 100644 index 00000000..e126fa06 --- /dev/null +++ b/src/utils_periodic/dump_2e_from_map.irp.f @@ -0,0 +1,118 @@ +program print_2e_integrals_from_map + call run +end + +subroutine run + use map_module + implicit none + BEGIN_DOC + ! Alpha and Beta Fock matrices in AO basis set + END_DOC + !TODO: finish implementing this: see complex qp1 (different mapping) + + integer :: i,j,k,l,k1,r,s + integer :: i0,j0,k0,l0 + integer*8 :: p,q + complex*16 :: integral, c0 + + PROVIDE ao_two_e_integrals_in_map + + integer(omp_lock_kind) :: lck(ao_num) + integer(map_size_kind) :: i8 + integer :: ii(4), jj(4), kk(4), ll(4), k2 + integer(cache_map_size_kind) :: n_elements_max, n_elements + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) + integer(key_kind) :: key1 + + call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + + do i8=0_8,ao_integrals_map%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) + ! i<=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + + if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + print'((A),4(I4),1(E15.7),2(I),2(E9.1))','imag1 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() + + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + print'((A),4(I4),1(E15.7),2(I))','real1 ',i,j,k,l,values(k1),k1,k2 + enddo + endif + enddo + enddo + deallocate(keys,values) + + + call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + + do i8=0_8,ao_integrals_map_2%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) + ! i>=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + if (shiftl(key1,1)==keys(k1)) then !imaginary part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + print'((A),4(I4),1(E15.7),2(I),2(E9.1))','imag2 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + print'((A),4(I4),1(E15.7),2(I))','real2 ',i,j,k,l,values(k1),k1,k2 + enddo + endif + enddo + enddo + deallocate(keys,values) +end diff --git a/src/utils_periodic/dump_ao_1e_complex.irp.f b/src/utils_periodic/dump_ao_1e_complex.irp.f new file mode 100644 index 00000000..f49b2529 --- /dev/null +++ b/src/utils_periodic/dump_ao_1e_complex.irp.f @@ -0,0 +1,41 @@ +program print_ao_1e_integrals + call run +end + +subroutine run + use map_module + implicit none + + integer :: i,j + + write(*,'(A)') 'ao_one_e_integrals_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_one_e_integrals_complex(i,:) + enddo + write(*,'(A)') 'ao_overlap_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_overlap_complex(i,:) + enddo + write(*,'(A)') 's_inv_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') s_inv_complex(i,:) + enddo + write(*,'(A)') 's_half_inv_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') s_half_inv_complex(i,:) + enddo + write(*,'(A)') 's_half_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') s_half_complex(i,:) + enddo + write(*,'(A)') 'ao_ortho_canonical_coef_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_ortho_canonical_coef_complex(i,:) + enddo +end diff --git a/src/utils_periodic/dump_ao_2e_complex.irp.f b/src/utils_periodic/dump_ao_2e_complex.irp.f new file mode 100644 index 00000000..3d553f01 --- /dev/null +++ b/src/utils_periodic/dump_ao_2e_complex.irp.f @@ -0,0 +1,33 @@ +program print_ao_2e_integrals + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,l + + provide ao_two_e_integrals_in_map + complex*16 :: get_ao_two_e_integral_periodic, tmp_cmplx + do i=1,ao_num + do j=1,ao_num + do k=1,ao_num + do l=1,ao_num + tmp_cmplx = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + print'(4(I4),2(E15.7))',i,j,k,l,tmp_cmplx + enddo + enddo + enddo + enddo + print*,'map1' + do i=0,ao_integrals_map%map_size + print*,i,ao_integrals_map%map(i)%value(:) + print*,i,ao_integrals_map%map(i)%key(:) + enddo + print*,'map2' + do i=0,ao_integrals_map_2%map_size + print*,i,ao_integrals_map_2%map(i)%value(:) + print*,i,ao_integrals_map_2%map(i)%key(:) + enddo +end From f4de811310eb9a3aad8bb0b95d8adaf97cfa9475 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 14:08:06 -0600 Subject: [PATCH 051/256] take transpose of density matrix for complex --- src/hartree_fock/hf_energy.irp.f | 40 ++++++++++++++++++++++++++------ src/scf_utils/fock_matrix.irp.f | 4 ++-- 2 files changed, 35 insertions(+), 9 deletions(-) diff --git a/src/hartree_fock/hf_energy.irp.f b/src/hartree_fock/hf_energy.irp.f index a0f9f897..66b9deb2 100644 --- a/src/hartree_fock/hf_energy.irp.f +++ b/src/hartree_fock/hf_energy.irp.f @@ -22,13 +22,39 @@ END_PROVIDER HF_energy = nuclear_repulsion HF_two_electron_energy = 0.d0 HF_one_electron_energy = 0.d0 - do j=1,ao_num - do i=1,ao_num - HF_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * SCF_density_matrix_ao_alpha(i,j) & - +ao_two_e_integral_beta(i,j) * SCF_density_matrix_ao_beta(i,j) ) - HF_one_electron_energy += ao_one_e_integrals(i,j) * (SCF_density_matrix_ao_alpha(i,j) + SCF_density_matrix_ao_beta (i,j) ) - enddo - enddo + if (is_periodic) then + complex*16 :: hf_1e_tmp, hf_2e_tmp + hf_1e_tmp = (0.d0,0.d0) + hf_2e_tmp = (0.d0,0.d0) + do j=1,ao_num + do i=1,ao_num + hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_complex(i,j) * SCF_density_matrix_ao_alpha_complex(j,i) & + +ao_two_e_integral_beta_complex(i,j) * SCF_density_matrix_ao_beta_complex(j,i) ) + hf_1e_tmp += ao_one_e_integrals_complex(i,j) * (SCF_density_matrix_ao_alpha_complex(j,i) & + + SCF_density_matrix_ao_beta_complex (j,i) ) + enddo + enddo + if (dabs(dimag(hf_2e_tmp)).gt.1.d-10) then + print*,'HF_2e energy should be real:',irp_here + stop -1 + else + HF_two_electron_energy = dble(hf_2e_tmp) + endif + if (dabs(dimag(hf_1e_tmp)).gt.1.d-10) then + print*,'HF_1e energy should be real:',irp_here + stop -1 + else + HF_one_electron_energy = dble(hf_1e_tmp) + endif + else + do j=1,ao_num + do i=1,ao_num + HF_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * SCF_density_matrix_ao_alpha(i,j) & + +ao_two_e_integral_beta(i,j) * SCF_density_matrix_ao_beta(i,j) ) + HF_one_electron_energy += ao_one_e_integrals(i,j) * (SCF_density_matrix_ao_alpha(i,j) + SCF_density_matrix_ao_beta (i,j) ) + enddo + enddo + endif HF_energy += HF_two_electron_energy + HF_one_electron_energy END_PROVIDER diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index 9c4d54e7..b59f921b 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -164,8 +164,8 @@ BEGIN_PROVIDER [ double precision, SCF_energy ] do j=1,ao_num do i=1,ao_num scf_e_tmp += 0.5d0 * ( & - (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_alpha_complex(i,j) ) * SCF_density_matrix_ao_alpha_complex(i,j) +& - (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) ) * SCF_density_matrix_ao_beta_complex (i,j) ) + (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_alpha_complex(i,j) ) * SCF_density_matrix_ao_alpha_complex(j,i) +& + (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) ) * SCF_density_matrix_ao_beta_complex (j,i) ) enddo enddo !TODO: add check for imaginary part? (should be zero) From 9b91e531194d15b36debbe15399bf24179a14518 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 15:10:50 -0600 Subject: [PATCH 052/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 38 ++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 6 deletions(-) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index dd8e69c2..c12ac095 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -1,10 +1,38 @@ -compare master-features_periodic -694df1d6498767c9b130dadf0e0cbd585d10d348 -8bfcfe8f21762aacd95bbeccb1c3c1d2f847cca3 + + +2e integrals printed from pyscf are in physicists' notation +mo energies from pyscf include ewald correction; in qp we just fold that into the nuclear repulsion +this may need to change for addition/removal of electrons (shift in enuc depends on number of electrons) + +mo_coef is not used in the periodic part of the code + use mo_coef_{real,imag,complex} + real and imag only used for I/O + mo_save routines handle this correctly (put real,imag parts of mo_coef_complex into two dble buffers; use ezfio_set to save real,imag parts to disk) + +AO 1e ints: + reuse old (real) provider as real part of ints + added new provider (double precision) for imag parts (mostly just for I/O?) + added new provider (complex) for real+i*imag + +MO 1e ints: + don't reuse old (real) provider for real part of ints + three linked providers (real,imag,complex) for each array of MO 1e ints + either read from disk or obtain via AO-to-MO transformation + +AO 2e ints: + see doc for map index details + see src/hartree_fock/fock_matrix_hf_complex.irp.f for example of iterating over values in map + + TODO: +symmetry + add provider for kconserv + restructure arrays? + mo coef and mo 1e ints already separate from real part of code (easy to add extra dimension) + ao 1e ints could also be handled in same way as mo 1e ints + ao_ints - reverse index ao_overlap_abs for complex ao_integrals_n_e_per_atom_complex? not implemented for periodic: @@ -14,8 +42,6 @@ ao_ints [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] compute_ao_integrals_jl -scf - finish ao_two_e_integral_{alpha,beta}_complex (need reverse index?) mo_two_e_ints not started From b39a7895f41c3c1297b041b52fca0af8d4de9a19 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 16:46:12 -0600 Subject: [PATCH 053/256] added kconserv array --- src/nuclei/EZFIO.cfg | 17 +++++++++++ src/nuclei/kconserv_complex.irp.f | 26 +++++++++++++++++ src/utils_periodic/import_kconserv.irp.f | 36 ++++++++++++++++++++++++ 3 files changed, 79 insertions(+) create mode 100644 src/nuclei/kconserv_complex.irp.f create mode 100644 src/utils_periodic/import_kconserv.irp.f diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index 34c27c46..b95385f5 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -37,3 +37,20 @@ type: logical doc: If true, the calculation uses periodic boundary conditions interface: ezfio, provider, ocaml default: false + +[io_kconserv] +doc: Read/Write kconserv array from/to disk [ Write | Read | None ] +type: Disk_access +interface: ezfio,provider,ocaml +default: None + +[kpt_num] +doc: Number of k-points +type: integer +interface: ezfio, provider + +[kconserv] +type: integer +doc: array containing information about k-point symmetry +size: (nuclei.kpt_num,nuclei.kpt_num,nuclei.kpt_num) +interface: ezfio diff --git a/src/nuclei/kconserv_complex.irp.f b/src/nuclei/kconserv_complex.irp.f new file mode 100644 index 00000000..11eb7daf --- /dev/null +++ b/src/nuclei/kconserv_complex.irp.f @@ -0,0 +1,26 @@ +BEGIN_PROVIDER [integer, kconserv, (kpt_num,kpt_num,kpt_num)] + implicit none + BEGIN_DOC + ! Information about k-point symmetry + ! + ! for k-points I,J,K: kconserv(I,J,K) gives L such that + ! k_I + k_J = k_K + k_L + ! two-electron integrals of the form + ! (where i,j,k have momentum k_I, k_J, k_K) + ! will only be nonzero if x has momentum k_L (as described above) + ! + END_DOC + integer :: i,j,k,l + + if (read_kconserv) then + call ezfio_get_nuclei_kconserv(kconserv) + print *, 'kconserv read from disk' + else + print*,'kconserv must be provided' + stop -1 + endif + if (write_kconserv) then + call ezfio_set_nuclei_kconserv(kconserv) + print *, 'kconserv written to disk' + endif +END_PROVIDER diff --git a/src/utils_periodic/import_kconserv.irp.f b/src/utils_periodic/import_kconserv.irp.f new file mode 100644 index 00000000..0dff268b --- /dev/null +++ b/src/utils_periodic/import_kconserv.irp.f @@ -0,0 +1,36 @@ +program import_kconserv + + PROVIDE ezfio_filename + call run +end + +subroutine run + use map_module + implicit none + BEGIN_DOC + ! read kconserv in physicists' notation order + ! if kconserv(i,j,k)=l, then is allowed by symmetry + ! NOTE: pyscf stores this internally in the order of chemists' notation (ik|jl) + END_DOC + + integer :: iunit + integer :: getunitandopen + + integer ::i,j,k,l + integer, allocatable :: A(:,:,:) + + allocate(A(kpt_num,kpt_num,kpt_num)) + + A = 0 + iunit = getunitandopen('kconserv','r') + do + read (iunit,*,end=10) i,j,k,l + A(i,j,k) = l + enddo + 10 continue + close(iunit) + call ezfio_set_nuclei_kconserv(A) + call ezfio_set_nuclei_io_kconserv("Read") + deallocate(A) + +end From 7287312b737ae864acd00d222740f1ed9e20824b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Feb 2020 16:58:01 -0600 Subject: [PATCH 054/256] started working on complex mo 2e ints --- src/mo_two_e_ints/map_integrals.irp.f | 102 +++++++++++++++++++++++++- 1 file changed, 99 insertions(+), 3 deletions(-) diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 83ca98cd..41534372 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/src/mo_two_e_ints/map_integrals.irp.f @@ -4,6 +4,7 @@ use map_module !! ====== BEGIN_PROVIDER [ type(map_type), mo_integrals_map ] +&BEGIN_PROVIDER [ type(map_type), mo_integrals_map_2 ] implicit none BEGIN_DOC ! MO integrals @@ -11,9 +12,17 @@ BEGIN_PROVIDER [ type(map_type), mo_integrals_map ] integer(key_kind) :: key_max integer(map_size_kind) :: sze call two_e_integrals_index(mo_num,mo_num,mo_num,mo_num,key_max) - sze = key_max - call map_init(mo_integrals_map,sze) - print*, 'MO map initialized: ', sze + if (is_periodic) then + sze = key_max*2 + call map_init(mo_integrals_map,sze) + call map_init(mo_integrals_map_2,sze) + print*, 'MO maps initialized (complex): ', 2*sze + else + sze = key_max + call map_init(mo_integrals_map,sze) + call map_init(mo_integrals_map_2,1_map_size_kind) + print*, 'MO map initialized: ', sze + endif END_PROVIDER subroutine insert_into_mo_integrals_map(n_integrals, & @@ -32,6 +41,22 @@ subroutine insert_into_mo_integrals_map(n_integrals, & call map_update(mo_integrals_map, buffer_i, buffer_values, n_integrals, thr) end +subroutine insert_into_mo_integrals_map_2(n_integrals, & + buffer_i, buffer_values, thr) + use map_module + implicit none + + BEGIN_DOC + ! Create new entry into MO map, or accumulate in an existing entry + END_DOC + + integer, intent(in) :: n_integrals + integer(key_kind), intent(inout) :: buffer_i(n_integrals) + real(integral_kind), intent(inout) :: buffer_values(n_integrals) + real(integral_kind), intent(in) :: thr + call map_update(mo_integrals_map_2, buffer_i, buffer_values, n_integrals, thr) +end + BEGIN_PROVIDER [ integer*4, mo_integrals_cache_min ] &BEGIN_PROVIDER [ integer*4, mo_integrals_cache_max ] &BEGIN_PROVIDER [ integer*8, mo_integrals_cache_min_8 ] @@ -85,6 +110,44 @@ BEGIN_PROVIDER [ double precision, mo_integrals_cache, (0_8:128_8*128_8*128_8*12 END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8*128_8) ] + implicit none + BEGIN_DOC + ! Cache of MO integrals for fast access + END_DOC + PROVIDE mo_two_e_integrals_in_map + integer*8 :: i,j,k,l + integer*4 :: i4,j4,k4,l4 + integer*8 :: ii + integer(key_kind) :: idx + complex(integral_kind) :: integral + complex*16 :: get_mo_two_e_integrals_periodic_simple + FREE ao_integrals_cache + !$OMP PARALLEL DO PRIVATE (i,j,k,l,i4,j4,k4,l4,idx,ii,integral) + do l=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + l4 = int(l,4) + do k=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + k4 = int(k,4) + do j=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + j4 = int(j,4) + do i=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + i4 = int(i,4) + !DIR$ FORCEINLINE + integral = get_mo_two_e_integrals_periodic_simple(i,j,k,l,& + mo_integrals_map,mo_integrals_map_2) + ii = l-mo_integrals_cache_min_8 + ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8) + ii = ior( shiftl(ii,7), j-mo_integrals_cache_min_8) + ii = ior( shiftl(ii,7), i-mo_integrals_cache_min_8) + mo_integrals_cache_periodic(ii) = integral + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + double precision function get_two_e_integral(i,j,k,l,map) use map_module @@ -118,6 +181,39 @@ double precision function get_two_e_integral(i,j,k,l,map) endif end +complex*16 function get_two_e_integral_periodic(i,j,k,l,map,map2) + use map_module + implicit none +! BEGIN_DOC +! ! Returns one integral in the MO basis +! ! TODO: finish this +! END_DOC +! integer, intent(in) :: i,j,k,l +! integer(key_kind) :: idx +! integer :: ii +! integer*8 :: ii_8 +! type(map_type), intent(inout) :: map +! real(integral_kind) :: tmp +! PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic +! ii = l-mo_integrals_cache_min +! ii = ior(ii, k-mo_integrals_cache_min) +! ii = ior(ii, j-mo_integrals_cache_min) +! ii = ior(ii, i-mo_integrals_cache_min) +! if (iand(ii, -128) /= 0) then +! !DIR$ FORCEINLINE +! call two_e_integrals_index(i,j,k,l,idx) +! !DIR$ FORCEINLINE +! call map_get(map,idx,tmp) +! get_two_e_integral_periodic = dble(tmp) +! else +! ii_8 = int(l,8)-mo_integrals_cache_min_8 +! ii_8 = ior( shiftl(ii_8,7), int(k,8)-mo_integrals_cache_min_8) +! ii_8 = ior( shiftl(ii_8,7), int(j,8)-mo_integrals_cache_min_8) +! ii_8 = ior( shiftl(ii_8,7), int(i,8)-mo_integrals_cache_min_8) +! get_two_e_integral = mo_integrals_cache(ii_8) +! endif +end + double precision function mo_two_e_integral(i,j,k,l) implicit none From 0914a60d63d1872aa969e95b7bb274d38c787e40 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 4 Feb 2020 13:35:09 -0600 Subject: [PATCH 055/256] working on MO 2e ints added functions to get MO 2e ints still need routines to get multiple ints reused some functions from AO 2e ints --- src/ao_two_e_ints/map_integrals.irp.f | 8 +- src/mo_two_e_ints/map_integrals.irp.f | 93 +--- src/mo_two_e_ints/map_integrals_complex.irp.f | 498 ++++++++++++++++++ 3 files changed, 507 insertions(+), 92 deletions(-) create mode 100644 src/mo_two_e_ints/map_integrals_complex.irp.f diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index bf284841..57abe5e2 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -518,8 +518,12 @@ complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) resu endif else call map_get(map2,idx,tmp_re) - call map_get(map2,idx+1,tmp_im) - tmp_im *= sign + if (sign/=0.d0) then + call map_get(map2,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif endif tmp = dcmplx(tmp_re,tmp_im) result = tmp diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 41534372..9374ea80 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/src/mo_two_e_ints/map_integrals.irp.f @@ -41,22 +41,6 @@ subroutine insert_into_mo_integrals_map(n_integrals, & call map_update(mo_integrals_map, buffer_i, buffer_values, n_integrals, thr) end -subroutine insert_into_mo_integrals_map_2(n_integrals, & - buffer_i, buffer_values, thr) - use map_module - implicit none - - BEGIN_DOC - ! Create new entry into MO map, or accumulate in an existing entry - END_DOC - - integer, intent(in) :: n_integrals - integer(key_kind), intent(inout) :: buffer_i(n_integrals) - real(integral_kind), intent(inout) :: buffer_values(n_integrals) - real(integral_kind), intent(in) :: thr - call map_update(mo_integrals_map_2, buffer_i, buffer_values, n_integrals, thr) -end - BEGIN_PROVIDER [ integer*4, mo_integrals_cache_min ] &BEGIN_PROVIDER [ integer*4, mo_integrals_cache_max ] &BEGIN_PROVIDER [ integer*8, mo_integrals_cache_min_8 ] @@ -110,45 +94,6 @@ BEGIN_PROVIDER [ double precision, mo_integrals_cache, (0_8:128_8*128_8*128_8*12 END_PROVIDER -BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8*128_8) ] - implicit none - BEGIN_DOC - ! Cache of MO integrals for fast access - END_DOC - PROVIDE mo_two_e_integrals_in_map - integer*8 :: i,j,k,l - integer*4 :: i4,j4,k4,l4 - integer*8 :: ii - integer(key_kind) :: idx - complex(integral_kind) :: integral - complex*16 :: get_mo_two_e_integrals_periodic_simple - FREE ao_integrals_cache - !$OMP PARALLEL DO PRIVATE (i,j,k,l,i4,j4,k4,l4,idx,ii,integral) - do l=mo_integrals_cache_min_8,mo_integrals_cache_max_8 - l4 = int(l,4) - do k=mo_integrals_cache_min_8,mo_integrals_cache_max_8 - k4 = int(k,4) - do j=mo_integrals_cache_min_8,mo_integrals_cache_max_8 - j4 = int(j,4) - do i=mo_integrals_cache_min_8,mo_integrals_cache_max_8 - i4 = int(i,4) - !DIR$ FORCEINLINE - integral = get_mo_two_e_integrals_periodic_simple(i,j,k,l,& - mo_integrals_map,mo_integrals_map_2) - ii = l-mo_integrals_cache_min_8 - ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8) - ii = ior( shiftl(ii,7), j-mo_integrals_cache_min_8) - ii = ior( shiftl(ii,7), i-mo_integrals_cache_min_8) - mo_integrals_cache_periodic(ii) = integral - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - -END_PROVIDER - - double precision function get_two_e_integral(i,j,k,l,map) use map_module implicit none @@ -181,40 +126,6 @@ double precision function get_two_e_integral(i,j,k,l,map) endif end -complex*16 function get_two_e_integral_periodic(i,j,k,l,map,map2) - use map_module - implicit none -! BEGIN_DOC -! ! Returns one integral in the MO basis -! ! TODO: finish this -! END_DOC -! integer, intent(in) :: i,j,k,l -! integer(key_kind) :: idx -! integer :: ii -! integer*8 :: ii_8 -! type(map_type), intent(inout) :: map -! real(integral_kind) :: tmp -! PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic -! ii = l-mo_integrals_cache_min -! ii = ior(ii, k-mo_integrals_cache_min) -! ii = ior(ii, j-mo_integrals_cache_min) -! ii = ior(ii, i-mo_integrals_cache_min) -! if (iand(ii, -128) /= 0) then -! !DIR$ FORCEINLINE -! call two_e_integrals_index(i,j,k,l,idx) -! !DIR$ FORCEINLINE -! call map_get(map,idx,tmp) -! get_two_e_integral_periodic = dble(tmp) -! else -! ii_8 = int(l,8)-mo_integrals_cache_min_8 -! ii_8 = ior( shiftl(ii_8,7), int(k,8)-mo_integrals_cache_min_8) -! ii_8 = ior( shiftl(ii_8,7), int(j,8)-mo_integrals_cache_min_8) -! ii_8 = ior( shiftl(ii_8,7), int(i,8)-mo_integrals_cache_min_8) -! get_two_e_integral = mo_integrals_cache(ii_8) -! endif -end - - double precision function mo_two_e_integral(i,j,k,l) implicit none BEGIN_DOC @@ -462,13 +373,15 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map) endif end - integer*8 function get_mo_map_size() implicit none BEGIN_DOC ! Return the number of elements in the MO map END_DOC get_mo_map_size = mo_integrals_map % n_elements + if (is_periodic) then + get_mo_map_size += mo_integrals_map_2 % n_elements + endif end diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_complex.irp.f new file mode 100644 index 00000000..7cf4ba0d --- /dev/null +++ b/src/mo_two_e_ints/map_integrals_complex.irp.f @@ -0,0 +1,498 @@ +use map_module + +subroutine insert_into_mo_integrals_map_2(n_integrals, & + buffer_i, buffer_values, thr) + use map_module + implicit none + + BEGIN_DOC + ! Create new entry into MO map, or accumulate in an existing entry + END_DOC + + integer, intent(in) :: n_integrals + integer(key_kind), intent(inout) :: buffer_i(n_integrals) + real(integral_kind), intent(inout) :: buffer_values(n_integrals) + real(integral_kind), intent(in) :: thr + call map_update(mo_integrals_map_2, buffer_i, buffer_values, n_integrals, thr) +end + +BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8*128_8) ] + implicit none + BEGIN_DOC + ! Cache of MO integrals for fast access + END_DOC + PROVIDE mo_two_e_integrals_in_map + integer*8 :: i,j,k,l + integer*4 :: i4,j4,k4,l4 + integer*8 :: ii + integer(key_kind) :: idx + complex(integral_kind) :: integral + complex*16 :: get_two_e_integral_periodic_simple + FREE ao_integrals_cache + !$OMP PARALLEL DO PRIVATE (i,j,k,l,i4,j4,k4,l4,idx,ii,integral) + do l=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + l4 = int(l,4) + do k=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + k4 = int(k,4) + do j=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + j4 = int(j,4) + do i=mo_integrals_cache_min_8,mo_integrals_cache_max_8 + i4 = int(i,4) + !DIR$ FORCEINLINE + integral = get_two_e_integral_periodic_simple(i,j,k,l,& + mo_integrals_map,mo_integrals_map_2) + ii = l-mo_integrals_cache_min_8 + ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8) + ii = ior( shiftl(ii,7), j-mo_integrals_cache_min_8) + ii = ior( shiftl(ii,7), i-mo_integrals_cache_min_8) + mo_integrals_cache_periodic(ii) = integral + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + + +complex*16 function get_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) + use map_module + implicit none + BEGIN_DOC + ! Gets one MO bi-electronic integral from the MO map + ! reuse ao map/idx/sign function + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind) :: idx + real(integral_kind) :: tmp_re, tmp_im + type(map_type), intent(inout) :: map,map2 + complex(integral_kind) :: tmp + logical :: use_map1 + double precision :: sign + PROVIDE mo_two_e_integrals_in_map + call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + if (use_map1) then + call map_get(map,idx,tmp_re) + if (sign/=0.d0) then + call map_get(map,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif + else + call map_get(map2,idx,tmp_re) + if (sign/=0.d0) then + call map_get(map2,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif + endif + tmp = dcmplx(tmp_re,tmp_im) + result = tmp +end + +complex*16 function get_two_e_integral_periodic(i,j,k,l,map,map2) + use map_module + implicit none + BEGIN_DOC + ! Returns one integral in the MO basis + ! TODO: finish this + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind) :: idx + integer :: ii + integer*8 :: ii_8 + type(map_type), intent(inout) :: map,map2 + complex(integral_kind) :: tmp + complex(integral_kind) :: get_two_e_integral_periodic_simple + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + ii = l-mo_integrals_cache_min + ii = ior(ii, k-mo_integrals_cache_min) + ii = ior(ii, j-mo_integrals_cache_min) + ii = ior(ii, i-mo_integrals_cache_min) + if (iand(ii, -128) /= 0) then + tmp = get_two_e_integral_periodic_simple(i,j,k,l,map,map2) + else + ii_8 = int(l,8)-mo_integrals_cache_min_8 + ii_8 = ior( shiftl(ii_8,7), int(k,8)-mo_integrals_cache_min_8) + ii_8 = ior( shiftl(ii_8,7), int(j,8)-mo_integrals_cache_min_8) + ii_8 = ior( shiftl(ii_8,7), int(i,8)-mo_integrals_cache_min_8) + tmp = mo_integrals_cache_periodic(ii_8) + endif + get_two_e_integral_periodic = tmp +end + +complex*16 function mo_two_e_integral_periodic(i,j,k,l) + implicit none + BEGIN_DOC + ! Returns one integral in the MO basis + END_DOC + integer, intent(in) :: i,j,k,l + complex*16 :: get_two_e_integral_periodic + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + PROVIDE mo_two_e_integrals_in_map + !DIR$ FORCEINLINE + mo_two_e_integral_periodic = get_two_e_integral_periodic(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + return +end + +subroutine get_mo_two_e_integrals_periodic(j,k,l,sze,out_val,map,map2) + use map_module + implicit none + BEGIN_DOC + ! Returns multiple integrals in the MO basis, all + ! i for j,k,l fixed. + END_DOC + integer, intent(in) :: j,k,l, sze + complex*16, intent(out) :: out_val(sze) + type(map_type), intent(inout) :: map,map2 + integer :: i + complex*16, external :: get_two_e_integral_periodic_simple + + integer :: ii, ii0 + integer*8 :: ii_8, ii0_8 + complex(integral_kind) :: tmp + integer(key_kind) :: i1, idx + integer(key_kind) :: p,q,r,s,i2 + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + +!DEBUG +! do i=1,sze +! out_val(i) = get_two_e_integral_periodic(i,j,k,l,map,map2) +! enddo +! return +!DEBUG + + ii0 = l-mo_integrals_cache_min + ii0 = ior(ii0, k-mo_integrals_cache_min) + ii0 = ior(ii0, j-mo_integrals_cache_min) + + ii0_8 = int(l,8)-mo_integrals_cache_min_8 + ii0_8 = ior( shiftl(ii0_8,7), int(k,8)-mo_integrals_cache_min_8) + ii0_8 = ior( shiftl(ii0_8,7), int(j,8)-mo_integrals_cache_min_8) + + do i=1,sze + ii = ior(ii0, i-mo_integrals_cache_min) + if (iand(ii, -128) == 0) then + ii_8 = ior( shiftl(ii0_8,7), int(i,8)-mo_integrals_cache_min_8) + out_val(i) = mo_integrals_cache_periodic(ii_8) + else + out_val(i) = get_two_e_integral_periodic_simple(i,j,k,l,map,map2) + endif + enddo +end + +!subroutine get_mo_two_e_integrals_ij_periodic(k,l,sze,out_array,map) +! use map_module +! implicit none +! BEGIN_DOC +! ! Returns multiple integrals in the MO basis, all +! ! i(1)j(2) 1/r12 k(1)l(2) +! ! i, j for k,l fixed. +! END_DOC +! integer, intent(in) :: k,l, sze +! double precision, intent(out) :: out_array(sze,sze) +! type(map_type), intent(inout) :: map +! integer :: i,j,kk,ll,m +! integer(key_kind),allocatable :: hash(:) +! integer ,allocatable :: pairs(:,:), iorder(:) +! real(integral_kind), allocatable :: tmp_val(:) +! +! PROVIDE mo_two_e_integrals_in_map +! allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze), & +! tmp_val(sze*sze)) +! +! kk=0 +! out_array = 0.d0 +! do j=1,sze +! do i=1,sze +! kk += 1 +! !DIR$ FORCEINLINE +! call two_e_integrals_index(i,j,k,l,hash(kk)) +! pairs(1,kk) = i +! pairs(2,kk) = j +! iorder(kk) = kk +! enddo +! enddo +! +! logical :: integral_is_in_map +! if (key_kind == 8) then +! call i8radix_sort(hash,iorder,kk,-1) +! else if (key_kind == 4) then +! call iradix_sort(hash,iorder,kk,-1) +! else if (key_kind == 2) then +! call i2radix_sort(hash,iorder,kk,-1) +! endif +! +! call map_get_many(mo_integrals_map, hash, tmp_val, kk) +! +! do ll=1,kk +! m = iorder(ll) +! i=pairs(1,m) +! j=pairs(2,m) +! out_array(i,j) = tmp_val(ll) +! enddo +! +! deallocate(pairs,hash,iorder,tmp_val) +!end + +!subroutine get_mo_two_e_integrals_i1j1_periodic(k,l,sze,out_array,map) +! use map_module +! implicit none +! BEGIN_DOC +! ! Returns multiple integrals in the MO basis, all +! ! i(1)j(1) 1/r12 k(2)l(2) +! ! i, j for k,l fixed. +! END_DOC +! integer, intent(in) :: k,l, sze +! double precision, intent(out) :: out_array(sze,sze) +! type(map_type), intent(inout) :: map +! integer :: i,j,kk,ll,m +! integer(key_kind),allocatable :: hash(:) +! integer ,allocatable :: pairs(:,:), iorder(:) +! real(integral_kind), allocatable :: tmp_val(:) +! +! PROVIDE mo_two_e_integrals_in_map +! allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze), & +! tmp_val(sze*sze)) +! +! kk=0 +! out_array = 0.d0 +! do j=1,sze +! do i=1,sze +! kk += 1 +! !DIR$ FORCEINLINE +! call two_e_integrals_index(i,k,j,l,hash(kk)) +! pairs(1,kk) = i +! pairs(2,kk) = j +! iorder(kk) = kk +! enddo +! enddo +! +! logical :: integral_is_in_map +! if (key_kind == 8) then +! call i8radix_sort(hash,iorder,kk,-1) +! else if (key_kind == 4) then +! call iradix_sort(hash,iorder,kk,-1) +! else if (key_kind == 2) then +! call i2radix_sort(hash,iorder,kk,-1) +! endif +! +! call map_get_many(mo_integrals_map, hash, tmp_val, kk) +! +! do ll=1,kk +! m = iorder(ll) +! i=pairs(1,m) +! j=pairs(2,m) +! out_array(i,j) = tmp_val(ll) +! enddo +! +! deallocate(pairs,hash,iorder,tmp_val) +!end + +subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map) + use map_module + implicit none + BEGIN_DOC + ! Returns multiple integrals + ! k(1)i(2) 1/r12 l(1)i(2) :: out_val(i1) + ! for k,l fixed. + ! always in map1, take conjugate if k>l, real if k==l + ! TODO: determine best way to structure code + ! to account for single/double integral_kind, real/complex, and +/- imag part + END_DOC + integer, intent(in) :: k,l, sze + complex*16, intent(out) :: out_val(sze) + type(map_type), intent(inout) :: map + integer :: i + integer(key_kind) :: hash(sze),hash_re(sze),hash_im(sze) + real(integral_kind) :: tmp_re(sze),tmp_im(sze) + complex*16 :: out_re(sze),out_im(sze) + double precision :: sign + PROVIDE mo_two_e_integrals_in_map + + if (k.eq.l) then ! real, call other function + call get_mo_two_e_integrals_coulomb_ijij_periodic(k,sze,out_re,map) + do i=1,sze + out_val(i) = dcmplx(out_re(i),0.d0) + enddo + else ! complex + if (k.gt.l) then + sign = -1.d0 + else + sign = 1.d0 + endif + + do i=1,sze + !DIR$ FORCEINLINE + call two_e_integrals_index(k,i,l,i,hash(i)) + !hash_im(i) = hash(i)*2 + hash_im(i) = shiftl(hash(i),1) + hash_re(i) = hash_im(i)-1 + enddo + + if (integral_kind == 8) then + call map_get_many(map, hash_re, out_re, sze) + call map_get_many(map, hash_im, out_im, sze) + do i=1,sze + out_val(i) = dcmplx(out_re(i),sign*out_im(i)) + enddo + else + call map_get_many(map, hash_re, tmp_re, sze) + call map_get_many(map, hash_im, tmp_im, sze) + ! Conversion to double complex + do i=1,sze + out_val(i) = dcmplx(tmp_re(i),sign*tmp_im(i)) + enddo + endif + endif +end + +subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map) + use map_module + implicit none + BEGIN_DOC + ! Returns multiple integrals + ! i*(1)j*(2) 1/r12 i(1)j(2) :: out_val(i) + ! for j fixed. + ! always in map1, always real + END_DOC + integer, intent(in) :: j, sze + double precision, intent(out) :: out_val(sze) + type(map_type), intent(inout) :: map + integer :: i + integer(key_kind) :: hash(sze),hash_re(sze) + real(integral_kind) :: tmp_re(sze) + PROVIDE mo_two_e_integrals_in_map + + do i=1,sze + !DIR$ FORCEINLINE + call two_e_integrals_index(i,j,i,j,hash(i)) + !hash_re(i) = hash(i)*2 - 1 + hash_re(i) = shiftl(hash(i),1) - 1 + enddo + + if (integral_kind == 8) then + call map_get_many(map, hash_re, out_val, sze) + else + call map_get_many(map, hash_re, tmp_re, sze) + ! Conversion to double complex + do i=1,sze + out_val(i) = dble(tmp_re(i)) + enddo + endif +end + +subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) + use map_module + implicit none + BEGIN_DOC + ! Returns multiple integrals + ! k*(1)i*(2) 1/r12 i(1)l(2) :: out_val(i1) + ! for k,l fixed. + ! + ! if k + ! i*(1)j*(2) 1/r12 j(1)i(2) :: out_val(i) + ! for j fixed. + ! always real, always in map2 (except when j==i, then in map1) + END_DOC + integer, intent(in) :: j, sze + double precision, intent(out) :: out_val(sze) + type(map_type), intent(inout) :: map,map2 + integer :: i + integer(key_kind) :: hash(sze),hash_re(sze) + real(integral_kind) :: tmp_val(sze) + PROVIDE mo_two_e_integrals_in_map + + do i=1,sze + !DIR$ FORCEINLINE + call two_e_integrals_index(i,j,j,i,hash(i)) + !hash_re(i) = 2*hash(i) - 1 + hash_re(i) = shiftl(hash(i),1) - 1 + enddo + + if (integral_kind == 8) then + call map_get_many(map2, hash_re, out_val, sze) + call map_get(map,hash_re(j), out_val(j)) + else + call map_get_many(map2, hash_re, tmp_val, sze) + call map_get(map, hash_re(j), tmp_val(j)) + ! Conversion to double precision + do i=1,sze + out_val(i) = dble(tmp_val(i)) + enddo + endif +end + From b3445bfa3f32286a8f7423209e2f27ebd0fce92e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 4 Feb 2020 13:39:49 -0600 Subject: [PATCH 056/256] notes --- src/utils_periodic/qp2-pbc-diff.txt | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index c12ac095..72c72e78 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -23,6 +23,13 @@ AO 2e ints: see doc for map index details see src/hartree_fock/fock_matrix_hf_complex.irp.f for example of iterating over values in map +MO 2e ints: + similar to AO 2e ints + maybe good idea to make map_get for two neighboring vals? (re/im parts) + +mapping: + should change so that all of the real ints are in map2 + (will make some things simpler when retrieving exchange ints (currently, all of these are in map2 except when i==j)) TODO: @@ -44,7 +51,7 @@ ao_ints mo_two_e_ints - not started + incomplete From 9ee697e567daec09c649ee9bd2888b57c1fca769 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 4 Feb 2020 14:29:14 -0600 Subject: [PATCH 057/256] separate file for complex ao 2e ints --- src/ao_two_e_ints/map_integrals.irp.f | 397 ------------- src/ao_two_e_ints/map_integrals_complex.irp.f | 546 ++++++++++++++++++ 2 files changed, 546 insertions(+), 397 deletions(-) create mode 100644 src/ao_two_e_ints/map_integrals_complex.irp.f diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 57abe5e2..5fd3264b 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -46,30 +46,6 @@ subroutine two_e_integrals_index(i,j,k,l,i1) i1 = i1+shiftr(i2*i2-i2,1) end -subroutine two_e_integrals_index_periodic(i,j,k,l,i1,p,q) - use map_module - implicit none - BEGIN_DOC -! Gives a unique index for i,j,k,l using permtuation symmetry. -! i <-> k, j <-> l, and (i,k) <-> (j,l) - END_DOC - integer, intent(in) :: i,j,k,l - integer(key_kind), intent(out) :: i1 - integer(key_kind) :: r,s,i2 - integer(key_kind),intent(out) :: p,q - p = min(i,k) - r = max(i,k) - p = p+shiftr(r*r-r,1) - q = min(j,l) - s = max(j,l) - q = q+shiftr(s*s-s,1) - i1 = min(p,q) - i2 = max(p,q) - i1 = i1+shiftr(i2*i2-i2,1) -end - - - subroutine two_e_integrals_index_reverse(i,j,k,l,i1) use map_module implicit none @@ -159,120 +135,6 @@ subroutine two_e_integrals_index_reverse(i,j,k,l,i1) end -subroutine two_e_integrals_index_reverse_complex_1(i,j,k,l,i1) - use map_module - implicit none - BEGIN_DOC -! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. -! For 2 indices $i,j$ and $i \le j$, we have -! $p = i(i-1)/2 + j$. -! The key point is that because $j < i$, -! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving -! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ -! and $j = p - i(i-1)/2$. -! This rule is applied 3 times. First for the symmetry of the -! pairs (i,k) and (j,l), and then for the symmetry within each pair. -! always returns first set such that i<=k, j<=l, ik<=jl - END_DOC - integer, intent(out) :: i(4),j(4),k(4),l(4) - integer(key_kind), intent(in) :: i1 - integer(key_kind) :: i2,i3 - i = 0 - i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) - l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) - i3 = i1 - shiftr(i2*i2-i2,1) - k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) - j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) - i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4) - - !ijkl a+ib - i(2) = j(1) !jilk a+ib - j(2) = i(1) - k(2) = l(1) - l(2) = k(1) - - i(3) = k(1) !klij a-ib - j(3) = l(1) - k(3) = i(1) - l(3) = j(1) - - i(4) = l(1) !lkji a-ib - j(4) = k(1) - k(4) = j(1) - l(4) = i(1) - - integer :: ii, jj - do ii=2,4 - do jj=1,ii-1 - if ( (i(ii) == i(jj)).and. & - (j(ii) == j(jj)).and. & - (k(ii) == k(jj)).and. & - (l(ii) == l(jj)) ) then - i(ii) = 0 - exit - endif - enddo - enddo -end - -subroutine two_e_integrals_index_reverse_complex_2(i,j,k,l,i1) - use map_module - implicit none - BEGIN_DOC -! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. -! For 2 indices $i,j$ and $i \le j$, we have -! $p = i(i-1)/2 + j$. -! The key point is that because $j < i$, -! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving -! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ -! and $j = p - i(i-1)/2$. -! This rule is applied 3 times. First for the symmetry of the -! pairs (i,k) and (j,l), and then for the symmetry within each pair. -! always returns first set such that k<=i, j<=l, ik<=jl - END_DOC - integer, intent(out) :: i(4),j(4),k(4),l(4) - integer(key_kind), intent(in) :: i1 - integer(key_kind) :: i2,i3 - i = 0 - i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) - l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) - i3 = i1 - shiftr(i2*i2-i2,1) - i(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) - j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) - k(1) = int(i3 - shiftr(i(1)*i(1)-i(1),1),4) - - !kjil a+ib - i(2) = j(1) !jkli a+ib - j(2) = i(1) - k(2) = l(1) - l(2) = k(1) - - i(3) = k(1) !ilkj a-ib - j(3) = l(1) - k(3) = i(1) - l(3) = j(1) - - i(4) = l(1) !lijk a-ib - j(4) = k(1) - k(4) = j(1) - l(4) = i(1) - - integer :: ii, jj - do ii=2,4 - do jj=1,ii-1 - if ( (i(ii) == i(jj)).and. & - (j(ii) == j(jj)).and. & - (k(ii) == k(jj)).and. & - (l(ii) == l(jj)) ) then - i(ii) = 0 - exit - endif - enddo - enddo -end - - - BEGIN_PROVIDER [ integer, ao_integrals_cache_min ] &BEGIN_PROVIDER [ integer, ao_integrals_cache_max ] implicit none @@ -356,223 +218,6 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result) result = tmp end -BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] - implicit none - BEGIN_DOC - ! Cache of AO integrals for fast access - END_DOC - PROVIDE ao_two_e_integrals_in_map - integer :: i,j,k,l,ii - integer(key_kind) :: idx1, idx2 - real(integral_kind) :: tmp_re, tmp_im - integer(key_kind) :: idx_re,idx_im - complex(integral_kind) :: integral - integer(key_kind) :: p,q,r,s,ik,jl - logical :: ilek, jlel, iklejl - complex*16 :: get_ao_two_e_integral_periodic_simple - - - !$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, & - !$OMP i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) - do l=ao_integrals_cache_min,ao_integrals_cache_max - do k=ao_integrals_cache_min,ao_integrals_cache_max - do j=ao_integrals_cache_min,ao_integrals_cache_max - do i=ao_integrals_cache_min,ao_integrals_cache_max - !DIR$ FORCEINLINE - integral = get_ao_two_e_integral_periodic_simple(i,j,k,l,& - ao_integrals_map,ao_integrals_map_2) - - ii = l-ao_integrals_cache_min - ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - ao_integrals_cache_periodic(ii) = integral - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - -END_PROVIDER - -subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) - use map_module - implicit none - BEGIN_DOC - ! get position of periodic AO integral - ! use_map1: true if integral is in first ao map, false if integral is in second ao map - ! idx: position of real part of integral in map (imag part is at idx+1) - ! sign: sign of imaginary part - ! - ! - ! for , conditionals are [a | | | | | | | | - ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - ! | | m1 | m1* | m2 | m2* | - ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - ! | | TTT | TTF | FFT | FFF | FTT | TFF | TFT | FTF | - ! | | 0TT | T0F | 0FT | F0F | | | | | - ! | | T0T | 0TF | F0T | 0FF | | | | | - ! | | TT0 | | FF0 | | FT0(r) | TF0(r) | | | - ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - ! | | 00T | 00F | | | | | | | - ! | | 000 | | | | | | | | - ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - END_DOC - integer, intent(in) :: i,j,k,l - integer(key_kind), intent(out) :: idx - logical, intent(out) :: use_map1 - double precision, intent(out) :: sign - integer(key_kind) :: p,q,r,s,ik,jl,ij,kl - !DIR$ FORCEINLINE - call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) - p = min(i,j) - r = max(i,j) - ij = p+shiftr(r*r-r,1) - q = min(k,l) - s = max(k,l) - kl = q+shiftr(s*s-s,1) - - idx = 2*idx-1 - - if (ij==kl) then !real, J -> map1, K -> map2 - sign=0.d0 - if (i==k) then - use_map1=.True. - else - use_map1=.False. - endif - else - if (ik.eq.jl) then - if (i.lt.k) then !TT0 - sign=1.d0 - use_map1=.True. - else !FF0 - sign=-1.d0 - use_map1=.True. - endif - else if (i.eq.k) then - if (j.lt.l) then !0T* - sign=1.d0 - use_map1=.True. - else !0F* - sign=-1.d0 - use_map1=.True. - endif - else if (j.eq.l) then - if (i.lt.k) then - sign=1.d0 - use_map1=.True. - else - sign=-1.d0 - use_map1=.True. - endif - else if ((i.lt.k).eqv.(j.lt.l)) then - if (i.lt.k) then - sign=1.d0 - use_map1=.True. - else - sign=-1.d0 - use_map1=.True. - endif - else - if ((j.lt.l).eqv.(ik.lt.jl)) then - sign=1.d0 - use_map1=.False. - else - sign=-1.d0 - use_map1=.False. - endif - endif - endif -end - -complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) - use map_module - implicit none - BEGIN_DOC - ! Gets one AO bi-electronic integral from the AO map - END_DOC - integer, intent(in) :: i,j,k,l - integer(key_kind) :: idx1,idx2,idx - real(integral_kind) :: tmp_re, tmp_im - integer(key_kind) :: idx_re,idx_im - type(map_type), intent(inout) :: map,map2 - integer :: ii - complex(integral_kind) :: tmp - integer(key_kind) :: p,q,r,s,ik,jl - logical :: ilek, jlel, iklejl,use_map1 - double precision :: sign - ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) - PROVIDE ao_two_e_integrals_in_map - call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) - if (use_map1) then - call map_get(map,idx,tmp_re) - if (sign/=0.d0) then - call map_get(map,idx+1,tmp_im) - tmp_im *= sign - else - tmp_im=0.d0 - endif - else - call map_get(map2,idx,tmp_re) - if (sign/=0.d0) then - call map_get(map2,idx+1,tmp_im) - tmp_im *= sign - else - tmp_im=0.d0 - endif - endif - tmp = dcmplx(tmp_re,tmp_im) - result = tmp -end - - -complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(result) - use map_module - implicit none - BEGIN_DOC - ! Gets one AO bi-electronic integral from the AO map - END_DOC - integer, intent(in) :: i,j,k,l - integer(key_kind) :: idx1,idx2 - real(integral_kind) :: tmp_re, tmp_im - integer(key_kind) :: idx_re,idx_im - type(map_type), intent(inout) :: map,map2 - integer :: ii - complex(integral_kind) :: tmp - complex(integral_kind) :: get_ao_two_e_integral_periodic_simple - integer(key_kind) :: p,q,r,s,ik,jl - logical :: ilek, jlel, iklejl - ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) - PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min - !DIR$ FORCEINLINE -! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then -! tmp = (0.d0,0.d0) -! else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then -! tmp = (0.d0,0.d0) -! else - if (.True.) then - ii = l-ao_integrals_cache_min - ii = ior(ii, k-ao_integrals_cache_min) - ii = ior(ii, j-ao_integrals_cache_min) - ii = ior(ii, i-ao_integrals_cache_min) - if (iand(ii, -64) /= 0) then - tmp = get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) - else - ii = l-ao_integrals_cache_min - ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - tmp = ao_integrals_cache_periodic(ii) - endif - result = tmp - endif -end - - subroutine get_ao_two_e_integrals(j,k,l,sze,out_val) use map_module BEGIN_DOC @@ -603,34 +248,6 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val) end -subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) - use map_module - BEGIN_DOC - ! Gets multiple AO bi-electronic integral from the AO map . - ! All i are retrieved for j,k,l fixed. - ! physicist convention : - END_DOC - implicit none - integer, intent(in) :: j,k,l, sze - complex*16, intent(out) :: out_val(sze) - - integer :: i - integer(key_kind) :: hash - double precision :: thresh - PROVIDE ao_two_e_integrals_in_map ao_integrals_map - thresh = ao_integrals_threshold - - if (ao_overlap_abs(j,l) < thresh) then - out_val = (0.d0,0.d0) - return - endif - - complex*16 :: get_ao_two_e_integral_periodic - do i=1,sze - out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) - enddo - -end subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int) use map_module @@ -816,18 +433,4 @@ subroutine insert_into_ao_integrals_map(n_integrals,buffer_i, buffer_values) call map_append(ao_integrals_map, buffer_i, buffer_values, n_integrals) end -subroutine insert_into_ao_integrals_map_2(n_integrals,buffer_i, buffer_values) - use map_module - implicit none - BEGIN_DOC - ! Create new entry into AO map - END_DOC - - integer, intent(in) :: n_integrals - integer(key_kind), intent(inout) :: buffer_i(n_integrals) - real(integral_kind), intent(inout) :: buffer_values(n_integrals) - - call map_append(ao_integrals_map_2, buffer_i, buffer_values, n_integrals) -end - diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f new file mode 100644 index 00000000..9b6e1ad9 --- /dev/null +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -0,0 +1,546 @@ +use map_module + + +subroutine two_e_integrals_index_periodic(i,j,k,l,i1,p,q) + use map_module + implicit none + BEGIN_DOC +! Gives a unique index for i,j,k,l using permtuation symmetry. +! i <-> k, j <-> l, and (i,k) <-> (j,l) + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind), intent(out) :: i1 + integer(key_kind) :: r,s,i2 + integer(key_kind),intent(out) :: p,q + p = min(i,k) + r = max(i,k) + p = p+shiftr(r*r-r,1) + q = min(j,l) + s = max(j,l) + q = q+shiftr(s*s-s,1) + i1 = min(p,q) + i2 = max(p,q) + i1 = i1+shiftr(i2*i2-i2,1) +end + + + +subroutine two_e_integrals_index_reverse_complex_1(i,j,k,l,i1) + use map_module + implicit none + BEGIN_DOC +! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. +! For 2 indices $i,j$ and $i \le j$, we have +! $p = i(i-1)/2 + j$. +! The key point is that because $j < i$, +! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving +! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ +! and $j = p - i(i-1)/2$. +! This rule is applied 3 times. First for the symmetry of the +! pairs (i,k) and (j,l), and then for the symmetry within each pair. +! always returns first set such that i<=k, j<=l, ik<=jl + END_DOC + integer, intent(out) :: i(4),j(4),k(4),l(4) + integer(key_kind), intent(in) :: i1 + integer(key_kind) :: i2,i3 + i = 0 + i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) + l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) + i3 = i1 - shiftr(i2*i2-i2,1) + k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) + j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) + i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4) + + !ijkl a+ib + i(2) = j(1) !jilk a+ib + j(2) = i(1) + k(2) = l(1) + l(2) = k(1) + + i(3) = k(1) !klij a-ib + j(3) = l(1) + k(3) = i(1) + l(3) = j(1) + + i(4) = l(1) !lkji a-ib + j(4) = k(1) + k(4) = j(1) + l(4) = i(1) + + integer :: ii, jj + do ii=2,4 + do jj=1,ii-1 + if ( (i(ii) == i(jj)).and. & + (j(ii) == j(jj)).and. & + (k(ii) == k(jj)).and. & + (l(ii) == l(jj)) ) then + i(ii) = 0 + exit + endif + enddo + enddo +end + +subroutine two_e_integrals_index_reverse_complex_2(i,j,k,l,i1) + use map_module + implicit none + BEGIN_DOC +! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$. +! For 2 indices $i,j$ and $i \le j$, we have +! $p = i(i-1)/2 + j$. +! The key point is that because $j < i$, +! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving +! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$ +! and $j = p - i(i-1)/2$. +! This rule is applied 3 times. First for the symmetry of the +! pairs (i,k) and (j,l), and then for the symmetry within each pair. +! always returns first set such that k<=i, j<=l, ik<=jl + END_DOC + integer, intent(out) :: i(4),j(4),k(4),l(4) + integer(key_kind), intent(in) :: i1 + integer(key_kind) :: i2,i3 + i = 0 + i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0)) + l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0)) + i3 = i1 - shiftr(i2*i2-i2,1) + i(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0)) + j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4) + k(1) = int(i3 - shiftr(i(1)*i(1)-i(1),1),4) + + !kjil a+ib + i(2) = j(1) !jkli a+ib + j(2) = i(1) + k(2) = l(1) + l(2) = k(1) + + i(3) = k(1) !ilkj a-ib + j(3) = l(1) + k(3) = i(1) + l(3) = j(1) + + i(4) = l(1) !lijk a-ib + j(4) = k(1) + k(4) = j(1) + l(4) = i(1) + + integer :: ii, jj + do ii=2,4 + do jj=1,ii-1 + if ( (i(ii) == i(jj)).and. & + (j(ii) == j(jj)).and. & + (k(ii) == k(jj)).and. & + (l(ii) == l(jj)) ) then + i(ii) = 0 + exit + endif + enddo + enddo +end + + +BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] + implicit none + BEGIN_DOC + ! Cache of AO integrals for fast access + END_DOC + PROVIDE ao_two_e_integrals_in_map + integer :: i,j,k,l,ii + integer(key_kind) :: idx1, idx2 + real(integral_kind) :: tmp_re, tmp_im + integer(key_kind) :: idx_re,idx_im + complex(integral_kind) :: integral + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl + complex*16 :: get_ao_two_e_integral_periodic_simple + + + !$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, & + !$OMP i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) + do l=ao_integrals_cache_min,ao_integrals_cache_max + do k=ao_integrals_cache_min,ao_integrals_cache_max + do j=ao_integrals_cache_min,ao_integrals_cache_max + do i=ao_integrals_cache_min,ao_integrals_cache_max + !DIR$ FORCEINLINE + integral = get_ao_two_e_integral_periodic_simple(i,j,k,l,& + ao_integrals_map,ao_integrals_map_2) + + ii = l-ao_integrals_cache_min + ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) + ao_integrals_cache_periodic(ii) = integral + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + +subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + use map_module + implicit none + BEGIN_DOC + ! get position of periodic AO integral + ! use_map1: true if integral is in first ao map, false if integral is in second ao map + ! idx: position of real part of integral in map (imag part is at idx+1) + ! sign: sign of imaginary part + ! + ! + ! for , conditionals are [a | | | | | | | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | m1 | m1* | m2 | m2* | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | TTT | TTF | FFT | FFF | FTT | TFF | TFT | FTF | + ! | | 0TT | T0F | 0FT | F0F | | | | | + ! | | T0T | 0TF | F0T | 0FF | | | | | + ! | | TT0 | | FF0 | | FT0(r) | TF0(r) | | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + ! | | 00T | 00F | | | | | | | + ! | | 000 | | | | | | | | + ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind), intent(out) :: idx + logical, intent(out) :: use_map1 + double precision, intent(out) :: sign + integer(key_kind) :: p,q,r,s,ik,jl,ij,kl + !DIR$ FORCEINLINE + call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) + p = min(i,j) + r = max(i,j) + ij = p+shiftr(r*r-r,1) + q = min(k,l) + s = max(k,l) + kl = q+shiftr(s*s-s,1) + + idx = 2*idx-1 + + if (ij==kl) then !real, J -> map1, K -> map2 + sign=0.d0 + if (i==k) then + use_map1=.True. + else + use_map1=.False. + endif + else + if (ik.eq.jl) then + if (i.lt.k) then !TT0 + sign=1.d0 + use_map1=.True. + else !FF0 + sign=-1.d0 + use_map1=.True. + endif + else if (i.eq.k) then + if (j.lt.l) then !0T* + sign=1.d0 + use_map1=.True. + else !0F* + sign=-1.d0 + use_map1=.True. + endif + else if (j.eq.l) then + if (i.lt.k) then + sign=1.d0 + use_map1=.True. + else + sign=-1.d0 + use_map1=.True. + endif + else if ((i.lt.k).eqv.(j.lt.l)) then + if (i.lt.k) then + sign=1.d0 + use_map1=.True. + else + sign=-1.d0 + use_map1=.True. + endif + else + if ((j.lt.l).eqv.(ik.lt.jl)) then + sign=1.d0 + use_map1=.False. + else + sign=-1.d0 + use_map1=.False. + endif + endif + endif +end + +complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) + use map_module + implicit none + BEGIN_DOC + ! Gets one AO bi-electronic integral from the AO map + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind) :: idx1,idx2,idx + real(integral_kind) :: tmp_re, tmp_im + integer(key_kind) :: idx_re,idx_im + type(map_type), intent(inout) :: map,map2 + integer :: ii + complex(integral_kind) :: tmp + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl,use_map1 + double precision :: sign + ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) + PROVIDE ao_two_e_integrals_in_map + call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + if (use_map1) then + call map_get(map,idx,tmp_re) + if (sign/=0.d0) then + call map_get(map,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif + else + call map_get(map2,idx,tmp_re) + if (sign/=0.d0) then + call map_get(map2,idx+1,tmp_im) + tmp_im *= sign + else + tmp_im=0.d0 + endif + endif + tmp = dcmplx(tmp_re,tmp_im) + result = tmp +end + + +complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(result) + use map_module + implicit none + BEGIN_DOC + ! Gets one AO bi-electronic integral from the AO map + END_DOC + integer, intent(in) :: i,j,k,l + integer(key_kind) :: idx1,idx2 + real(integral_kind) :: tmp_re, tmp_im + integer(key_kind) :: idx_re,idx_im + type(map_type), intent(inout) :: map,map2 + integer :: ii + complex(integral_kind) :: tmp + complex(integral_kind) :: get_ao_two_e_integral_periodic_simple + integer(key_kind) :: p,q,r,s,ik,jl + logical :: ilek, jlel, iklejl + ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) + PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min + !DIR$ FORCEINLINE +! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then +! tmp = (0.d0,0.d0) +! else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then +! tmp = (0.d0,0.d0) +! else + if (.True.) then + ii = l-ao_integrals_cache_min + ii = ior(ii, k-ao_integrals_cache_min) + ii = ior(ii, j-ao_integrals_cache_min) + ii = ior(ii, i-ao_integrals_cache_min) + if (iand(ii, -64) /= 0) then + tmp = get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) + else + ii = l-ao_integrals_cache_min + ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) + ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) + tmp = ao_integrals_cache_periodic(ii) + endif + result = tmp + endif +end + + +subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) + use map_module + BEGIN_DOC + ! Gets multiple AO bi-electronic integral from the AO map . + ! All i are retrieved for j,k,l fixed. + ! physicist convention : + END_DOC + implicit none + integer, intent(in) :: j,k,l, sze + complex*16, intent(out) :: out_val(sze) + + integer :: i + integer(key_kind) :: hash + double precision :: thresh + PROVIDE ao_two_e_integrals_in_map ao_integrals_map + thresh = ao_integrals_threshold + + if (ao_overlap_abs(j,l) < thresh) then + out_val = (0.d0,0.d0) + return + endif + + complex*16 :: get_ao_two_e_integral_periodic + do i=1,sze + out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + enddo + +end + +!subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_index,non_zero_int) +! use map_module +! implicit none +! BEGIN_DOC +! ! Gets multiple AO bi-electronic integral from the AO map . +! ! All non-zero i are retrieved for j,k,l fixed. +! END_DOC +! integer, intent(in) :: j,k,l, sze +! real(integral_kind), intent(out) :: out_val(sze) +! integer, intent(out) :: out_val_index(sze),non_zero_int +! +! integer :: i +! integer(key_kind) :: hash +! double precision :: thresh,tmp +! if(is_periodic) then +! print*,'not implemented for periodic:',irp_here +! stop -1 +! endif +! PROVIDE ao_two_e_integrals_in_map +! thresh = ao_integrals_threshold +! +! non_zero_int = 0 +! if (ao_overlap_abs(j,l) < thresh) then +! out_val = 0.d0 +! return +! endif +! +! non_zero_int = 0 +! do i=1,sze +! integer, external :: ao_l4 +! double precision, external :: ao_two_e_integral +! !DIR$ FORCEINLINE +! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then +! cycle +! endif +! call two_e_integrals_index(i,j,k,l,hash) +! call map_get(ao_integrals_map, hash,tmp) +! if (dabs(tmp) < thresh ) cycle +! non_zero_int = non_zero_int+1 +! out_val_index(non_zero_int) = i +! out_val(non_zero_int) = tmp +! enddo +! +!end + + +!subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) +! use map_module +! implicit none +! BEGIN_DOC +! ! Gets multiple AO bi-electronic integral from the AO map . +! ! All non-zero i are retrieved for j,k,l fixed. +! END_DOC +! double precision, intent(in) :: thresh +! integer, intent(in) :: j,l, sze,sze_max +! real(integral_kind), intent(out) :: out_val(sze_max) +! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int +! +! integer :: i,k +! integer(key_kind) :: hash +! double precision :: tmp +! +! if(is_periodic) then +! print*,'not implemented for periodic:',irp_here +! stop -1 +! endif +! PROVIDE ao_two_e_integrals_in_map +! non_zero_int = 0 +! if (ao_overlap_abs(j,l) < thresh) then +! out_val = 0.d0 +! return +! endif +! +! non_zero_int = 0 +! do k = 1, sze +! do i = 1, sze +! integer, external :: ao_l4 +! double precision, external :: ao_two_e_integral +! !DIR$ FORCEINLINE +! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then +! cycle +! endif +! call two_e_integrals_index(i,j,k,l,hash) +! call map_get(ao_integrals_map, hash,tmp) +! if (dabs(tmp) < thresh ) cycle +! non_zero_int = non_zero_int+1 +! out_val_index(1,non_zero_int) = i +! out_val_index(2,non_zero_int) = k +! out_val(non_zero_int) = tmp +! enddo +! enddo +! +!end + + +!subroutine get_ao_two_e_integrals_non_zero_jl_from_list_periodic(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) +! use map_module +! implicit none +! BEGIN_DOC +! ! Gets multiple AO two-electron integrals from the AO map . +! ! All non-zero i are retrieved for j,k,l fixed. +! END_DOC +! double precision, intent(in) :: thresh +! integer, intent(in) :: sze_max +! integer, intent(in) :: j,l, n_list,list(2,sze_max) +! real(integral_kind), intent(out) :: out_val(sze_max) +! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int +! +! integer :: i,k +! integer(key_kind) :: hash +! double precision :: tmp +! +! if(is_periodic) then +! print*,'not implemented for periodic:',irp_here +! stop -1 +! endif +! PROVIDE ao_two_e_integrals_in_map +! non_zero_int = 0 +! if (ao_overlap_abs(j,l) < thresh) then +! out_val = 0.d0 +! return +! endif +! +! non_zero_int = 0 +! integer :: kk +! do kk = 1, n_list +! k = list(1,kk) +! i = list(2,kk) +! integer, external :: ao_l4 +! double precision, external :: ao_two_e_integral +! !DIR$ FORCEINLINE +! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then +! cycle +! endif +! call two_e_integrals_index(i,j,k,l,hash) +! call map_get(ao_integrals_map, hash,tmp) +! if (dabs(tmp) < thresh ) cycle +! non_zero_int = non_zero_int+1 +! out_val_index(1,non_zero_int) = i +! out_val_index(2,non_zero_int) = k +! out_val(non_zero_int) = tmp +! enddo +! +!end + +subroutine insert_into_ao_integrals_map_2(n_integrals,buffer_i, buffer_values) + use map_module + implicit none + BEGIN_DOC + ! Create new entry into AO map + END_DOC + + integer, intent(in) :: n_integrals + integer(key_kind), intent(inout) :: buffer_i(n_integrals) + real(integral_kind), intent(inout) :: buffer_values(n_integrals) + + call map_append(ao_integrals_map_2, buffer_i, buffer_values, n_integrals) +end + + From 91a86c3b2f6be8d5b93a5367adf715e023d17fbd Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 4 Feb 2020 15:56:58 -0600 Subject: [PATCH 058/256] changed mapping --- src/ao_two_e_ints/map_integrals_complex.irp.f | 18 +++------- src/mo_two_e_ints/map_integrals_complex.irp.f | 34 ++++++++----------- src/utils_periodic/qp2-pbc-diff.txt | 4 +-- 3 files changed, 22 insertions(+), 34 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f index 9b6e1ad9..f087e1b8 100644 --- a/src/ao_two_e_ints/map_integrals_complex.irp.f +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -199,8 +199,8 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) ! | | T0T | 0TF | F0T | 0FF | | | | | ! | | TT0 | | FF0 | | FT0(r) | TF0(r) | | | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ - ! | | 00T | 00F | | | | | | | - ! | | 000 | | | | | | | | + ! | | | | | | 00T(r) | 00F(r) | | | + ! | | | | | | 000 | | | | ! +---------+---------+---------+---------+---------+---------+---------+---------+---------+ END_DOC integer, intent(in) :: i,j,k,l @@ -221,11 +221,7 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) if (ij==kl) then !real, J -> map1, K -> map2 sign=0.d0 - if (i==k) then - use_map1=.True. - else - use_map1=.False. - endif + use_map1=.False. else if (ik.eq.jl) then if (i.lt.k) then !TT0 @@ -292,12 +288,8 @@ complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) resu call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) if (use_map1) then call map_get(map,idx,tmp_re) - if (sign/=0.d0) then - call map_get(map,idx+1,tmp_im) - tmp_im *= sign - else - tmp_im=0.d0 - endif + call map_get(map,idx+1,tmp_im) + tmp_im *= sign else call map_get(map2,idx,tmp_re) if (sign/=0.d0) then diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_complex.irp.f index 7cf4ba0d..1864d600 100644 --- a/src/mo_two_e_ints/map_integrals_complex.irp.f +++ b/src/mo_two_e_ints/map_integrals_complex.irp.f @@ -73,12 +73,8 @@ complex*16 function get_two_e_integral_periodic_simple(i,j,k,l,map,map2) result( call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) if (use_map1) then call map_get(map,idx,tmp_re) - if (sign/=0.d0) then - call map_get(map,idx+1,tmp_im) - tmp_im *= sign - else - tmp_im=0.d0 - endif + call map_get(map,idx+1,tmp_im) + tmp_im *= sign else call map_get(map2,idx,tmp_re) if (sign/=0.d0) then @@ -291,20 +287,22 @@ end ! deallocate(pairs,hash,iorder,tmp_val) !end -subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map) +subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map,map2) use map_module implicit none BEGIN_DOC ! Returns multiple integrals ! k(1)i(2) 1/r12 l(1)i(2) :: out_val(i1) ! for k,l fixed. - ! always in map1, take conjugate if k>l, real if k==l + ! real and in map2 if k==l + ! complex and in map1 otherwise + ! take conjugate if k>l ! TODO: determine best way to structure code ! to account for single/double integral_kind, real/complex, and +/- imag part END_DOC integer, intent(in) :: k,l, sze complex*16, intent(out) :: out_val(sze) - type(map_type), intent(inout) :: map + type(map_type), intent(inout) :: map,map2 integer :: i integer(key_kind) :: hash(sze),hash_re(sze),hash_im(sze) real(integral_kind) :: tmp_re(sze),tmp_im(sze) @@ -313,7 +311,7 @@ subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map) PROVIDE mo_two_e_integrals_in_map if (k.eq.l) then ! real, call other function - call get_mo_two_e_integrals_coulomb_ijij_periodic(k,sze,out_re,map) + call get_mo_two_e_integrals_coulomb_ijij_periodic(k,sze,out_re,map2) do i=1,sze out_val(i) = dcmplx(out_re(i),0.d0) enddo @@ -349,18 +347,18 @@ subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map) endif end -subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map) +subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map2) use map_module implicit none BEGIN_DOC ! Returns multiple integrals ! i*(1)j*(2) 1/r12 i(1)j(2) :: out_val(i) ! for j fixed. - ! always in map1, always real + ! always in map2, always real END_DOC integer, intent(in) :: j, sze double precision, intent(out) :: out_val(sze) - type(map_type), intent(inout) :: map + type(map_type), intent(inout) :: map2 integer :: i integer(key_kind) :: hash(sze),hash_re(sze) real(integral_kind) :: tmp_re(sze) @@ -374,9 +372,9 @@ subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map) enddo if (integral_kind == 8) then - call map_get_many(map, hash_re, out_val, sze) + call map_get_many(map2, hash_re, out_val, sze) else - call map_get_many(map, hash_re, tmp_re, sze) + call map_get_many(map2, hash_re, tmp_re, sze) ! Conversion to double complex do i=1,sze out_val(i) = dble(tmp_re(i)) @@ -401,7 +399,7 @@ subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) END_DOC integer, intent(in) :: k,l, sze double precision, intent(out) :: out_val(sze) - type(map_type), intent(inout) :: map + type(map_type), intent(inout) :: map,map2 integer :: i integer(key_kind) :: hash(sze),hash_re(sze),hash_im(sze) real(integral_kind) :: tmp_re(sze),tmp_im(sze) @@ -466,7 +464,7 @@ subroutine get_mo_two_e_integrals_exch_ijji_periodic(j,sze,out_val,map,map2) ! Returns multiple integrals ! i*(1)j*(2) 1/r12 j(1)i(2) :: out_val(i) ! for j fixed. - ! always real, always in map2 (except when j==i, then in map1) + ! always real, always in map2 END_DOC integer, intent(in) :: j, sze double precision, intent(out) :: out_val(sze) @@ -485,10 +483,8 @@ subroutine get_mo_two_e_integrals_exch_ijji_periodic(j,sze,out_val,map,map2) if (integral_kind == 8) then call map_get_many(map2, hash_re, out_val, sze) - call map_get(map,hash_re(j), out_val(j)) else call map_get_many(map2, hash_re, tmp_val, sze) - call map_get(map, hash_re(j), tmp_val(j)) ! Conversion to double precision do i=1,sze out_val(i) = dble(tmp_val(i)) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 72c72e78..eb5ec462 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -28,8 +28,8 @@ MO 2e ints: maybe good idea to make map_get for two neighboring vals? (re/im parts) mapping: - should change so that all of the real ints are in map2 - (will make some things simpler when retrieving exchange ints (currently, all of these are in map2 except when i==j)) + changed so that all real ints (Jij, Kij, Jii) are in map2 + , , TODO: From f35c8f4f4c036bc920bba6f9dbc5f8bcd13917c9 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 5 Feb 2020 14:21:28 -0600 Subject: [PATCH 059/256] working on mo 2e int framework --- src/mo_two_e_ints/integrals_3_index.irp.f | 30 +++++++++++++ src/mo_two_e_ints/mo_bi_integrals.irp.f | 54 ++++++++++++++++++++++- src/utils_periodic/qp2-pbc-diff.txt | 12 +++++ 3 files changed, 94 insertions(+), 2 deletions(-) diff --git a/src/mo_two_e_ints/integrals_3_index.irp.f b/src/mo_two_e_ints/integrals_3_index.irp.f index 73e31182..33d201d8 100644 --- a/src/mo_two_e_ints/integrals_3_index.irp.f +++ b/src/mo_two_e_ints/integrals_3_index.irp.f @@ -25,3 +25,33 @@ END_PROVIDER + BEGIN_PROVIDER [complex*16, big_array_coulomb_integrals_periodic, (mo_num,mo_num, mo_num)] +&BEGIN_PROVIDER [complex*16, big_array_exchange_integrals_periodic,(mo_num,mo_num, mo_num)] + implicit none + BEGIN_DOC + ! big_array_coulomb_integrals(j,i,k) = = (ik|jj) + ! big_array_exchange_integrals(j,i,k) = = (ij|jk) + ! for both of these, i and k must be from same kpt for integral to be nonzero + ! TODO: only loop over half, and assign two elements: + ! b_a_coul_int(j,i,k) = b_a_coul_int(j,k,i)* + ! b_a_exch_int(j,i,k) = b_a_exch_int(j,k,i)* + END_DOC + integer :: i,j,k,l + complex*16 :: get_two_e_integral_periodic + complex*16 :: integral + + do k = 1, mo_num + do i = 1, mo_num + do j = 1, mo_num + l = j + integral = get_two_e_integral_periodic(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + big_array_coulomb_integrals(j,i,k) = integral + l = j + integral = get_two_e_integral_periodic(i,j,l,k,mo_integrals_map,mo_integrals_map_2) + big_array_exchange_integrals(j,i,k) = integral + enddo + enddo + enddo + +END_PROVIDER + diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index a9983e51..11687602 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -28,9 +28,60 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] integer(bit_kind) :: mask_ijkl(N_int,4) integer(bit_kind) :: mask_ijk(N_int,3) double precision :: cpu_1, cpu_2, wall_1, wall_2 + integer*8 :: get_mo_map_size, mo_map_size + double precision, external :: map_mb PROVIDE mo_class + if (is_periodic) then + mo_two_e_integrals_in_map = .True. + if (read_mo_two_e_integrals) then + print*,'Reading the MO integrals' + call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_1',mo_integrals_map) + call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_2',mo_integrals_map_2) + print*, 'MO integrals provided (periodic)' + return + else + PROVIDE ao_two_e_integrals_in_map + endif + + print *, '' + print *, 'AO -> MO integrals transformation (periodic)' + print *, '---------------------------------' + print *, '' + + call wall_time(wall_1) + call cpu_time(cpu_1) + + if(no_vvvv_integrals)then + print*,'not implemented for periodic',irp_here + stop -1 + call four_idx_novvvv_periodic + else + print*,'not implemented for periodic',irp_here + stop -1 + call add_integrals_to_map_periodic(full_ijkl_bitmask_4) + endif + + call wall_time(wall_2) + call cpu_time(cpu_2) + + mo_map_size = get_mo_map_size() + + print*,'Molecular integrals provided:' + print*,' Size of MO map 1 ', map_mb(mo_integrals_map) ,'MB' + print*,' Size of MO map 2 ', map_mb(mo_integrals_map_2) ,'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + + if (write_mo_two_e_integrals.and.mpi_master) then + call ezfio_set_work_empty(.False.) + call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_1',mo_integrals_map) + call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_2',mo_integrals_map_2) + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + endif + else mo_two_e_integrals_in_map = .True. if (read_mo_two_e_integrals) then print*,'Reading the MO integrals' @@ -58,10 +109,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] call wall_time(wall_2) call cpu_time(cpu_2) - integer*8 :: get_mo_map_size, mo_map_size mo_map_size = get_mo_map_size() - double precision, external :: map_mb print*,'Molecular integrals provided:' print*,' Size of MO map ', map_mb(mo_integrals_map) ,'MB' print*,' Number of MO integrals: ', mo_map_size @@ -73,6 +122,7 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints',mo_integrals_map) call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') endif + endif END_PROVIDER diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index eb5ec462..15bc6cfc 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -54,6 +54,18 @@ mo_two_e_ints incomplete +NOTES: + number of unique 4-tuples with 8-fold symmetry is a8(n)=n*(n+1)*(n^2+n+2)/8 + number of unique 4-tuples with 4-fold symmetry is a4(n)=n^2*(n^2+3)/4 + a8 is number of unique real 2e ints with n mos + a4 is number of unique* complex 2e ints with n mos (where p+i*q and p-i*q are counted as one, not two) + a4(n) = a8(n) + a8(n-1) + + we can already generate the list of with unique values for the 8-fold case + the set of these for 4-fold symmetry is the union of the 8-fold set for n and the 8-fold set for n-1 with a simple transformation + _{4,n} = _{8,n} + <(k+1)j|i(l+1)>_{8,n-1} + + ############################ From b1e14142c655e6400a975273f506c62702996d13 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 5 Feb 2020 17:50:17 -0600 Subject: [PATCH 060/256] working on complex MO 2e ints --- src/ao_two_e_ints/map_integrals_complex.irp.f | 8 +- src/mo_basis/mos_complex.irp.f | 32 +- .../four_idx_novvvv_complex.irp.f | 247 ++++ src/mo_two_e_ints/map_integrals_complex.irp.f | 6 +- src/mo_two_e_ints/mo_bi_integrals.irp.f | 204 ++- .../mo_bi_integrals_complex.irp.f | 1163 +++++++++++++++++ 6 files changed, 1644 insertions(+), 16 deletions(-) create mode 100644 src/mo_two_e_ints/four_idx_novvvv_complex.irp.f create mode 100644 src/mo_two_e_ints/mo_bi_integrals_complex.irp.f diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f index f087e1b8..611bc4cb 100644 --- a/src/ao_two_e_ints/map_integrals_complex.irp.f +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -376,7 +376,9 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) end -!subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_index,non_zero_int) + print*,'not implemented for periodic',irp_here + stop -1 ! use map_module ! implicit none ! BEGIN_DOC @@ -418,8 +420,8 @@ end ! out_val_index(non_zero_int) = i ! out_val(non_zero_int) = tmp ! enddo -! -!end + +end !subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index 7a4361b7..75d3e169 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -166,7 +166,7 @@ subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo) ! Transform A from the AO basis to the MO basis ! where A is complex in the AO basis ! - ! Ct.A_ao.C + ! C^\dagger.A_ao.C END_DOC integer, intent(in) :: LDA_ao,LDA_mo complex*16, intent(in) :: A_ao(LDA_ao,ao_num) @@ -189,6 +189,36 @@ subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo) deallocate(T) end +subroutine ao_to_mo_noconjg_complex(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the AO basis to the MO basis + ! where A is complex in the AO basis + ! + ! C^T.A_ao.C + ! needed for 4idx tranform in four_idx_novvvv + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num) + complex*16, intent(out) :: A_mo(LDA_mo,mo_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,mo_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','N', ao_num, mo_num, ao_num, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_complex, size(mo_coef_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('T','N', mo_num, mo_num, ao_num, & + (1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), & + T, ao_num, & + (0.d0,0.d0), A_mo, size(A_mo,1)) + + deallocate(T) +end + subroutine ao_ortho_cano_to_ao_complex(A_ao,LDA_ao,A,LDA) implicit none diff --git a/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f b/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f new file mode 100644 index 00000000..e02de3b7 --- /dev/null +++ b/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f @@ -0,0 +1,247 @@ +BEGIN_PROVIDER [ complex*16, mo_coef_novirt_complex, (ao_num,n_core_inact_act_orb) ] + implicit none + BEGIN_DOC + ! MO coefficients without virtual MOs + END_DOC + integer :: j,jj + + do j=1,n_core_inact_act_orb + jj = list_core_inact_act(j) + mo_coef_novirt_complex(:,j) = mo_coef_complex(:,jj) + enddo + +END_PROVIDER + +subroutine ao_to_mo_novirt_complex(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the |AO| basis to the |MO| basis excluding virtuals + ! + ! $C^\dagger.A_{ao}.C$ + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num) + complex*16, intent(out) :: A_mo(LDA_mo,n_core_inact_act_orb) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,n_core_inact_act_orb) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','N', ao_num, n_core_inact_act_orb, ao_num, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_novirt_complex, size(mo_coef_novirt_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('C','N', n_core_inact_act_orb, n_core_inact_act_orb, ao_num,& + (1.d0,0.d0), mo_coef_novirt_complex,size(mo_coef_novirt_complex,1), & + T, ao_num, & + (0.d0,0.d0), A_mo, size(A_mo,1)) + + deallocate(T) +end + +subroutine ao_to_mo_novirt_conjg_complex(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the |AO| basis to the |MO| basis excluding virtuals + ! + ! $C^\dagger.A_{ao}.C^*$ + ! half-transformed ints as handled by four_idx_novvvv need to use this + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num) + complex*16, intent(out) :: A_mo(LDA_mo,n_core_inact_act_orb) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num,n_core_inact_act_orb) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + + call zgemm('N','N', ao_num, n_core_inact_act_orb, ao_num, & + (1.d0,0.d0), A_ao,LDA_ao, & + dconjg(mo_coef_novirt_complex), size(mo_coef_novirt_complex,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('C','N', n_core_inact_act_orb, n_core_inact_act_orb, ao_num,& + (1.d0,0.d0), mo_coef_novirt_complex,size(mo_coef_novirt_complex,1), & + T, ao_num, & + (0.d0,0.d0), A_mo, size(A_mo,1)) + + deallocate(T) +end + + +subroutine four_idx_novvvv_complex + use map_module + implicit none + BEGIN_DOC + ! Retransform MO integrals for next CAS-SCF step + END_DOC + integer :: i,j,k,l,n_integrals1,n_integrals2 + logical :: use_map1 + complex*16, allocatable :: f(:,:,:), f2(:,:,:), d(:,:), T(:,:,:,:), T2(:,:,:,:) + complex*16, external :: get_ao_two_e_integral_periodic + integer(key_kind), allocatable :: idx1(:),idx2(:) + complex(integral_kind), allocatable :: values1(:),values2(:) + double precision :: sign_tmp + integer(key_kind) :: idx_tmp + + integer :: p,q,r,s + allocate( T(n_core_inact_act_orb,n_core_inact_act_orb,ao_num,ao_num) , & + T2(n_core_inact_act_orb,n_core_inact_act_orb,ao_num,ao_num) ) + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(mo_num,ao_num,T,n_core_inact_act_orb, & + !$OMP mo_integrals_threshold,mo_integrals_map, & + !$OMP mo_integrals_map_2,ao_integrals_map_2, & + !$OMP list_core_inact_act,T2,ao_integrals_map) & + !$OMP PRIVATE(i,j,k,l,p,q,r,s,idx1,idx2,values1,values2,n_integrals1, & + !$OMP n_integrals2,use_map1,idx_tmp,sign_tmp, & + !$OMP f,f2,d) + allocate(f(ao_num,ao_num,ao_num), f2(ao_num,ao_num,ao_num), d(mo_num,mo_num), & + idx1(2*mo_num*mo_num), values1(2*mo_num*mo_num), & + idx2(2*mo_num*mo_num), values2(2*mo_num*mo_num) ) + + ! + !$OMP DO + do s=1,ao_num + do r=1,ao_num + do q=1,ao_num + do p=1,r + f (p,q,r) = get_ao_two_e_integral_periodic(p,q,r,s,ao_integrals_map,ao_integrals_map_2) + f (r,q,p) = get_ao_two_e_integral_periodic(r,q,p,s,ao_integrals_map,ao_integrals_map_2) + enddo + enddo + enddo + do r=1,ao_num + do q=1,ao_num + do p=1,ao_num + f2(p,q,r) = f(p,r,q) + enddo + enddo + enddo + ! f (p,q,r) = + ! f2(p,q,r) = + + do r=1,ao_num + call ao_to_mo_novirt_conjg_complex(f (1,1,r),size(f ,1),T (1,1,r,s),size(T,1)) + call ao_to_mo_novirt_complex(f2(1,1,r),size(f2,1),T2(1,1,r,s),size(T,1)) + enddo + ! T (i,j,p,q) = + ! T2(i,j,p,q) = + + enddo + !$OMP END DO + + !$OMP DO + do j=1,n_core_inact_act_orb + do i=1,n_core_inact_act_orb + do s=1,ao_num + do r=1,ao_num + f (r,s,1) = T (i,j,r,s) + f2(r,s,1) = T2(i,j,r,s) + enddo + enddo + call ao_to_mo_noconjg_complex(f ,size(f ,1),d,size(d,1)) + n_integrals1 = 0 + n_integrals2 = 0 + do l=1,mo_num + do k=1,mo_num + call ao_two_e_integral_periodic_map_idx_sign(list_core_inact_act(i),list_core_inact_act(j),k,l,use_map1,idx_tmp,sign_tmp) + if (use_map1) then + n_integrals1+=1 + values1(n_integrals1) = dble(d(k,l)) + idx1(n_integrals1) = idx_tmp + if (sign_tmp /= 0.d0) then ! should always be true, but might change in the future + n_integrals1+=1 + values1(n_integrals1) = sign_tmp*dimag(d(k,l)) + idx1(n_integrals1) = idx_tmp+1 + endif + else + n_integrals2+=1 + values2(n_integrals2) = dble(d(k,l)) + idx2(n_integrals2) = idx_tmp + if (sign_tmp /= 0.d0) then + n_integrals2+=1 + values2(n_integrals2) = sign_tmp*dimag(d(k,l)) + idx2(n_integrals2) = idx_tmp+1 + endif + endif + enddo + enddo + call map_append(mo_integrals_map, idx1, values1, n_integrals1) + call map_append(mo_integrals_map_2, idx2, values2, n_integrals2) + + call ao_to_mo(f2,size(f2,1),d,size(d,1)) + n_integrals1 = 0 + n_integrals2 = 0 + do l=1,mo_num + do k=1,mo_num + call ao_two_e_integral_periodic_map_idx_sign(list_core_inact_act(i),k,list_core_inact_act(j),l,use_map1,idx_tmp,sign_tmp) + if (use_map1) then + n_integrals1+=1 + values1(n_integrals1) = dble(d(k,l)) + idx1(n_integrals1) = idx_tmp + if (sign_tmp /= 0.d0) then ! should always be true, but might change in the future + n_integrals1+=1 + values1(n_integrals1) = sign_tmp*dimag(d(k,l)) + idx1(n_integrals1) = idx_tmp+1 + endif + else + n_integrals2+=1 + values2(n_integrals2) = dble(d(k,l)) + idx2(n_integrals2) = idx_tmp + if (sign_tmp /= 0.d0) then + n_integrals2+=1 + values2(n_integrals2) = sign_tmp*dimag(d(k,l)) + idx2(n_integrals2) = idx_tmp+1 + endif + endif + enddo + enddo + call map_append(mo_integrals_map, idx1, values1, n_integrals1) + call map_append(mo_integrals_map_2, idx2, values2, n_integrals2) + enddo + enddo + !$OMP END DO + deallocate(f,f2,d,idx1,idx2,values1,values2) + + !$OMP END PARALLEL + + deallocate(T,T2) + + + call map_sort(mo_integrals_map) + call map_unique(mo_integrals_map) + call map_shrink(mo_integrals_map,real(mo_integrals_threshold,integral_kind)) + + call map_sort(mo_integrals_map_2) + call map_unique(mo_integrals_map_2) + call map_shrink(mo_integrals_map_2,real(mo_integrals_threshold,integral_kind)) + +end + +subroutine four_idx_novvvv2_complex + use bitmasks + implicit none + integer :: i + integer(bit_kind) :: mask_ijkl(N_int,4) + + print*, '' + do i = 1,N_int + mask_ijkl(i,1) = core_inact_act_bitmask_4(i,1) + mask_ijkl(i,2) = full_ijkl_bitmask_4(i,1) + mask_ijkl(i,3) = core_inact_act_bitmask_4(i,1) + mask_ijkl(i,4) = full_ijkl_bitmask_4(i,1) + enddo + call add_integrals_to_map_complex(mask_ijkl) + + print*, '' + do i = 1,N_int + mask_ijkl(i,1) = core_inact_act_bitmask_4(i,1) + mask_ijkl(i,2) = core_inact_act_bitmask_4(i,1) + mask_ijkl(i,3) = virt_bitmask(i,1) + mask_ijkl(i,4) = virt_bitmask(i,1) + enddo + call add_integrals_to_map_complex(mask_ijkl) + +end diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_complex.irp.f index 1864d600..20970a15 100644 --- a/src/mo_two_e_ints/map_integrals_complex.irp.f +++ b/src/mo_two_e_ints/map_integrals_complex.irp.f @@ -306,7 +306,7 @@ subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map,map2) integer :: i integer(key_kind) :: hash(sze),hash_re(sze),hash_im(sze) real(integral_kind) :: tmp_re(sze),tmp_im(sze) - complex*16 :: out_re(sze),out_im(sze) + double precision :: out_re(sze),out_im(sze) double precision :: sign PROVIDE mo_two_e_integrals_in_map @@ -400,10 +400,10 @@ subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) integer, intent(in) :: k,l, sze double precision, intent(out) :: out_val(sze) type(map_type), intent(inout) :: map,map2 - integer :: i + integer :: i,klmin,klmax integer(key_kind) :: hash(sze),hash_re(sze),hash_im(sze) real(integral_kind) :: tmp_re(sze),tmp_im(sze) - complex*16 :: out_re(sze),out_im(sze) + double precision :: out_re(sze),out_im(sze) double precision :: sign,sign2(sze) PROVIDE mo_two_e_integrals_in_map diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index 11687602..bb998c26 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -56,11 +56,11 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] if(no_vvvv_integrals)then print*,'not implemented for periodic',irp_here stop -1 - call four_idx_novvvv_periodic + call four_idx_novvvv_complex else print*,'not implemented for periodic',irp_here stop -1 - call add_integrals_to_map_periodic(full_ijkl_bitmask_4) + call add_integrals_to_map_complex(full_ijkl_bitmask_4) endif call wall_time(wall_2) @@ -981,13 +981,94 @@ end ! mo_two_e_integrals_jj_exchange_from_ao(i,j) = J_ij ! mo_two_e_integrals_jj_anti_from_ao(i,j) = J_ij - K_ij END_DOC - + integer :: i,j,p,q,r,s double precision :: c - real(integral_kind) :: integral integer :: n, pp - real(integral_kind), allocatable :: int_value(:) integer, allocatable :: int_idx(:) + if (is_periodic) then + complex(integral_kind) :: integral2 + complex(integral_kind), allocatable :: int_value2(:) + complex*16 :: cz + + complex*16, allocatable :: iqrs2(:,:), iqsr2(:,:), iqis2(:), iqri2(:) + PROVIDE ao_two_e_integrals_in_map mo_coef_complex + mo_two_e_integral_jj_from_ao = 0.d0 + mo_two_e_integrals_jj_exchange_from_ao = 0.d0 + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs2, iqsr2 + + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i,j,p,q,r,s,integral2,c,n,pp,int_value2,int_idx, & + !$OMP iqrs2, iqsr2,iqri2,iqis2,cz) & + !$OMP SHARED(mo_num,mo_coef_transp_complex,mo_coef_transp_complex_conjg,ao_num, & + !$OMP ao_integrals_threshold) & + !$OMP REDUCTION(+:mo_two_e_integral_jj_from_ao,mo_two_e_integrals_jj_exchange_from_ao) + + allocate( int_value2(ao_num), int_idx(ao_num), & + iqrs2(mo_num,ao_num), iqis2(mo_num), iqri2(mo_num), & + iqsr2(mo_num,ao_num) ) + + !$OMP DO SCHEDULE (guided) + do s=1,ao_num + do q=1,ao_num + + do j=1,ao_num + do i=1,mo_num + iqrs2(i,j) = (0.d0,0.d0) + iqsr2(i,j) = (0.d0,0.d0) + enddo + enddo + + + do r=1,ao_num + call get_ao_two_e_integrals_non_zero_periodic(q,r,s,ao_num,int_value2,int_idx,n) + do pp=1,n + p = int_idx(pp) + integral2 = int_value2(pp) + if (cdabs(integral2) > ao_integrals_threshold) then + do i=1,mo_num + iqrs2(i,r) += mo_coef_transp_complex_conjg(i,p) * integral2 + enddo + endif + enddo + call get_ao_two_e_integrals_non_zero_periodic(q,s,r,ao_num,int_value2,int_idx,n) + do pp=1,n + p = int_idx(pp) + integral2 = int_value2(pp) + if (cdabs(integral2) > ao_integrals_threshold) then + do i=1,mo_num + iqsr2(i,r) += mo_coef_transp_complex_conjg(i,p) * integral2 + enddo + endif + enddo + enddo + iqis2 = (0.d0,0.d0) + iqri2 = (0.d0,0.d0) + do r=1,ao_num + do i=1,mo_num + iqis2(i) += mo_coef_transp_complex(i,r) * iqrs2(i,r) + iqri2(i) += mo_coef_transp_complex(i,r) * iqsr2(i,r) + enddo + enddo + do i=1,mo_num + do j=1,mo_num + cz = mo_coef_transp_complex_conjg(j,q)*mo_coef_transp_complex(j,s) + mo_two_e_integral_jj_from_ao(j,i) += dble(cz * iqis2(i)) + mo_two_e_integrals_jj_exchange_from_ao(j,i) += dble(cz * iqri2(i)) + enddo + enddo + + enddo + enddo + !$OMP END DO NOWAIT + deallocate(iqrs2,iqsr2,int_value2,int_idx) + !$OMP END PARALLEL + + + else + real(integral_kind) :: integral + real(integral_kind), allocatable :: int_value(:) double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) @@ -1092,7 +1173,7 @@ end !$OMP END DO NOWAIT deallocate(iqrs,iqsr,int_value,int_idx) !$OMP END PARALLEL - + endif mo_two_e_integrals_jj_anti_from_ao = mo_two_e_integral_jj_from_ao - mo_two_e_integrals_jj_exchange_from_ao @@ -1112,11 +1193,100 @@ END_PROVIDER integer :: i,j,p,q,r,s integer :: i0,j0 double precision :: c - real(integral_kind) :: integral integer :: n, pp - real(integral_kind), allocatable :: int_value(:) integer, allocatable :: int_idx(:) + if (is_periodic) then + complex*16 :: cz + complex(integral_kind) :: integral2 + complex(integral_kind), allocatable :: int_value2(:) + complex*16, allocatable :: iqrs2(:,:), iqsr2(:,:), iqis2(:), iqri2(:) + + PROVIDE ao_two_e_integrals_in_map mo_coef_complex + + mo_two_e_integrals_vv_from_ao = 0.d0 + mo_two_e_integrals_vv_exchange_from_ao = 0.d0 + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs2, iqsr2 + + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i0,j0,i,j,p,q,r,s,integral2,c,n,pp,int_value2,int_idx, & + !$OMP iqrs2, iqsr2,iqri2,iqis2,cz) & + !$OMP SHARED(n_virt_orb,mo_num,list_virt,mo_coef_transp_complex,ao_num, & + !$OMP mo_coef_transp_complex_conjg, & + !$OMP ao_integrals_threshold,do_direct_integrals) & + !$OMP REDUCTION(+:mo_two_e_integrals_vv_from_ao,mo_two_e_integrals_vv_exchange_from_ao) + + allocate( int_value2(ao_num), int_idx(ao_num), & + iqrs2(mo_num,ao_num), iqis2(mo_num), iqri2(mo_num),& + iqsr2(mo_num,ao_num) ) + + !$OMP DO SCHEDULE (guided) + do s=1,ao_num + do q=1,ao_num + + do j=1,ao_num + do i0=1,n_virt_orb + i = list_virt(i0) + iqrs2(i,j) = (0.d0,0.d0) + iqsr2(i,j) = (0.d0,0.d0) + enddo + enddo + + + do r=1,ao_num + call get_ao_two_e_integrals_non_zero_periodic(q,r,s,ao_num,int_value2,int_idx,n) + do pp=1,n + p = int_idx(pp) + integral2 = int_value2(pp) + if (cdabs(integral2) > ao_integrals_threshold) then + do i0=1,n_virt_orb + i =list_virt(i0) + iqrs2(i,r) += mo_coef_transp_complex_conjg(i,p) * integral2 + enddo + endif + enddo + call get_ao_two_e_integrals_non_zero_periodic(q,s,r,ao_num,int_value2,int_idx,n) + do pp=1,n + p = int_idx(pp) + integral2 = int_value2(pp) + if (cdabs(integral2) > ao_integrals_threshold) then + do i0=1,n_virt_orb + i = list_virt(i0) + iqsr2(i,r) += mo_coef_transp_complex_conjg(i,p) * integral2 + enddo + endif + enddo + enddo + + iqis2 = (0.d0,0.d0) + iqri2 = (0.d0,0.d0) + do r=1,ao_num + do i0=1,n_virt_orb + i = list_virt(i0) + iqis2(i) += mo_coef_transp_complex(i,r) * iqrs2(i,r) + iqri2(i) += mo_coef_transp_complex(i,r) * iqsr2(i,r) + enddo + enddo + do i0=1,n_virt_orb + i= list_virt(i0) + do j0=1,n_virt_orb + j = list_virt(j0) + cz = mo_coef_transp_complex_conjg(j,q)*mo_coef_transp_complex(j,s) + mo_two_e_integrals_vv_from_ao(j,i) += dble(cz * iqis2(i)) + mo_two_e_integrals_vv_exchange_from_ao(j,i) += dble(cz * iqri2(i)) + enddo + enddo + + enddo + enddo + !$OMP END DO NOWAIT + deallocate(iqrs2,iqsr2,iqis2,iqri2,int_value2,int_idx) + !$OMP END PARALLEL + else + real(integral_kind) :: integral + real(integral_kind), allocatable :: int_value(:) double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) if (.not.do_direct_integrals) then @@ -1228,6 +1398,7 @@ END_PROVIDER !$OMP END DO NOWAIT deallocate(iqrs,iqsr,int_value,int_idx) !$OMP END PARALLEL + endif mo_two_e_integrals_vv_anti_from_ao = mo_two_e_integrals_vv_from_ao - mo_two_e_integrals_vv_exchange_from_ao ! print*, '**********' @@ -1257,7 +1428,18 @@ END_PROVIDER PROVIDE mo_two_e_integrals_in_map mo_two_e_integrals_jj = 0.d0 mo_two_e_integrals_jj_exchange = 0.d0 - + if (is_periodic) then + complex*16 :: get_two_e_integral_periodic + do j=1,mo_num + do i=1,mo_num + mo_two_e_integrals_jj(i,j) = dble(get_two_e_integral_periodic(i,j,i,j,& + mo_integrals_map,mo_integrals_map_2)) + mo_two_e_integrals_jj_exchange(i,j) = dble(get_two_e_integral_periodic(i,j,j,i,& + mo_integrals_map,mo_integrals_map_2)) + mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j) + enddo + enddo + else do j=1,mo_num do i=1,mo_num mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map) @@ -1265,6 +1447,7 @@ END_PROVIDER mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j) enddo enddo + endif END_PROVIDER @@ -1275,6 +1458,9 @@ subroutine clear_mo_map ! Frees the memory of the MO map END_DOC call map_deinit(mo_integrals_map) + if (is_periodic) then + call map_deinit(mo_integrals_map_2) + endif FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map end diff --git a/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f b/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f new file mode 100644 index 00000000..8d1dd9f0 --- /dev/null +++ b/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f @@ -0,0 +1,1163 @@ + + +subroutine add_integrals_to_map_complex(mask_ijkl) + use map_module + use bitmasks + implicit none + + BEGIN_DOC + ! Adds integrals to tha MO map according to some bitmask + END_DOC + + integer(bit_kind), intent(in) :: mask_ijkl(N_int,4) + + integer :: i,j,k,l + integer :: i0,j0,k0,l0 + double precision :: c, cpu_1, cpu_2, wall_1, wall_2, wall_0 + + integer, allocatable :: list_ijkl(:,:) + integer :: n_i, n_j, n_k, n_l + integer, allocatable :: two_e_tmp_0_idx(:) + real(integral_kind), allocatable :: two_e_tmp_0(:,:) + double precision, allocatable :: two_e_tmp_1(:) + double precision, allocatable :: two_e_tmp_2(:,:) + double precision, allocatable :: two_e_tmp_3(:,:,:) + !DIR$ ATTRIBUTES ALIGN : 64 :: two_e_tmp_1, two_e_tmp_2, two_e_tmp_3 + + integer :: n_integrals + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i(:) + real(integral_kind),allocatable :: buffer_value(:) + double precision, external :: map_mb + + integer :: i1,j1,k1,l1, ii1, kmax, thread_num + integer :: i2,i3,i4 + double precision,parameter :: thr_coef = 1.d-10 + + print*,'not implemented for complex',irp_here + stop -1 +! PROVIDE ao_two_e_integrals_in_map mo_coef +! +! !Get list of MOs for i,j,k and l +! !------------------------------- +! +! allocate(list_ijkl(mo_num,4)) +! call bitstring_to_list( mask_ijkl(1,1), list_ijkl(1,1), n_i, N_int ) +! call bitstring_to_list( mask_ijkl(1,2), list_ijkl(1,2), n_j, N_int ) +! call bitstring_to_list( mask_ijkl(1,3), list_ijkl(1,3), n_k, N_int ) +! call bitstring_to_list( mask_ijkl(1,4), list_ijkl(1,4), n_l, N_int ) +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijkl(i,1)) +! enddo +! if(j==0)then +! return +! endif +! +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijkl(i,2)) +! enddo +! if(j==0)then +! return +! endif +! +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijkl(i,3)) +! enddo +! if(j==0)then +! return +! endif +! +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijkl(i,4)) +! enddo +! if(j==0)then +! return +! endif +! +! size_buffer = min(ao_num*ao_num*ao_num,16000000) +! print*, 'Buffers : ', 8.*(mo_num*(n_j)*(n_k+1) + mo_num+& +! ao_num+ao_num*ao_num+ size_buffer*3)/(1024*1024), 'MB / core' +! +! double precision :: accu_bis +! accu_bis = 0.d0 +! call wall_time(wall_1) +! +! !$OMP PARALLEL PRIVATE(l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, & +! !$OMP two_e_tmp_0_idx, two_e_tmp_0, two_e_tmp_1,two_e_tmp_2,two_e_tmp_3,& +! !$OMP buffer_i,buffer_value,n_integrals,wall_2,i0,j0,k0,l0, & +! !$OMP wall_0,thread_num,accu_bis) & +! !$OMP DEFAULT(NONE) & +! !$OMP SHARED(size_buffer,ao_num,mo_num,n_i,n_j,n_k,n_l, & +! !$OMP mo_coef_transp, & +! !$OMP mo_coef_transp_is_built, list_ijkl, & +! !$OMP mo_coef_is_built, wall_1, & +! !$OMP mo_coef,mo_integrals_threshold,mo_integrals_map) +! n_integrals = 0 +! wall_0 = wall_1 +! allocate(two_e_tmp_3(mo_num, n_j, n_k), & +! two_e_tmp_1(mo_num), & +! two_e_tmp_0(ao_num,ao_num), & +! two_e_tmp_0_idx(ao_num), & +! two_e_tmp_2(mo_num, n_j), & +! buffer_i(size_buffer), & +! buffer_value(size_buffer) ) +! +! thread_num = 0 +! !$ thread_num = omp_get_thread_num() +! !$OMP DO SCHEDULE(guided) +! do l1 = 1,ao_num +! two_e_tmp_3 = 0.d0 +! do k1 = 1,ao_num +! two_e_tmp_2 = 0.d0 +! do j1 = 1,ao_num +! call get_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1)) +! ! call compute_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1)) +! enddo +! do j1 = 1,ao_num +! kmax = 0 +! do i1 = 1,ao_num +! c = two_e_tmp_0(i1,j1) +! if (c == 0.d0) then +! cycle +! endif +! kmax += 1 +! two_e_tmp_0(kmax,j1) = c +! two_e_tmp_0_idx(kmax) = i1 +! enddo +! +! if (kmax==0) then +! cycle +! endif +! +! two_e_tmp_1 = 0.d0 +! ii1=1 +! do ii1 = 1,kmax-4,4 +! i1 = two_e_tmp_0_idx(ii1) +! i2 = two_e_tmp_0_idx(ii1+1) +! i3 = two_e_tmp_0_idx(ii1+2) +! i4 = two_e_tmp_0_idx(ii1+3) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + & +! mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) + & +! mo_coef_transp(i,i2) * two_e_tmp_0(ii1+1,j1) + & +! mo_coef_transp(i,i3) * two_e_tmp_0(ii1+2,j1) + & +! mo_coef_transp(i,i4) * two_e_tmp_0(ii1+3,j1) +! enddo ! i +! enddo ! ii1 +! +! i2 = ii1 +! do ii1 = i2,kmax +! i1 = two_e_tmp_0_idx(ii1) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) +! enddo ! i +! enddo ! ii1 +! c = 0.d0 +! +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! c = max(c,abs(two_e_tmp_1(i))) +! if (c>mo_integrals_threshold) exit +! enddo +! if ( c < mo_integrals_threshold ) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! c = mo_coef_transp(j,j1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_2(i,j0) = two_e_tmp_2(i,j0) + c * two_e_tmp_1(i) +! enddo ! i +! enddo ! j +! enddo !j1 +! if ( maxval(abs(two_e_tmp_2)) < mo_integrals_threshold ) then +! cycle +! endif +! +! +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! c = mo_coef_transp(k,k1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! do i = list_ijkl(1,1), k +! two_e_tmp_3(i,j0,k0) = two_e_tmp_3(i,j0,k0) + c* two_e_tmp_2(i,j0) +! enddo!i +! enddo !j +! +! enddo !k +! enddo !k1 +! +! +! +! do l0 = 1,n_l +! l = list_ijkl(l0,4) +! c = mo_coef_transp(l,l1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! j1 = shiftr((l*l-l),1) +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! if (j > l) then +! exit +! endif +! j1 += 1 +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! i1 = shiftr((k*k-k),1) +! if (i1<=j1) then +! continue +! else +! exit +! endif +! two_e_tmp_1 = 0.d0 +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if (i>k) then +! exit +! endif +! two_e_tmp_1(i) = c*two_e_tmp_3(i,j0,k0) +! ! i1+=1 +! enddo +! +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if(i> min(k,j1-i1+list_ijkl(1,1)-1))then +! exit +! endif +! if (abs(two_e_tmp_1(i)) < mo_integrals_threshold) then +! cycle +! endif +! n_integrals += 1 +! buffer_value(n_integrals) = two_e_tmp_1(i) +! !DIR$ FORCEINLINE +! call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) +! if (n_integrals == size_buffer) then +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! n_integrals = 0 +! endif +! enddo +! enddo +! enddo +! enddo +! +! call wall_time(wall_2) +! if (thread_num == 0) then +! if (wall_2 - wall_0 > 1.d0) then +! wall_0 = wall_2 +! print*, 100.*float(l1)/float(ao_num), '% in ', & +! wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB' +! endif +! endif +! enddo +! !$OMP END DO NOWAIT +! deallocate (two_e_tmp_1,two_e_tmp_2,two_e_tmp_3) +! +! integer :: index_needed +! +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! deallocate(buffer_i, buffer_value) +! !$OMP END PARALLEL +! call map_merge(mo_integrals_map) +! +! call wall_time(wall_2) +! call cpu_time(cpu_2) +! integer*8 :: get_mo_map_size, mo_map_size +! mo_map_size = get_mo_map_size() +! +! deallocate(list_ijkl) + + +end + + +subroutine add_integrals_to_map_three_indices_complex(mask_ijk) + use map_module + use bitmasks + implicit none + + BEGIN_DOC + ! Adds integrals to tha MO map according to some bitmask + END_DOC + + integer(bit_kind), intent(in) :: mask_ijk(N_int,3) + + integer :: i,j,k,l + integer :: i0,j0,k0,l0 + double precision :: c, cpu_1, cpu_2, wall_1, wall_2, wall_0 + + integer, allocatable :: list_ijkl(:,:) + integer :: n_i, n_j, n_k + integer :: m + integer, allocatable :: two_e_tmp_0_idx(:) + real(integral_kind), allocatable :: two_e_tmp_0(:,:) + double precision, allocatable :: two_e_tmp_1(:) + double precision, allocatable :: two_e_tmp_2(:,:) + double precision, allocatable :: two_e_tmp_3(:,:,:) + !DIR$ ATTRIBUTES ALIGN : 64 :: two_e_tmp_1, two_e_tmp_2, two_e_tmp_3 + + integer :: n_integrals + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i(:) + real(integral_kind),allocatable :: buffer_value(:) + double precision :: map_mb + + integer :: i1,j1,k1,l1, ii1, kmax, thread_num + integer :: i2,i3,i4 + double precision,parameter :: thr_coef = 1.d-10 + + print*,'not implemented for complex',irp_here + stop -1 +! PROVIDE ao_two_e_integrals_in_map mo_coef +! +! !Get list of MOs for i,j,k and l +! !------------------------------- +! +! allocate(list_ijkl(mo_num,4)) +! call bitstring_to_list( mask_ijk(1,1), list_ijkl(1,1), n_i, N_int ) +! call bitstring_to_list( mask_ijk(1,2), list_ijkl(1,2), n_j, N_int ) +! call bitstring_to_list( mask_ijk(1,3), list_ijkl(1,3), n_k, N_int ) +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijk(i,1)) +! enddo +! if(j==0)then +! return +! endif +! +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijk(i,2)) +! enddo +! if(j==0)then +! return +! endif +! +! j = 0 +! do i = 1, N_int +! j += popcnt(mask_ijk(i,3)) +! enddo +! if(j==0)then +! return +! endif +! +! size_buffer = min(ao_num*ao_num*ao_num,16000000) +! print*, 'Providing the molecular integrals ' +! print*, 'Buffers : ', 8.*(mo_num*(n_j)*(n_k+1) + mo_num+& +! ao_num+ao_num*ao_num+ size_buffer*3)/(1024*1024), 'MB / core' +! +! call wall_time(wall_1) +! call cpu_time(cpu_1) +! double precision :: accu_bis +! accu_bis = 0.d0 +! !$OMP PARALLEL PRIVATE(m,l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, & +! !$OMP two_e_tmp_0_idx, two_e_tmp_0, two_e_tmp_1,two_e_tmp_2,two_e_tmp_3,& +! !$OMP buffer_i,buffer_value,n_integrals,wall_2,i0,j0,k0,l0, & +! !$OMP wall_0,thread_num,accu_bis) & +! !$OMP DEFAULT(NONE) & +! !$OMP SHARED(size_buffer,ao_num,mo_num,n_i,n_j,n_k, & +! !$OMP mo_coef_transp, & +! !$OMP mo_coef_transp_is_built, list_ijkl, & +! !$OMP mo_coef_is_built, wall_1, & +! !$OMP mo_coef,mo_integrals_threshold,mo_integrals_map) +! n_integrals = 0 +! wall_0 = wall_1 +! allocate(two_e_tmp_3(mo_num, n_j, n_k), & +! two_e_tmp_1(mo_num), & +! two_e_tmp_0(ao_num,ao_num), & +! two_e_tmp_0_idx(ao_num), & +! two_e_tmp_2(mo_num, n_j), & +! buffer_i(size_buffer), & +! buffer_value(size_buffer) ) +! +! thread_num = 0 +! !$ thread_num = omp_get_thread_num() +! !$OMP DO SCHEDULE(guided) +! do l1 = 1,ao_num +! two_e_tmp_3 = 0.d0 +! do k1 = 1,ao_num +! two_e_tmp_2 = 0.d0 +! do j1 = 1,ao_num +! call get_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1)) +! enddo +! do j1 = 1,ao_num +! kmax = 0 +! do i1 = 1,ao_num +! c = two_e_tmp_0(i1,j1) +! if (c == 0.d0) then +! cycle +! endif +! kmax += 1 +! two_e_tmp_0(kmax,j1) = c +! two_e_tmp_0_idx(kmax) = i1 +! enddo +! +! if (kmax==0) then +! cycle +! endif +! +! two_e_tmp_1 = 0.d0 +! ii1=1 +! do ii1 = 1,kmax-4,4 +! i1 = two_e_tmp_0_idx(ii1) +! i2 = two_e_tmp_0_idx(ii1+1) +! i3 = two_e_tmp_0_idx(ii1+2) +! i4 = two_e_tmp_0_idx(ii1+3) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + & +! mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) + & +! mo_coef_transp(i,i2) * two_e_tmp_0(ii1+1,j1) + & +! mo_coef_transp(i,i3) * two_e_tmp_0(ii1+2,j1) + & +! mo_coef_transp(i,i4) * two_e_tmp_0(ii1+3,j1) +! enddo ! i +! enddo ! ii1 +! +! i2 = ii1 +! do ii1 = i2,kmax +! i1 = two_e_tmp_0_idx(ii1) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) +! enddo ! i +! enddo ! ii1 +! c = 0.d0 +! +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! c = max(c,abs(two_e_tmp_1(i))) +! if (c>mo_integrals_threshold) exit +! enddo +! if ( c < mo_integrals_threshold ) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! c = mo_coef_transp(j,j1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_2(i,j0) = two_e_tmp_2(i,j0) + c * two_e_tmp_1(i) +! enddo ! i +! enddo ! j +! enddo !j1 +! if ( maxval(abs(two_e_tmp_2)) < mo_integrals_threshold ) then +! cycle +! endif +! +! +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! c = mo_coef_transp(k,k1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! do i = list_ijkl(1,1), k +! two_e_tmp_3(i,j0,k0) = two_e_tmp_3(i,j0,k0) + c* two_e_tmp_2(i,j0) +! enddo!i +! enddo !j +! +! enddo !k +! enddo !k1 +! +! +! +! do l0 = 1,n_j +! l = list_ijkl(l0,2) +! c = mo_coef_transp(l,l1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! i1 = shiftr((k*k-k),1) +! two_e_tmp_1 = 0.d0 +! j0 = l0 +! j = list_ijkl(j0,2) +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if (i>k) then +! exit +! endif +! two_e_tmp_1(i) = c*two_e_tmp_3(i,j0,k0) +! enddo +! +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if (i>k) then !min(k,j1-i1) +! exit +! endif +! if (abs(two_e_tmp_1(i)) < mo_integrals_threshold) then +! cycle +! endif +! n_integrals += 1 +! buffer_value(n_integrals) = two_e_tmp_1(i) +! if(i==k .and. j==l .and. i.ne.j)then +! buffer_value(n_integrals) = buffer_value(n_integrals) *0.5d0 +! endif +! !DIR$ FORCEINLINE +! call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) +! if (n_integrals == size_buffer) then +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! n_integrals = 0 +! endif +! enddo +! enddo +! enddo +! +! do l0 = 1,n_j +! l = list_ijkl(l0,2) +! c = mo_coef_transp(l,l1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! i1 = shiftr((k*k-k),1) +! two_e_tmp_1 = 0.d0 +! j0 = k0 +! j = list_ijkl(k0,2) +! i0 = l0 +! i = list_ijkl(i0,2) +! if (k==l) then +! cycle +! endif +! two_e_tmp_1(i) = c*two_e_tmp_3(i,j0,k0) +! +! n_integrals += 1 +! buffer_value(n_integrals) = two_e_tmp_1(i) +! !DIR$ FORCEINLINE +! call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) +! if (n_integrals == size_buffer) then +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! n_integrals = 0 +! endif +! enddo +! enddo +! +! call wall_time(wall_2) +! if (thread_num == 0) then +! if (wall_2 - wall_0 > 1.d0) then +! wall_0 = wall_2 +! print*, 100.*float(l1)/float(ao_num), '% in ', & +! wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB' +! endif +! endif +! enddo +! !$OMP END DO NOWAIT +! deallocate (two_e_tmp_1,two_e_tmp_2,two_e_tmp_3) +! +! integer :: index_needed +! +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! deallocate(buffer_i, buffer_value) +! !$OMP END PARALLEL +! call map_merge(mo_integrals_map) +! +! call wall_time(wall_2) +! call cpu_time(cpu_2) +! integer*8 :: get_mo_map_size, mo_map_size +! mo_map_size = get_mo_map_size() +! +! deallocate(list_ijkl) +! +! +! print*,'Molecular integrals provided:' +! print*,' Size of MO map ', map_mb(mo_integrals_map) ,'MB' +! print*,' Number of MO integrals: ', mo_map_size +! print*,' cpu time :',cpu_2 - cpu_1, 's' +! print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end + + +subroutine add_integrals_to_map_no_exit_34_complex(mask_ijkl) + use map_module + use bitmasks + implicit none + + BEGIN_DOC + ! Adds integrals to tha MO map according to some bitmask + END_DOC + + integer(bit_kind), intent(in) :: mask_ijkl(N_int,4) + + integer :: i,j,k,l + integer :: i0,j0,k0,l0 + double precision :: c, cpu_1, cpu_2, wall_1, wall_2, wall_0 + + integer, allocatable :: list_ijkl(:,:) + integer :: n_i, n_j, n_k, n_l + integer, allocatable :: two_e_tmp_0_idx(:) + real(integral_kind), allocatable :: two_e_tmp_0(:,:) + double precision, allocatable :: two_e_tmp_1(:) + double precision, allocatable :: two_e_tmp_2(:,:) + double precision, allocatable :: two_e_tmp_3(:,:,:) + !DIR$ ATTRIBUTES ALIGN : 64 :: two_e_tmp_1, two_e_tmp_2, two_e_tmp_3 + + integer :: n_integrals + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i(:) + real(integral_kind),allocatable :: buffer_value(:) + double precision :: map_mb + + integer :: i1,j1,k1,l1, ii1, kmax, thread_num + integer :: i2,i3,i4 + double precision,parameter :: thr_coef = 1.d-10 + + print*,'not implemented for complex',irp_here + stop -1 +! PROVIDE ao_two_e_integrals_in_map mo_coef +! +! !Get list of MOs for i,j,k and l +! !------------------------------- +! +! allocate(list_ijkl(mo_num,4)) +! call bitstring_to_list( mask_ijkl(1,1), list_ijkl(1,1), n_i, N_int ) +! call bitstring_to_list( mask_ijkl(1,2), list_ijkl(1,2), n_j, N_int ) +! call bitstring_to_list( mask_ijkl(1,3), list_ijkl(1,3), n_k, N_int ) +! call bitstring_to_list( mask_ijkl(1,4), list_ijkl(1,4), n_l, N_int ) +! +! size_buffer = min(ao_num*ao_num*ao_num,16000000) +! print*, 'Providing the molecular integrals ' +! print*, 'Buffers : ', 8.*(mo_num*(n_j)*(n_k+1) + mo_num+& +! ao_num+ao_num*ao_num+ size_buffer*3)/(1024*1024), 'MB / core' +! +! call wall_time(wall_1) +! call cpu_time(cpu_1) +! +! !$OMP PARALLEL PRIVATE(l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, & +! !$OMP two_e_tmp_0_idx, two_e_tmp_0, two_e_tmp_1,two_e_tmp_2,two_e_tmp_3,& +! !$OMP buffer_i,buffer_value,n_integrals,wall_2,i0,j0,k0,l0, & +! !$OMP wall_0,thread_num) & +! !$OMP DEFAULT(NONE) & +! !$OMP SHARED(size_buffer,ao_num,mo_num,n_i,n_j,n_k,n_l, & +! !$OMP mo_coef_transp, & +! !$OMP mo_coef_transp_is_built, list_ijkl, & +! !$OMP mo_coef_is_built, wall_1, & +! !$OMP mo_coef,mo_integrals_threshold,mo_integrals_map) +! n_integrals = 0 +! wall_0 = wall_1 +! allocate(two_e_tmp_3(mo_num, n_j, n_k), & +! two_e_tmp_1(mo_num), & +! two_e_tmp_0(ao_num,ao_num), & +! two_e_tmp_0_idx(ao_num), & +! two_e_tmp_2(mo_num, n_j), & +! buffer_i(size_buffer), & +! buffer_value(size_buffer) ) +! +! thread_num = 0 +! !$ thread_num = omp_get_thread_num() +! !$OMP DO SCHEDULE(guided) +! do l1 = 1,ao_num +! !IRP_IF COARRAY +! ! if (mod(l1-this_image(),num_images()) /= 0 ) then +! ! cycle +! ! endif +! !IRP_ENDIF +! two_e_tmp_3 = 0.d0 +! do k1 = 1,ao_num +! two_e_tmp_2 = 0.d0 +! do j1 = 1,ao_num +! call get_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1)) +! ! call compute_ao_two_e_integrals(j1,k1,l1,ao_num,two_e_tmp_0(1,j1)) +! enddo +! do j1 = 1,ao_num +! kmax = 0 +! do i1 = 1,ao_num +! c = two_e_tmp_0(i1,j1) +! if (c == 0.d0) then +! cycle +! endif +! kmax += 1 +! two_e_tmp_0(kmax,j1) = c +! two_e_tmp_0_idx(kmax) = i1 +! enddo +! +! if (kmax==0) then +! cycle +! endif +! +! two_e_tmp_1 = 0.d0 +! ii1=1 +! do ii1 = 1,kmax-4,4 +! i1 = two_e_tmp_0_idx(ii1) +! i2 = two_e_tmp_0_idx(ii1+1) +! i3 = two_e_tmp_0_idx(ii1+2) +! i4 = two_e_tmp_0_idx(ii1+3) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + & +! mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) + & +! mo_coef_transp(i,i2) * two_e_tmp_0(ii1+1,j1) + & +! mo_coef_transp(i,i3) * two_e_tmp_0(ii1+2,j1) + & +! mo_coef_transp(i,i4) * two_e_tmp_0(ii1+3,j1) +! enddo ! i +! enddo ! ii1 +! +! i2 = ii1 +! do ii1 = i2,kmax +! i1 = two_e_tmp_0_idx(ii1) +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_1(i) = two_e_tmp_1(i) + mo_coef_transp(i,i1) * two_e_tmp_0(ii1,j1) +! enddo ! i +! enddo ! ii1 +! c = 0.d0 +! +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! c = max(c,abs(two_e_tmp_1(i))) +! if (c>mo_integrals_threshold) exit +! enddo +! if ( c < mo_integrals_threshold ) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! c = mo_coef_transp(j,j1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! do i = list_ijkl(1,1), list_ijkl(n_i,1) +! two_e_tmp_2(i,j0) = two_e_tmp_2(i,j0) + c * two_e_tmp_1(i) +! enddo ! i +! enddo ! j +! enddo !j1 +! if ( maxval(abs(two_e_tmp_2)) < mo_integrals_threshold ) then +! cycle +! endif +! +! +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! c = mo_coef_transp(k,k1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! do i = list_ijkl(1,1), k +! two_e_tmp_3(i,j0,k0) = two_e_tmp_3(i,j0,k0) + c* two_e_tmp_2(i,j0) +! enddo!i +! enddo !j +! +! enddo !k +! enddo !k1 +! +! +! +! do l0 = 1,n_l +! l = list_ijkl(l0,4) +! c = mo_coef_transp(l,l1) +! if (abs(c) < thr_coef) then +! cycle +! endif +! j1 = shiftr((l*l-l),1) +! do j0 = 1, n_j +! j = list_ijkl(j0,2) +! if (j > l) then +! exit +! endif +! j1 += 1 +! do k0 = 1, n_k +! k = list_ijkl(k0,3) +! i1 = shiftr((k*k-k),1) +! two_e_tmp_1 = 0.d0 +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if (i>k) then +! exit +! endif +! two_e_tmp_1(i) = c*two_e_tmp_3(i,j0,k0) +! enddo +! +! do i0 = 1, n_i +! i = list_ijkl(i0,1) +! if(i> k)then +! exit +! endif +! +! if (abs(two_e_tmp_1(i)) < mo_integrals_threshold) then +! cycle +! endif +! n_integrals += 1 +! buffer_value(n_integrals) = two_e_tmp_1(i) +! !DIR$ FORCEINLINE +! call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) +! if (n_integrals == size_buffer) then +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! n_integrals = 0 +! endif +! enddo +! enddo +! enddo +! enddo +! +! call wall_time(wall_2) +! if (thread_num == 0) then +! if (wall_2 - wall_0 > 1.d0) then +! wall_0 = wall_2 +! print*, 100.*float(l1)/float(ao_num), '% in ', & +! wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB' +! endif +! endif +! enddo +! !$OMP END DO NOWAIT +! deallocate (two_e_tmp_1,two_e_tmp_2,two_e_tmp_3) +! +! call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_value,& +! real(mo_integrals_threshold,integral_kind)) +! deallocate(buffer_i, buffer_value) +! !$OMP END PARALLEL +! !IRP_IF COARRAY +! ! print*, 'Communicating the map' +! ! call communicate_mo_integrals() +! !IRP_ENDIF +! call map_merge(mo_integrals_map) +! +! call wall_time(wall_2) +! call cpu_time(cpu_2) +! integer*8 :: get_mo_map_size, mo_map_size +! mo_map_size = get_mo_map_size() +! +! deallocate(list_ijkl) +! +! +! print*,'Molecular integrals provided:' +! print*,' Size of MO map ', map_mb(mo_integrals_map) ,'MB' +! print*,' Number of MO integrals: ', mo_map_size +! print*,' cpu time :',cpu_2 - cpu_1, 's' +! print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + + +end + + + +! BEGIN_PROVIDER [ double precision, mo_two_e_integral_jj_from_ao, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_exchange_from_ao, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_anti_from_ao, (mo_num,mo_num) ] +! implicit none +! BEGIN_DOC +! ! mo_two_e_integral_jj_from_ao(i,j) = J_ij +! ! mo_two_e_integrals_jj_exchange_from_ao(i,j) = J_ij +! ! mo_two_e_integrals_jj_anti_from_ao(i,j) = J_ij - K_ij +! END_DOC +! +! integer :: i,j,p,q,r,s +! double precision :: c +! real(integral_kind) :: integral +! integer :: n, pp +! real(integral_kind), allocatable :: int_value(:) +! integer, allocatable :: int_idx(:) +! +! double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) +! +! if (.not.do_direct_integrals) then +! PROVIDE ao_two_e_integrals_in_map mo_coef +! endif +! +! mo_two_e_integral_jj_from_ao = 0.d0 +! mo_two_e_integrals_jj_exchange_from_ao = 0.d0 +! +! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs, iqsr +! +! +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE (i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, & +! !$OMP iqrs, iqsr,iqri,iqis) & +! !$OMP SHARED(mo_num,mo_coef_transp,ao_num, & +! !$OMP ao_integrals_threshold,do_direct_integrals) & +! !$OMP REDUCTION(+:mo_two_e_integral_jj_from_ao,mo_two_e_integrals_jj_exchange_from_ao) +! +! allocate( int_value(ao_num), int_idx(ao_num), & +! iqrs(mo_num,ao_num), iqis(mo_num), iqri(mo_num), & +! iqsr(mo_num,ao_num) ) +! +! !$OMP DO SCHEDULE (guided) +! do s=1,ao_num +! do q=1,ao_num +! +! do j=1,ao_num +! do i=1,mo_num +! iqrs(i,j) = 0.d0 +! iqsr(i,j) = 0.d0 +! enddo +! enddo +! +! if (do_direct_integrals) then +! double precision :: ao_two_e_integral +! do r=1,ao_num +! call compute_ao_two_e_integrals(q,r,s,ao_num,int_value) +! do p=1,ao_num +! integral = int_value(p) +! if (abs(integral) > ao_integrals_threshold) then +! do i=1,mo_num +! iqrs(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! call compute_ao_two_e_integrals(q,s,r,ao_num,int_value) +! do p=1,ao_num +! integral = int_value(p) +! if (abs(integral) > ao_integrals_threshold) then +! do i=1,mo_num +! iqsr(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! enddo +! +! else +! +! do r=1,ao_num +! call get_ao_two_e_integrals_non_zero(q,r,s,ao_num,int_value,int_idx,n) +! do pp=1,n +! p = int_idx(pp) +! integral = int_value(pp) +! if (abs(integral) > ao_integrals_threshold) then +! do i=1,mo_num +! iqrs(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! call get_ao_two_e_integrals_non_zero(q,s,r,ao_num,int_value,int_idx,n) +! do pp=1,n +! p = int_idx(pp) +! integral = int_value(pp) +! if (abs(integral) > ao_integrals_threshold) then +! do i=1,mo_num +! iqsr(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! enddo +! endif +! iqis = 0.d0 +! iqri = 0.d0 +! do r=1,ao_num +! do i=1,mo_num +! iqis(i) += mo_coef_transp(i,r) * iqrs(i,r) +! iqri(i) += mo_coef_transp(i,r) * iqsr(i,r) +! enddo +! enddo +! do i=1,mo_num +! do j=1,mo_num +! c = mo_coef_transp(j,q)*mo_coef_transp(j,s) +! mo_two_e_integral_jj_from_ao(j,i) += c * iqis(i) +! mo_two_e_integrals_jj_exchange_from_ao(j,i) += c * iqri(i) +! enddo +! enddo +! +! enddo +! enddo +! !$OMP END DO NOWAIT +! deallocate(iqrs,iqsr,int_value,int_idx) +! !$OMP END PARALLEL +! +! mo_two_e_integrals_jj_anti_from_ao = mo_two_e_integral_jj_from_ao - mo_two_e_integrals_jj_exchange_from_ao +! +! +!END_PROVIDER +! +! BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_from_ao, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_exchange_from_ao, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_anti_from_ao, (mo_num,mo_num) ] +! implicit none +! BEGIN_DOC +! ! mo_two_e_integrals_vv_from_ao(i,j) = J_ij +! ! mo_two_e_integrals_vv_exchange_from_ao(i,j) = J_ij +! ! mo_two_e_integrals_vv_anti_from_ao(i,j) = J_ij - K_ij +! ! but only for the virtual orbitals +! END_DOC +! +! integer :: i,j,p,q,r,s +! integer :: i0,j0 +! double precision :: c +! real(integral_kind) :: integral +! integer :: n, pp +! real(integral_kind), allocatable :: int_value(:) +! integer, allocatable :: int_idx(:) +! +! double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) +! +! if (.not.do_direct_integrals) then +! PROVIDE ao_two_e_integrals_in_map mo_coef +! endif +! +! mo_two_e_integrals_vv_from_ao = 0.d0 +! mo_two_e_integrals_vv_exchange_from_ao = 0.d0 +! +! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs, iqsr +! +! +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE (i0,j0,i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, & +! !$OMP iqrs, iqsr,iqri,iqis) & +! !$OMP SHARED(n_virt_orb,mo_num,list_virt,mo_coef_transp,ao_num, & +! !$OMP ao_integrals_threshold,do_direct_integrals) & +! !$OMP REDUCTION(+:mo_two_e_integrals_vv_from_ao,mo_two_e_integrals_vv_exchange_from_ao) +! +! allocate( int_value(ao_num), int_idx(ao_num), & +! iqrs(mo_num,ao_num), iqis(mo_num), iqri(mo_num),& +! iqsr(mo_num,ao_num) ) +! +! !$OMP DO SCHEDULE (guided) +! do s=1,ao_num +! do q=1,ao_num +! +! do j=1,ao_num +! do i0=1,n_virt_orb +! i = list_virt(i0) +! iqrs(i,j) = 0.d0 +! iqsr(i,j) = 0.d0 +! enddo +! enddo +! +! if (do_direct_integrals) then +! double precision :: ao_two_e_integral +! do r=1,ao_num +! call compute_ao_two_e_integrals(q,r,s,ao_num,int_value) +! do p=1,ao_num +! integral = int_value(p) +! if (abs(integral) > ao_integrals_threshold) then +! do i0=1,n_virt_orb +! i = list_virt(i0) +! iqrs(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! call compute_ao_two_e_integrals(q,s,r,ao_num,int_value) +! do p=1,ao_num +! integral = int_value(p) +! if (abs(integral) > ao_integrals_threshold) then +! do i0=1,n_virt_orb +! i =list_virt(i0) +! iqsr(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! enddo +! +! else +! +! do r=1,ao_num +! call get_ao_two_e_integrals_non_zero(q,r,s,ao_num,int_value,int_idx,n) +! do pp=1,n +! p = int_idx(pp) +! integral = int_value(pp) +! if (abs(integral) > ao_integrals_threshold) then +! do i0=1,n_virt_orb +! i =list_virt(i0) +! iqrs(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! call get_ao_two_e_integrals_non_zero(q,s,r,ao_num,int_value,int_idx,n) +! do pp=1,n +! p = int_idx(pp) +! integral = int_value(pp) +! if (abs(integral) > ao_integrals_threshold) then +! do i0=1,n_virt_orb +! i = list_virt(i0) +! iqsr(i,r) += mo_coef_transp(i,p) * integral +! enddo +! endif +! enddo +! enddo +! endif +! iqis = 0.d0 +! iqri = 0.d0 +! do r=1,ao_num +! do i0=1,n_virt_orb +! i = list_virt(i0) +! iqis(i) += mo_coef_transp(i,r) * iqrs(i,r) +! iqri(i) += mo_coef_transp(i,r) * iqsr(i,r) +! enddo +! enddo +! do i0=1,n_virt_orb +! i= list_virt(i0) +! do j0=1,n_virt_orb +! j = list_virt(j0) +! c = mo_coef_transp(j,q)*mo_coef_transp(j,s) +! mo_two_e_integrals_vv_from_ao(j,i) += c * iqis(i) +! mo_two_e_integrals_vv_exchange_from_ao(j,i) += c * iqri(i) +! enddo +! enddo +! +! enddo +! enddo +! !$OMP END DO NOWAIT +! deallocate(iqrs,iqsr,int_value,int_idx) +! !$OMP END PARALLEL +! +! mo_two_e_integrals_vv_anti_from_ao = mo_two_e_integrals_vv_from_ao - mo_two_e_integrals_vv_exchange_from_ao +! ! print*, '**********' +! ! do i0 =1, n_virt_orb +! ! i = list_virt(i0) +! ! print*, mo_two_e_integrals_vv_from_ao(i,i) +! ! enddo +! ! print*, '**********' +! +! +!END_PROVIDER +! +! +! BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_exchange, (mo_num,mo_num) ] +!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_anti, (mo_num,mo_num) ] +! implicit none +! BEGIN_DOC +! ! mo_two_e_integrals_jj(i,j) = J_ij +! ! mo_two_e_integrals_jj_exchange(i,j) = K_ij +! ! mo_two_e_integrals_jj_anti(i,j) = J_ij - K_ij +! END_DOC +! +! integer :: i,j +! double precision :: get_two_e_integral +! +! PROVIDE mo_two_e_integrals_in_map +! mo_two_e_integrals_jj = 0.d0 +! mo_two_e_integrals_jj_exchange = 0.d0 +! +! do j=1,mo_num +! do i=1,mo_num +! mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map) +! mo_two_e_integrals_jj_exchange(i,j) = get_two_e_integral(i,j,j,i,mo_integrals_map) +! mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j) +! enddo +! enddo +! +!END_PROVIDER +! +! +!subroutine clear_mo_map +! implicit none +! BEGIN_DOC +! ! Frees the memory of the MO map +! END_DOC +! call map_deinit(mo_integrals_map) +! FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti +! FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map +!end +! From a64be709119675904d2d9a0d1fab59e0a6b009c4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 6 Feb 2020 11:59:03 -0600 Subject: [PATCH 061/256] complex core quantities --- src/mo_two_e_ints/core_quantities.irp.f | 33 +++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f index 1cc50cb1..349b0cd1 100644 --- a/src/mo_two_e_ints/core_quantities.irp.f +++ b/src/mo_two_e_ints/core_quantities.irp.f @@ -5,6 +5,16 @@ BEGIN_PROVIDER [double precision, core_energy] END_DOC integer :: i,j,k,l core_energy = 0.d0 + if (is_periodic) then + do i = 1, n_core_orb + j = list_core(i) + core_energy += 2.d0 * dble(mo_one_e_integrals_complex(j,j)) + mo_two_e_integrals_jj(j,j) + do k = i+1, n_core_orb + l = list_core(k) + core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) + enddo + enddo + else do i = 1, n_core_orb j = list_core(i) core_energy += 2.d0 * mo_one_e_integrals(j,j) + mo_two_e_integrals_jj(j,j) @@ -13,6 +23,7 @@ BEGIN_PROVIDER [double precision, core_energy] core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) enddo enddo + endif core_energy += nuclear_repulsion END_PROVIDER @@ -36,3 +47,25 @@ BEGIN_PROVIDER [double precision, core_fock_operator, (mo_num,mo_num)] enddo enddo END_PROVIDER + +BEGIN_PROVIDER [complex*16, core_fock_operator_complex, (mo_num,mo_num)] + implicit none + integer :: i,j,k,l,m,n + complex*16 :: get_two_e_integral_periodic + BEGIN_DOC +! this is the contribution to the Fock operator from the core electrons + END_DOC + core_fock_operator_complex = (0.d0,0.d0) + do i = 1, n_act_orb + j = list_act(i) + do k = 1, n_act_orb + l = list_act(k) + do m = 1, n_core_orb + n = list_core(m) + core_fock_operator_complex(j,l) += 2.d0 * & + get_two_e_integral_periodic(j,n,l,n,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_periodic(j,n,n,l,mo_integrals_map,mo_integrals_map_2) + enddo + enddo + enddo +END_PROVIDER From df2295206fa8f921baaa931cf9c0b66ed830d5c3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 6 Feb 2020 13:59:02 -0600 Subject: [PATCH 062/256] cleaning up 2e ints; added placeholders for missing periodic functions --- src/ao_two_e_ints/map_integrals_complex.irp.f | 16 +- .../mo_bi_integrals_complex.irp.f | 310 ------------------ src/utils_periodic/qp2-pbc-diff.txt | 34 +- 3 files changed, 36 insertions(+), 324 deletions(-) diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f index 611bc4cb..3359d535 100644 --- a/src/ao_two_e_ints/map_integrals_complex.irp.f +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -424,7 +424,9 @@ subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_in end -!subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) + print*,'not implemented for periodic',irp_here + stop -1 ! use map_module ! implicit none ! BEGIN_DOC @@ -469,11 +471,13 @@ end ! out_val(non_zero_int) = tmp ! enddo ! enddo -! -!end + +end -!subroutine get_ao_two_e_integrals_non_zero_jl_from_list_periodic(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_jl_from_list_periodic(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) + print*,'not implemented for periodic',irp_here + stop -1 ! use map_module ! implicit none ! BEGIN_DOC @@ -520,8 +524,8 @@ end ! out_val_index(2,non_zero_int) = k ! out_val(non_zero_int) = tmp ! enddo -! -!end + +end subroutine insert_into_ao_integrals_map_2(n_integrals,buffer_i, buffer_values) use map_module diff --git a/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f b/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f index 8d1dd9f0..632ff591 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f @@ -851,313 +851,3 @@ subroutine add_integrals_to_map_no_exit_34_complex(mask_ijkl) end - - - -! BEGIN_PROVIDER [ double precision, mo_two_e_integral_jj_from_ao, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_exchange_from_ao, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_anti_from_ao, (mo_num,mo_num) ] -! implicit none -! BEGIN_DOC -! ! mo_two_e_integral_jj_from_ao(i,j) = J_ij -! ! mo_two_e_integrals_jj_exchange_from_ao(i,j) = J_ij -! ! mo_two_e_integrals_jj_anti_from_ao(i,j) = J_ij - K_ij -! END_DOC -! -! integer :: i,j,p,q,r,s -! double precision :: c -! real(integral_kind) :: integral -! integer :: n, pp -! real(integral_kind), allocatable :: int_value(:) -! integer, allocatable :: int_idx(:) -! -! double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) -! -! if (.not.do_direct_integrals) then -! PROVIDE ao_two_e_integrals_in_map mo_coef -! endif -! -! mo_two_e_integral_jj_from_ao = 0.d0 -! mo_two_e_integrals_jj_exchange_from_ao = 0.d0 -! -! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs, iqsr -! -! -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE (i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, & -! !$OMP iqrs, iqsr,iqri,iqis) & -! !$OMP SHARED(mo_num,mo_coef_transp,ao_num, & -! !$OMP ao_integrals_threshold,do_direct_integrals) & -! !$OMP REDUCTION(+:mo_two_e_integral_jj_from_ao,mo_two_e_integrals_jj_exchange_from_ao) -! -! allocate( int_value(ao_num), int_idx(ao_num), & -! iqrs(mo_num,ao_num), iqis(mo_num), iqri(mo_num), & -! iqsr(mo_num,ao_num) ) -! -! !$OMP DO SCHEDULE (guided) -! do s=1,ao_num -! do q=1,ao_num -! -! do j=1,ao_num -! do i=1,mo_num -! iqrs(i,j) = 0.d0 -! iqsr(i,j) = 0.d0 -! enddo -! enddo -! -! if (do_direct_integrals) then -! double precision :: ao_two_e_integral -! do r=1,ao_num -! call compute_ao_two_e_integrals(q,r,s,ao_num,int_value) -! do p=1,ao_num -! integral = int_value(p) -! if (abs(integral) > ao_integrals_threshold) then -! do i=1,mo_num -! iqrs(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! call compute_ao_two_e_integrals(q,s,r,ao_num,int_value) -! do p=1,ao_num -! integral = int_value(p) -! if (abs(integral) > ao_integrals_threshold) then -! do i=1,mo_num -! iqsr(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! enddo -! -! else -! -! do r=1,ao_num -! call get_ao_two_e_integrals_non_zero(q,r,s,ao_num,int_value,int_idx,n) -! do pp=1,n -! p = int_idx(pp) -! integral = int_value(pp) -! if (abs(integral) > ao_integrals_threshold) then -! do i=1,mo_num -! iqrs(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! call get_ao_two_e_integrals_non_zero(q,s,r,ao_num,int_value,int_idx,n) -! do pp=1,n -! p = int_idx(pp) -! integral = int_value(pp) -! if (abs(integral) > ao_integrals_threshold) then -! do i=1,mo_num -! iqsr(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! enddo -! endif -! iqis = 0.d0 -! iqri = 0.d0 -! do r=1,ao_num -! do i=1,mo_num -! iqis(i) += mo_coef_transp(i,r) * iqrs(i,r) -! iqri(i) += mo_coef_transp(i,r) * iqsr(i,r) -! enddo -! enddo -! do i=1,mo_num -! do j=1,mo_num -! c = mo_coef_transp(j,q)*mo_coef_transp(j,s) -! mo_two_e_integral_jj_from_ao(j,i) += c * iqis(i) -! mo_two_e_integrals_jj_exchange_from_ao(j,i) += c * iqri(i) -! enddo -! enddo -! -! enddo -! enddo -! !$OMP END DO NOWAIT -! deallocate(iqrs,iqsr,int_value,int_idx) -! !$OMP END PARALLEL -! -! mo_two_e_integrals_jj_anti_from_ao = mo_two_e_integral_jj_from_ao - mo_two_e_integrals_jj_exchange_from_ao -! -! -!END_PROVIDER -! -! BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_from_ao, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_exchange_from_ao, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_vv_anti_from_ao, (mo_num,mo_num) ] -! implicit none -! BEGIN_DOC -! ! mo_two_e_integrals_vv_from_ao(i,j) = J_ij -! ! mo_two_e_integrals_vv_exchange_from_ao(i,j) = J_ij -! ! mo_two_e_integrals_vv_anti_from_ao(i,j) = J_ij - K_ij -! ! but only for the virtual orbitals -! END_DOC -! -! integer :: i,j,p,q,r,s -! integer :: i0,j0 -! double precision :: c -! real(integral_kind) :: integral -! integer :: n, pp -! real(integral_kind), allocatable :: int_value(:) -! integer, allocatable :: int_idx(:) -! -! double precision, allocatable :: iqrs(:,:), iqsr(:,:), iqis(:), iqri(:) -! -! if (.not.do_direct_integrals) then -! PROVIDE ao_two_e_integrals_in_map mo_coef -! endif -! -! mo_two_e_integrals_vv_from_ao = 0.d0 -! mo_two_e_integrals_vv_exchange_from_ao = 0.d0 -! -! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: iqrs, iqsr -! -! -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE (i0,j0,i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, & -! !$OMP iqrs, iqsr,iqri,iqis) & -! !$OMP SHARED(n_virt_orb,mo_num,list_virt,mo_coef_transp,ao_num, & -! !$OMP ao_integrals_threshold,do_direct_integrals) & -! !$OMP REDUCTION(+:mo_two_e_integrals_vv_from_ao,mo_two_e_integrals_vv_exchange_from_ao) -! -! allocate( int_value(ao_num), int_idx(ao_num), & -! iqrs(mo_num,ao_num), iqis(mo_num), iqri(mo_num),& -! iqsr(mo_num,ao_num) ) -! -! !$OMP DO SCHEDULE (guided) -! do s=1,ao_num -! do q=1,ao_num -! -! do j=1,ao_num -! do i0=1,n_virt_orb -! i = list_virt(i0) -! iqrs(i,j) = 0.d0 -! iqsr(i,j) = 0.d0 -! enddo -! enddo -! -! if (do_direct_integrals) then -! double precision :: ao_two_e_integral -! do r=1,ao_num -! call compute_ao_two_e_integrals(q,r,s,ao_num,int_value) -! do p=1,ao_num -! integral = int_value(p) -! if (abs(integral) > ao_integrals_threshold) then -! do i0=1,n_virt_orb -! i = list_virt(i0) -! iqrs(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! call compute_ao_two_e_integrals(q,s,r,ao_num,int_value) -! do p=1,ao_num -! integral = int_value(p) -! if (abs(integral) > ao_integrals_threshold) then -! do i0=1,n_virt_orb -! i =list_virt(i0) -! iqsr(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! enddo -! -! else -! -! do r=1,ao_num -! call get_ao_two_e_integrals_non_zero(q,r,s,ao_num,int_value,int_idx,n) -! do pp=1,n -! p = int_idx(pp) -! integral = int_value(pp) -! if (abs(integral) > ao_integrals_threshold) then -! do i0=1,n_virt_orb -! i =list_virt(i0) -! iqrs(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! call get_ao_two_e_integrals_non_zero(q,s,r,ao_num,int_value,int_idx,n) -! do pp=1,n -! p = int_idx(pp) -! integral = int_value(pp) -! if (abs(integral) > ao_integrals_threshold) then -! do i0=1,n_virt_orb -! i = list_virt(i0) -! iqsr(i,r) += mo_coef_transp(i,p) * integral -! enddo -! endif -! enddo -! enddo -! endif -! iqis = 0.d0 -! iqri = 0.d0 -! do r=1,ao_num -! do i0=1,n_virt_orb -! i = list_virt(i0) -! iqis(i) += mo_coef_transp(i,r) * iqrs(i,r) -! iqri(i) += mo_coef_transp(i,r) * iqsr(i,r) -! enddo -! enddo -! do i0=1,n_virt_orb -! i= list_virt(i0) -! do j0=1,n_virt_orb -! j = list_virt(j0) -! c = mo_coef_transp(j,q)*mo_coef_transp(j,s) -! mo_two_e_integrals_vv_from_ao(j,i) += c * iqis(i) -! mo_two_e_integrals_vv_exchange_from_ao(j,i) += c * iqri(i) -! enddo -! enddo -! -! enddo -! enddo -! !$OMP END DO NOWAIT -! deallocate(iqrs,iqsr,int_value,int_idx) -! !$OMP END PARALLEL -! -! mo_two_e_integrals_vv_anti_from_ao = mo_two_e_integrals_vv_from_ao - mo_two_e_integrals_vv_exchange_from_ao -! ! print*, '**********' -! ! do i0 =1, n_virt_orb -! ! i = list_virt(i0) -! ! print*, mo_two_e_integrals_vv_from_ao(i,i) -! ! enddo -! ! print*, '**********' -! -! -!END_PROVIDER -! -! -! BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_exchange, (mo_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_two_e_integrals_jj_anti, (mo_num,mo_num) ] -! implicit none -! BEGIN_DOC -! ! mo_two_e_integrals_jj(i,j) = J_ij -! ! mo_two_e_integrals_jj_exchange(i,j) = K_ij -! ! mo_two_e_integrals_jj_anti(i,j) = J_ij - K_ij -! END_DOC -! -! integer :: i,j -! double precision :: get_two_e_integral -! -! PROVIDE mo_two_e_integrals_in_map -! mo_two_e_integrals_jj = 0.d0 -! mo_two_e_integrals_jj_exchange = 0.d0 -! -! do j=1,mo_num -! do i=1,mo_num -! mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map) -! mo_two_e_integrals_jj_exchange(i,j) = get_two_e_integral(i,j,j,i,mo_integrals_map) -! mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j) -! enddo -! enddo -! -!END_PROVIDER -! -! -!subroutine clear_mo_map -! implicit none -! BEGIN_DOC -! ! Frees the memory of the MO map -! END_DOC -! call map_deinit(mo_integrals_map) -! FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti -! FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map -!end -! diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 15bc6cfc..9bde53fc 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -30,28 +30,46 @@ MO 2e ints: mapping: changed so that all real ints (Jij, Kij, Jii) are in map2 , , + some places in code assume that map1 ints can be real + (can remove once we are sure we like this mapping) +translational symmetry: + kconserv array gives quartets which are symmetry-allowed + k_i + k_j = k_k + k_l + I + J = K + L + kconserv(I,J,K)=L TODO: symmetry - add provider for kconserv restructure arrays? mo coef and mo 1e ints already separate from real part of code (easy to add extra dimension) ao 1e ints could also be handled in same way as mo 1e ints -ao_ints - ao_overlap_abs for complex - ao_integrals_n_e_per_atom_complex? - not implemented for periodic: +ao_one_e_ints + ao_overlap_abs for complex? vs abs() + ao_integrals_n_e_per_atom_complex (should be simple, but currently we only use dummy nuclei) + +ao_two_e_ints (todo) + get_ao_two_e_integrals_non_zero_periodic + get_ao_two_e_integrals_non_zero_jl_periodic + get_ao_two_e_integrals_non_zero_jl_from_list_periodic + +mo_two_e_ints (todo) + get_mo_two_e_integrals_ij_periodic + add_integrals_to_map_complex + add_integrals_to_map_three_indices_complex + add_integrals_to_map_no_exit_34_complex + + +later: + calculation of pbc integrals in QP ao_two_e_integral ao_two_e_integral_schwartz_accel compute_ao_two_e_integrals [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] compute_ao_integrals_jl + ... - -mo_two_e_ints - incomplete NOTES: From f9ec0e9cff375c06a5665fd56686c0d7d160d733 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 10 Feb 2020 08:34:51 -0600 Subject: [PATCH 063/256] started working on converter --- .../Gen_Ezfio_from_integral_complex_3idx.sh | 63 ++ src/utils_periodic/MolPyscfToQPkpts.py | 881 ++++++++++++++++++ .../create_ezfio_complex_3idx.py | 78 ++ src/utils_periodic/qp2-pbc-diff.txt | 26 +- 4 files changed, 1039 insertions(+), 9 deletions(-) create mode 100755 src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh create mode 100644 src/utils_periodic/MolPyscfToQPkpts.py create mode 100755 src/utils_periodic/create_ezfio_complex_3idx.py diff --git a/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh new file mode 100755 index 00000000..10d42223 --- /dev/null +++ b/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh @@ -0,0 +1,63 @@ +#!/bin/bash + +ezfio=$1 +# Create the integral +echo 'Create Integral' + +echo 'Create EZFIO' +read nel nmo natom <<< $(cat param) +read e_nucl <<< $(cat e_nuc) +read nao <<< $(cat num_ao) +read nkpts <<< $(cat num_kpts) +read ndf <<< $(cat num_df) +#./create_ezfio_complex_4idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts +./create_ezfio_complex_3idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts $ndf +#Handle the orbital consitensy check +qp_edit -c $ezfio &> /dev/null +cp $ezfio/{ao,mo}_basis/ao_md5 + +#Read the integral +echo 'Read Integral' + + +################################################ +## using AO mono, 4-idx from pyscf ## +################################################ +qp_run import_integrals_ao_periodic $ezfio + + +################################################ +## using AO mono, 3-idx, mo coef from pyscf ## +################################################ + +#qp_run read_ao_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_ao_df_complex $ezfio +#qp_run read_mo_coef_complex $ezfio #start from converged pyscf MOs +# +#qp_run save_mo_df_to_disk $ezfio +#qp_run save_mo_bielec_to_disk $ezfio + +#qp_run mo_from_ao_orth $ezfio #use canonical orthonormalized AOs as initial MO guess +#qp_run print_H_matrix_restart $ezfio > hmat.out + + +############################################################### +## using AO mono, full 4-idx AO bielec, mo coef from pyscf ## +############################################################### + +#qp_run read_ao_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_ao_eri_chunk_complex $ezfio +#qp_run read_mo_coef_complex $ezfio #start from converged pyscf MOs +##qp_run mo_from_ao_orth $ezfio #use canonical orthonormalized AOs as initial MO guess + + +###################################################### +## using MO mono, full 4-idx MO bielec from pyscf ## +###################################################### + +#qp_run read_mo_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_mo_eri_chunk_complex $ezfio + diff --git a/src/utils_periodic/MolPyscfToQPkpts.py b/src/utils_periodic/MolPyscfToQPkpts.py new file mode 100644 index 00000000..1f72788e --- /dev/null +++ b/src/utils_periodic/MolPyscfToQPkpts.py @@ -0,0 +1,881 @@ +import numpy as np +from functools import reduce + + +def memoize(f): + memo = {} + def helper(x): + if x not in memo: + memo[x] = f(x) + return memo[x] + return helper + +@memoize +def idx2_tri(iijj): + ''' + iijj should be a 2-tuple + return triangular compound index for (0-indexed counting) + ''' + ij1=min(iijj) + ij2=max(iijj) + return ij1+(ij2*(ij2+1))//2 +# return ij1+(ij2*(ij2-1))//2 + +def pad(arr_in,outshape): + arr_out = np.zeros(outshape,dtype=np.complex128) + dataslice = tuple(slice(0,arr_in.shape[dim]) for dim in range(len(outshape))) + arr_out[dataslice] = arr_in + return arr_out + +def makesq(vlist,n1,n2): + ''' + make hermitian matrices of size (n2 x n2) from from lower triangles + vlist is n1 lower triangles in flattened form + given: ([a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t],2,4) + output a 2x4x4 array, where each 4x4 is the square constructed from the lower triangle + [ + [ + [a b* d* g*] + [b c e* h*] + [d e f i*] + [g h i j ] + ], + [ + [k l* n* q*] + [l m o* r*] + [n o p s*] + [q r s t ] + ] + ] + ''' + out=np.zeros([n1,n2,n2],dtype=np.complex128) + n0 = vlist.shape[0] + lmask=np.tri(n2,dtype=bool) + for i in range(n0): + out[i][lmask] = vlist[i].conj() + out2=out.transpose([0,2,1]) + for i in range(n0): + out2[i][lmask] = vlist[i] + return out2 + + +def makesq3(vlist,n2): + ''' + make hermitian matrices of size (n2 x n2) from from lower triangles + vlist is n1 lower triangles in flattened form + given: ([a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t],2,4) + output a 2x4x4 array, where each 4x4 is the square constructed from the lower triangle + [ + [ + [a b* d* g*] + [b c e* h*] + [d e f i*] + [g h i j ] + ], + [ + [k l* n* q*] + [l m o* r*] + [n o p s*] + [q r s t ] + ] + ] + ''' + n0 = vlist.shape[0] + out=np.zeros([n0,n2,n2],dtype=np.complex128) + lmask=np.tri(n2,dtype=bool) + for i in range(n0): + out[i][lmask] = vlist[i].conj() + out2=out.transpose([0,2,1]) + for i in range(n0): + out2[i][lmask] = vlist[i] + return out2 + +def makesq2(vlist,n1,n2): + out=np.zeros([n1,n2,n2],dtype=np.complex128) + lmask=np.tri(n2,dtype=bool) + tmp=np.zeros([n2,n2],dtype=np.complex128) + tmp2=np.zeros([n2,n2],dtype=np.complex128) + for i in range(n1): + tmp[lmask] = vlist[i].conj() + tmp2=tmp.T + tmp2[lmask] = vlist[i] + out[i] = tmp2.copy() + return out + + +def get_phase(cell, kpts, kmesh=None): + ''' + The unitary transformation that transforms the supercell basis k-mesh + adapted basis. + ''' + from pyscf.pbc import tools + from pyscf import lib + + latt_vec = cell.lattice_vectors() + if kmesh is None: + # Guess kmesh + scaled_k = cell.get_scaled_kpts(kpts).round(8) + kmesh = (len(np.unique(scaled_k[:,0])), + len(np.unique(scaled_k[:,1])), + len(np.unique(scaled_k[:,2]))) + + R_rel_a = np.arange(kmesh[0]) + R_rel_b = np.arange(kmesh[1]) + R_rel_c = np.arange(kmesh[2]) + R_vec_rel = lib.cartesian_prod((R_rel_a, R_rel_b, R_rel_c)) + R_vec_abs = np.einsum('nu, uv -> nv', R_vec_rel, latt_vec) + + NR = len(R_vec_abs) + phase = np.exp(1j*np.einsum('Ru, ku -> Rk', R_vec_abs, kpts)) + phase /= np.sqrt(NR) # normalization in supercell + + # R_rel_mesh has to be construct exactly same to the Ts in super_cell function + scell = tools.super_cell(cell, kmesh) + return scell, phase + +def mo_k2gamma(cell, mo_energy, mo_coeff, kpts, kmesh=None): + ''' + Transform MOs in Kpoints to the equivalents supercell + ''' + from pyscf import lib + import scipy.linalg as la + scell, phase = get_phase(cell, kpts, kmesh) + + E_g = np.hstack(mo_energy) + C_k = np.asarray(mo_coeff) + Nk, Nao, Nmo = C_k.shape + NR = phase.shape[0] + + # Transform AO indices + C_gamma = np.einsum('Rk, kum -> Rukm', phase, C_k) + C_gamma = C_gamma.reshape(Nao*NR, Nk*Nmo) + + E_sort_idx = np.argsort(E_g) + E_g = E_g[E_sort_idx] + C_gamma = C_gamma[:,E_sort_idx] + s = scell.pbc_intor('int1e_ovlp') + assert(abs(reduce(np.dot, (C_gamma.conj().T, s, C_gamma)) + - np.eye(Nmo*Nk)).max() < 1e-7) + + # Transform MO indices + E_k_degen = abs(E_g[1:] - E_g[:-1]).max() < 1e-5 + if np.any(E_k_degen): + degen_mask = np.append(False, E_k_degen) | np.append(E_k_degen, False) + shift = min(E_g[degen_mask]) - .1 + f = np.dot(C_gamma[:,degen_mask] * (E_g[degen_mask] - shift), + C_gamma[:,degen_mask].conj().T) + assert(abs(f.imag).max() < 1e-5) + + e, na_orb = la.eigh(f.real, s, type=2) + C_gamma[:,degen_mask] = na_orb[:, e>0] + + if abs(C_gamma.imag).max() < 1e-7: + print('!Warning Some complexe pollutions in MOs are present') + + C_gamma = C_gamma.real + if abs(reduce(np.dot, (C_gamma.conj().T, s, C_gamma)) - np.eye(Nmo*Nk)).max() < 1e-7: + print('!Warning Some complexe pollutions in MOs are present') + + s_k = cell.pbc_intor('int1e_ovlp', kpts=kpts) + # overlap between k-point unitcell and gamma-point supercell + s_k_g = np.einsum('kuv,Rk->kuRv', s_k, phase.conj()).reshape(Nk,Nao,NR*Nao) + # The unitary transformation from k-adapted orbitals to gamma-point orbitals + mo_phase = lib.einsum('kum,kuv,vi->kmi', C_k.conj(), s_k_g, C_gamma) + + return mo_phase + +def qp2rename(): + import shutil + qp2names={} + qp2names['mo_coef_complex'] = 'C.qp' + qp2names['bielec_ao_complex'] = 'W.qp' + + qp2names['kinetic_ao_complex'] = 'T.qp' + qp2names['ne_ao_complex'] = 'V.qp' + qp2names['overlap_ao_complex'] = 'S.qp' + + + for old,new in qp2names.items(): + shutil.move(old,new) + shutil.copy('e_nuc','E.qp') + +def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, + print_ao_ints_bi=False, + print_mo_ints_bi=False, + print_ao_ints_df=True, + print_mo_ints_df=False, + print_ao_ints_mono=True, + print_mo_ints_mono=False): + ''' + kpts = List of kpoints coordinates. Cannot be null, for gamma is other script + kmesh = Mesh of kpoints (optional) + cas_idx = List of active MOs. If not specified all MOs are actives + int_threshold = The integral will be not printed in they are bellow that + ''' + + from pyscf.pbc import ao2mo + from pyscf.pbc import tools + from pyscf.pbc.gto import ecp + import h5py + + mo_coef_threshold = int_threshold + ovlp_threshold = int_threshold + kin_threshold = int_threshold + ne_threshold = int_threshold + bielec_int_threshold = int_threshold + + natom = len(cell.atom_coords()) + print('n_atom per kpt', natom) + print('num_elec per kpt', cell.nelectron) + + mo_coeff = mf.mo_coeff + # Mo_coeff actif + mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) + e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) + + Nk, nao, nmo = mo_k.shape + print("n Kpts", Nk) + print("n active Mos per kpt", nmo) + print("n AOs per kpt", nao) + + naux = mf.with_df.auxcell.nao + print("n df fitting functions", naux) + with open('num_df','w') as f: + f.write(str(naux)) + + # Write all the parameter need to creat a dummy EZFIO folder who will containt the integral after. + # More an implentation detail than a real thing + with open('param','w') as f: + # Note the use of nmo_tot + f.write(' '.join(map(str,(cell.nelectron*Nk, Nk*nmo, natom*Nk)))) + + with open('num_ao','w') as f: + f.write(str(nao*Nk)) + with open('num_kpts','w') as f: + f.write(str(Nk)) + # _ + # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ + # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | + # | + + #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = + shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 + e_nuc = (cell.energy_nuc() + shift)*Nk + + print('nucl_repul', e_nuc) + with open('e_nuc','w') as f: + f.write(str(e_nuc)) + + + + # __ __ _ + # |\/| | | | _ _ |_ _ + # | | |__| |__ (_) (/_ | _> + # + with open('mo_coef_complex','w') as outfile: + c_kpts = np.reshape(mo_k,(Nk,nao,nmo)) + + for ik in range(Nk): + shift1=ik*nao+1 + shift2=ik*nmo+1 + for i in range(nao): + for j in range(nmo): + cij = c_kpts[ik,i,j] + if abs(cij) > mo_coef_threshold: + outfile.write('%s %s %s %s\n' % (i+shift1, j+shift2, cij.real, cij.imag)) + + # ___ + # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ + # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) + # _| + + if mf.cell.pseudo: + v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) + else: + v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) + if len(cell._ecpbas) > 0: + v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) + + ne_ao = ('ne',v_kpts_ao,ne_threshold) + ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) + kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) + + for name, intval_kpts_ao, thresh in (ne_ao, ovlp_ao, kin_ao): + if print_ao_ints_mono: + with open('%s_ao_complex' % name,'w') as outfile: + for ik in range(Nk): + shift=ik*nao+1 + for i in range(nao): + for j in range(i,nao): + int_ij = intval_kpts_ao[ik,i,j] + if abs(int_ij) > thresh: + outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + if print_mo_ints_mono: + intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) + with open('%s_mo_complex' % name,'w') as outfile: + for ik in range(Nk): + shift=ik*nmo+1 + for i in range(nmo): + for j in range(i,nmo): + int_ij = intval_kpts_mo[ik,i,j] + if abs(int_ij) > thresh: + outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + + + # ___ _ + # | ._ _|_ _ _ ._ _. | _ |_) o + # _|_ | | |_ (/_ (_| | (_| | _> |_) | + # _| + # + kconserv = tools.get_kconserv(cell, kpts) + + with open('kconserv_complex','w') as outfile: + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + d = kconserv[a,b,c] + outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) + + + intfile=h5py.File(mf.with_df._cderi,'r') + + j3c = intfile.get('j3c') + naosq = nao*nao + naotri = (nao*(nao+1))//2 + j3ckeys = list(j3c.keys()) + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + j3clist = [j3c.get(i+'/0') for i in j3ckeys] + if j3clist==[None]*len(j3clist): + # if using older version, stop before last level + j3clist = [j3c.get(i) for i in j3ckeys] + + nkinvsq = 1./np.sqrt(Nk) + + # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j + # output dimensions should be reversed (nao, nao, naux, nkptpairs) + j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + + nkpt_pairs = j3arr.shape[0] + + if print_ao_ints_df: + with open('df_ao_integral_array','w') as outfile: + pass + with open('df_ao_integral_array','a') as outfile: + for k,kpt_pair in enumerate(j3arr): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + + if print_mo_ints_df: + kpair_list=[] + for i in range(Nk): + for j in range(Nk): + if(i>=j): + kpair_list.append((i,j,idx2_tri((i,j)))) + j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) + with open('df_mo_integral_array','w') as outfile: + pass + with open('df_mo_integral_array','a') as outfile: + for k,kpt_pair in enumerate(j3mo): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + + + + +# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) +# for d, kd in enumerate(kpts): +# for c, kc in enumerate(kpts): +# if c > d: break +# idx2_cd = idx2_tri(c,d) +# for b, kb in enumerate(kpts): +# if b > d: break +# a = kconserv[b,c,d] +# if idx2_tri(a,b) > idx2_cd: continue +# if ((c==d) and (a>b)): continue +# ka = kpts[a] +# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) +# v *= 1./Nk +# eri_4d_ao[a,:,b,:,c,:,d] = v +# +# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) + + + if (print_ao_ints_bi or print_mo_ints_bi): + if print_ao_ints_bi: + with open('bielec_ao_complex','w') as outfile: + pass + if print_mo_ints_bi: + with open('bielec_mo_complex','w') as outfile: + pass + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if idx2_tri((a,b)) > idx2_cd: continue + if ((c==d) and (a>b)): continue + ka = kpts[a] + + if print_ao_ints_bi: + with open('bielec_ao_complex','a') as outfile: + eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) + eri_4d_ao_kpt *= 1./Nk + for l in range(nao): + ll=l+d*nao + for j in range(nao): + jj=j+c*nao + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nao): + kk=k+b*nao + if kk>ll: break + for i in range(nao): + ii=i+a*nao + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_ao_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + + if print_mo_ints_bi: + with open('bielec_mo_complex','a') as outfile: + eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], + [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) + eri_4d_mo_kpt *= 1./Nk + for l in range(nmo): + ll=l+d*nmo + for j in range(nmo): + jj=j+c*nmo + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nmo): + kk=k+b*nmo + if kk>ll: break + for i in range(nmo): + ii=i+a*nmo + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_mo_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + + +def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, + print_ao_ints_bi=False, + print_mo_ints_bi=False, + print_ao_ints_df=True, + print_mo_ints_df=False, + print_ao_ints_mono=True, + print_mo_ints_mono=False): + ''' + kpts = List of kpoints coordinates. Cannot be null, for gamma is other script + kmesh = Mesh of kpoints (optional) + cas_idx = List of active MOs. If not specified all MOs are actives + int_threshold = The integral will be not printed in they are bellow that + ''' + + from pyscf.pbc import ao2mo + from pyscf.pbc import tools + from pyscf.pbc.gto import ecp + import h5py + import scipy + + qph5=h5py.File('qpdat.h5') + qph5.create_group('nuclei') + qph5.create_group('electrons') + qph5.create_group('ao_basis') + qph5.create_group('mo_basis') + + + mo_coef_threshold = int_threshold + ovlp_threshold = int_threshold + kin_threshold = int_threshold + ne_threshold = int_threshold + bielec_int_threshold = int_threshold + + natom = cell.natm + nelec = cell.nelectron + print('n_atom per kpt', natom) + print('num_elec per kpt', nelec) + + mo_coeff = mf.mo_coeff + # Mo_coeff actif + mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) + e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) + + Nk, nao, nmo = mo_k.shape + print("n Kpts", Nk) + print("n active Mos per kpt", nmo) + print("n AOs per kpt", nao) + + naux = mf.with_df.auxcell.nao + print("n df fitting functions", naux) + + #in old version: param < nelec*Nk, nmo*Nk, natom*Nk + qph5['electrons'].attrs['elec_alpha_num']=nelec*Nk + qph5['electrons'].attrs['elec_beta_num']=nelec*Nk + qph5['mo_basis'].attrs['mo_num']=Nk*nmo + qph5['ao_basis'].attrs['ao_num']=Nk*nao + qph5['nuclei'].attrs['nucl_num']=Nk*natom + qph5['nuclei'].attrs['kpt_num']=Nk + qph5['ao_basis'].attrs['df_num']=naux + + # _ + # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ + # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | + # | + + #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = + shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 + e_nuc = (cell.energy_nuc() + shift)*Nk + + print('nucl_repul', e_nuc) + qph5['nuclei'].attrs['nuclear_repulsion']=e_nuc + + # __ __ _ + # |\/| | | | _ _ |_ _ + # | | |__| |__ (_) (/_ | _> + # + mo_coef_blocked=scipy.linalg.block_diag(*mo_k) + qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) + qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) + qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) + qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + + # ___ + # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ + # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) + # _| + + if mf.cell.pseudo: + ao_n_e = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) + else: + v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) + if len(cell._ecpbas) > 0: + v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) + + ne_ao = ('ne',v_kpts_ao,ne_threshold) + ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) + kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) + + for name, intval_kpts_ao, thresh in (ne_ao, ovlp_ao, kin_ao): + if print_ao_ints_mono: + with open('%s_ao_complex' % name,'w') as outfile: + for ik in range(Nk): + shift=ik*nao+1 + for i in range(nao): + for j in range(i,nao): + int_ij = intval_kpts_ao[ik,i,j] + if abs(int_ij) > thresh: + outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + if print_mo_ints_mono: + intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) + with open('%s_mo_complex' % name,'w') as outfile: + for ik in range(Nk): + shift=ik*nmo+1 + for i in range(nmo): + for j in range(i,nmo): + int_ij = intval_kpts_mo[ik,i,j] + if abs(int_ij) > thresh: + outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + + + # ___ _ + # | ._ _|_ _ _ ._ _. | _ |_) o + # _|_ | | |_ (/_ (_| | (_| | _> |_) | + # _| + # + kconserv = tools.get_kconserv(cell, kpts) + + with open('kconserv_complex','w') as outfile: + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + d = kconserv[a,b,c] + outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) + + + intfile=h5py.File(mf.with_df._cderi,'r') + + j3c = intfile.get('j3c') + naosq = nao*nao + naotri = (nao*(nao+1))//2 + j3ckeys = list(j3c.keys()) + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + j3clist = [j3c.get(i+'/0') for i in j3ckeys] + if j3clist==[None]*len(j3clist): + # if using older version, stop before last level + j3clist = [j3c.get(i) for i in j3ckeys] + + nkinvsq = 1./np.sqrt(Nk) + + # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j + # output dimensions should be reversed (nao, nao, naux, nkptpairs) + j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + + nkpt_pairs = j3arr.shape[0] + + if print_ao_ints_df: + with open('df_ao_integral_array','w') as outfile: + pass + with open('df_ao_integral_array','a') as outfile: + for k,kpt_pair in enumerate(j3arr): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + + if print_mo_ints_df: + kpair_list=[] + for i in range(Nk): + for j in range(Nk): + if(i>=j): + kpair_list.append((i,j,idx2_tri((i,j)))) + j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) + with open('df_mo_integral_array','w') as outfile: + pass + with open('df_mo_integral_array','a') as outfile: + for k,kpt_pair in enumerate(j3mo): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + + + +# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) +# for d, kd in enumerate(kpts): +# for c, kc in enumerate(kpts): +# if c > d: break +# idx2_cd = idx2_tri(c,d) +# for b, kb in enumerate(kpts): +# if b > d: break +# a = kconserv[b,c,d] +# if idx2_tri(a,b) > idx2_cd: continue +# if ((c==d) and (a>b)): continue +# ka = kpts[a] +# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) +# v *= 1./Nk +# eri_4d_ao[a,:,b,:,c,:,d] = v +# +# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) + + + if (print_ao_ints_bi or print_mo_ints_bi): + if print_ao_ints_bi: + with open('bielec_ao_complex','w') as outfile: + pass + if print_mo_ints_bi: + with open('bielec_mo_complex','w') as outfile: + pass + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if idx2_tri((a,b)) > idx2_cd: continue + if ((c==d) and (a>b)): continue + ka = kpts[a] + + if print_ao_ints_bi: + with open('bielec_ao_complex','a') as outfile: + eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) + eri_4d_ao_kpt *= 1./Nk + for l in range(nao): + ll=l+d*nao + for j in range(nao): + jj=j+c*nao + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nao): + kk=k+b*nao + if kk>ll: break + for i in range(nao): + ii=i+a*nao + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_ao_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + + if print_mo_ints_bi: + with open('bielec_mo_complex','a') as outfile: + eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], + [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) + eri_4d_mo_kpt *= 1./Nk + for l in range(nmo): + ll=l+d*nmo + for j in range(nmo): + jj=j+c*nmo + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nmo): + kk=k+b*nmo + if kk>ll: break + for i in range(nmo): + ii=i+a*nmo + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_mo_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + + + +#def testpyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8): +# ''' +# kpts = List of kpoints coordinates. Cannot be null, for gamma is other script +# kmesh = Mesh of kpoints (optional) +# cas_idx = List of active MOs. If not specified all MOs are actives +# int_threshold = The integral will be not printed in they are bellow that +# ''' +# +# from pyscf.pbc import ao2mo +# from pyscf.pbc import tools +# from pyscf.pbc.gto import ecp +# +# mo_coef_threshold = int_threshold +# ovlp_threshold = int_threshold +# kin_threshold = int_threshold +# ne_threshold = int_threshold +# bielec_int_threshold = int_threshold +# +# natom = len(cell.atom_coords()) +# print('n_atom per kpt', natom) +# print('num_elec per kpt', cell.nelectron) +# +# mo_coeff = mf.mo_coeff +# # Mo_coeff actif +# mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) +# e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) +# +# Nk, nao, nmo = mo_k.shape +# print("n Kpts", Nk) +# print("n active Mos per kpt", nmo) +# print("n AOs per kpt", nao) +# +# naux = mf.with_df.get_naoaux() +# print("n df fitting functions", naux) +# +# # _ +# # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ +# # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | +# # | +# +# #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = +# shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 +# e_nuc = (cell.energy_nuc() + shift)*Nk +# +# print('nucl_repul', e_nuc) +# +# +# # ___ +# # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ +# # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) +# # _| +# +# if mf.cell.pseudo: +# v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) +# else: +# v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) +# if len(cell._ecpbas) > 0: +# v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) +# +# ne_ao = ('ne',v_kpts_ao,ne_threshold) +# ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) +# kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) +# +# +# # ___ _ +# # | ._ _|_ _ _ ._ _. | _ |_) o +# # _|_ | | |_ (/_ (_| | (_| | _> |_) | +# # _| +# # +# kconserv = tools.get_kconserv(cell, kpts) +# +# +# import h5py +# +# intfile=h5py.File(mf.with_df._cderi,'r') +# +# j3c = intfile.get('j3c') +# naosq = nao*nao +# naotri = (nao*(nao+1))//2 +# j3keys = list(j3c.keys()) +# j3keys.sort(key=lambda x:int(x)) +# j3clist = [j3c.get(i) for i in j3keys] +# nkinvsq = 1./np.sqrt(Nk) +# +# # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j +# # output dimensions should be reversed (nao, nao, naux, nkptpairs) +# j3arr=np.array([(pad(i.value.reshape([-1,nao,nao]),[naux,nao,nao]) if (i.shape[1] == naosq) else makesq(i.value,naux,nao)) * nkinvsq for i in j3clist]) +# +# nkpt_pairs = j3arr.shape[0] +# +# kpair_list=[] +# for i in range(Nk): +# for j in range(Nk): +# if(i>=j): +# kpair_list.append((i,j,idx2_tri((i,j)))) +# j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij,:,:,:],mo_k[ki,:,:].conj(),mo_k[kj,:,:]) for ki,kj,kij in kpair_list]) +# +# +# +# eri_mo = np.zeros(4*[nmo*Nk],dtype=np.complex128) +# eri_ao = np.zeros(4*[nao*Nk],dtype=np.complex128) +# +# for d, kd in enumerate(kpts): +# for c, kc in enumerate(kpts): +# for b, kb in enumerate(kpts): +# a = kconserv[b,c,d] +# ka = kpts[a] +# eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) +# eri_4d_ao_kpt *= 1./Nk +# for l in range(nao): +# ll=l+d*nao +# for j in range(nao): +# jj=j+c*nao +# for k in range(nao): +# kk=k+b*nao +# for i in range(nao): +# ii=i+a*nao +# v=eri_4d_ao_kpt[i,k,j,l] +# eri_ao[ii,kk,jj,ll]=v +# +# eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], +# [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) +# eri_4d_mo_kpt *= 1./Nk +# for l in range(nmo): +# ll=l+d*nmo +# for j in range(nmo): +# jj=j+c*nmo +# for k in range(nmo): +# kk=k+b*nmo +# for i in range(nmo): +# ii=i+a*nmo +# v=eri_4d_mo_kpt[i,k,j,l] +# eri_mo[ii,kk,jj,ll]=v +# +# return (mo_k,j3arr,j3mo,eri_ao,eri_mo,kpair_list) + + diff --git a/src/utils_periodic/create_ezfio_complex_3idx.py b/src/utils_periodic/create_ezfio_complex_3idx.py new file mode 100755 index 00000000..d0bacf81 --- /dev/null +++ b/src/utils_periodic/create_ezfio_complex_3idx.py @@ -0,0 +1,78 @@ +#!/usr/bin/env python +from ezfio import ezfio +import h5py + +import sys +filename = sys.argv[1] +h5filename = sys.argv[2] +#num_elec, nucl_num, mo_num = map(int,sys.argv[2:5]) + +#nuclear_repulsion = float(sys.argv[5]) +#ao_num = int(sys.argv[6]) +#n_kpts = int(sys.argv[7]) +#n_aux = int(sys.argv[8]) +ezfio.set_file(filename) +qph5=h5py.File(h5filename.'r') + +ezfio.electrons_elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] +ezfio.electrons_elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + +nucl_num = qph5['nuclei'].attrs['nucl_num'] +kpt_num = qph5['nuclei'].attrs['kpt_num'] +#df_num = qph5['???'].attrs['df_num'] + +mo_num = qph5['mo_basis'].attrs['mo_num'] +ezfio.set_mo_basis_mo_num(mo_num) + +#ao_num = mo_num +#Important ! +import math +nelec_per_kpt = num_elec // n_kpts +nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) +nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + +ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) +ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + +#ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) +#ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + +#ezfio.set_utils_num_kpts(n_kpts) +#ezfio.set_integrals_bielec_df_num(n_aux) + +#Important +ezfio.set_nuclei_nucl_num(nucl_num) +ezfio.set_nuclei_nucl_charge([0.]*nucl_num) +ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) +ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + +ezfio.set_nuclei_io_nuclear_repulsion('Read') +ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + +# Ao num +#ao_num = mo_num +ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") +ezfio.set_ao_basis_ao_num(ao_num) +ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff + +#Just need one +ao_prim_num_max = 5 + +d = [ [0] *ao_prim_num_max]*ao_num +ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) +ezfio.set_ao_basis_ao_power(d) +ezfio.set_ao_basis_ao_coef(d) +ezfio.set_ao_basis_ao_expo(d) + +#Dummy one +ao_md5 = '3b8b464dfc95f282129bde3efef3c502' +ezfio.set_ao_basis_ao_md5(ao_md5) +ezfio.set_mo_basis_ao_md5(ao_md5) + + +ezfio.set_mo_basis_mo_num(mo_num) +c_mo = [[1 if i==j else 0 for i in range(mo_num)] for j in range(ao_num)] +ezfio.set_mo_basis_mo_coef([ [0]*mo_num] * ao_num) +#ezfio.set_mo_basis_mo_coef_real(c_mo) + +ezfio.set_nuclei_is_periodic(True) diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index 9bde53fc..d1953c8b 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -73,16 +73,24 @@ later: NOTES: - number of unique 4-tuples with 8-fold symmetry is a8(n)=n*(n+1)*(n^2+n+2)/8 - number of unique 4-tuples with 4-fold symmetry is a4(n)=n^2*(n^2+3)/4 - a8 is number of unique real 2e ints with n mos - a4 is number of unique* complex 2e ints with n mos (where p+i*q and p-i*q are counted as one, not two) - a4(n) = a8(n) + a8(n-1) - - we can already generate the list of with unique values for the 8-fold case - the set of these for 4-fold symmetry is the union of the 8-fold set for n and the 8-fold set for n-1 with a simple transformation - _{4,n} = _{8,n} + <(k+1)j|i(l+1)>_{8,n-1} + 3-index integrals + = \sum_\mu (ik|\mu)(jl|\mu) + store (ik|\mu) for I<=K + if i>k, take conjugate transpose in first two dimensions + df_mo(:,:,mu,kjkl) = C(:,:,kj)^\dagger.df_ao(:,:,mu,kjkl).C(:,:,kl) + + 2e int compound indexing + number of unique 4-tuples with 8-fold symmetry is a8(n)=n*(n+1)*(n^2+n+2)/8 + number of unique 4-tuples with 4-fold symmetry is a4(n)=n^2*(n^2+3)/4 + a8 is number of unique real 2e ints with n mos + a4 is number of unique* complex 2e ints with n mos (where p+i*q and p-i*q are counted as one, not two) + a4(n) = a8(n) + a8(n-1) + + we can already generate the list of with unique values for the 8-fold case + the set of these for 4-fold symmetry is the union of the 8-fold set for n and the 8-fold set for n-1 with a simple transformation + _{4,n} = _{8,n} + <(k+1)j|i(l+1)>_{8,n-1} + From 85f4ca312194684e3d31fdc4ec42df22b368ef58 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 10 Feb 2020 08:36:11 -0600 Subject: [PATCH 064/256] added ao_num, df_num to converter --- src/utils_periodic/create_ezfio_complex_3idx.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/utils_periodic/create_ezfio_complex_3idx.py b/src/utils_periodic/create_ezfio_complex_3idx.py index d0bacf81..c0315d1e 100755 --- a/src/utils_periodic/create_ezfio_complex_3idx.py +++ b/src/utils_periodic/create_ezfio_complex_3idx.py @@ -19,7 +19,8 @@ ezfio.electrons_elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] nucl_num = qph5['nuclei'].attrs['nucl_num'] kpt_num = qph5['nuclei'].attrs['kpt_num'] -#df_num = qph5['???'].attrs['df_num'] +df_num = qph5['ao_basis'].attrs['df_num'] +ao_num = qph5['ao_basis'].attrs['ao_num'] mo_num = qph5['mo_basis'].attrs['mo_num'] ezfio.set_mo_basis_mo_num(mo_num) From c4154c10ea57f530659f4970fa61c83a2f0c0d7f Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 10 Feb 2020 15:21:41 -0600 Subject: [PATCH 065/256] pyscf converter hdf5 arr --- src/utils_periodic/MolPyscfToQPkpts.py | 56 +++++++++++++++++++------- 1 file changed, 41 insertions(+), 15 deletions(-) diff --git a/src/utils_periodic/MolPyscfToQPkpts.py b/src/utils_periodic/MolPyscfToQPkpts.py index 1f72788e..86db7285 100644 --- a/src/utils_periodic/MolPyscfToQPkpts.py +++ b/src/utils_periodic/MolPyscfToQPkpts.py @@ -560,19 +560,28 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # _| if mf.cell.pseudo: - ao_n_e = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) + v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) else: v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) if len(cell._ecpbas) > 0: v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) - ne_ao = ('ne',v_kpts_ao,ne_threshold) - ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) - kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) + ne_ao = ('V',v_kpts_ao,ne_threshold) + ovlp_ao = ('S',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) + kin_ao = ('T',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) + + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic', data=kin_ao[1].real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao[1].imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap', data=ovlp_ao[1].real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao[1].imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=v_kpts_ao.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=v_kpts_ao.imag) + + for name, intval_kpts_ao, thresh in (ne_ao, ovlp_ao, kin_ao): if print_ao_ints_mono: - with open('%s_ao_complex' % name,'w') as outfile: + with open('%s.qp' % name,'w') as outfile: for ik in range(Nk): shift=ik*nao+1 for i in range(nao): @@ -582,7 +591,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) if print_mo_ints_mono: intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) - with open('%s_mo_complex' % name,'w') as outfile: + with open('%s_mo.qp' % name,'w') as outfile: for ik in range(Nk): shift=ik*nmo+1 for i in range(nmo): @@ -598,8 +607,16 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # _| # kconserv = tools.get_kconserv(cell, kpts) + qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) + kcon_test = np.zeros((Nk,Nk,Nk),dtype=int) + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + kcon_test[a,c,b] = kconserv[a,b,c]+1 + qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) - with open('kconserv_complex','w') as outfile: + + with open('K.qp','w') as outfile: for a in range(Nk): for b in range(Nk): for c in range(Nk): @@ -630,17 +647,22 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) nkpt_pairs = j3arr.shape[0] + df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) if print_ao_ints_df: - with open('df_ao_integral_array','w') as outfile: + with open('D.qp','w') as outfile: pass - with open('df_ao_integral_array','a') as outfile: + with open('D.qp','a') as outfile: for k,kpt_pair in enumerate(j3arr): for iaux,dfbasfunc in enumerate(kpt_pair): for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + df_ao_tmp[i,j,iaux,k]=v + + qph5.create_dataset('ao_two_e_ints/df_ao_array_real',data=df_ao_tmp.real) + qph5.create_dataset('ao_two_e_ints/df_ao_array_imag',data=df_ao_tmp.imag) if print_mo_ints_df: kpair_list=[] @@ -649,15 +671,19 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if(i>=j): kpair_list.append((i,j,idx2_tri((i,j)))) j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) - with open('df_mo_integral_array','w') as outfile: + df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) + with open('D_mo.qp','w') as outfile: pass - with open('df_mo_integral_array','a') as outfile: + with open('D_mo.qp','a') as outfile: for k,kpt_pair in enumerate(j3mo): for iaux,dfbasfunc in enumerate(kpt_pair): for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + df_mo_tmp[i,j,iaux,k]=v + qph5.create_dataset('mo_two_e_ints/df_mo_array_real',data=df_mo_tmp.real) + qph5.create_dataset('mo_two_e_ints/df_mo_array_imag',data=df_mo_tmp.imag) @@ -681,10 +707,10 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if (print_ao_ints_bi or print_mo_ints_bi): if print_ao_ints_bi: - with open('bielec_ao_complex','w') as outfile: + with open('W.qp','w') as outfile: pass if print_mo_ints_bi: - with open('bielec_mo_complex','w') as outfile: + with open('W_mo.qp','w') as outfile: pass for d, kd in enumerate(kpts): for c, kc in enumerate(kpts): @@ -698,7 +724,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ka = kpts[a] if print_ao_ints_bi: - with open('bielec_ao_complex','a') as outfile: + with open('W.qp','a') as outfile: eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) eri_4d_ao_kpt *= 1./Nk for l in range(nao): @@ -719,7 +745,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) if print_mo_ints_bi: - with open('bielec_mo_complex','a') as outfile: + with open('W_mo.qp','a') as outfile: eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) eri_4d_mo_kpt *= 1./Nk From 4ded39470b5b7c2b64084afa6be74bc55de7f021 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 10 Feb 2020 15:29:58 -0600 Subject: [PATCH 066/256] parameters are not variables (openmp data-sharing) --- src/hartree_fock/fock_matrix_hf_complex.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_complex.irp.f index d4b3194d..3dea06fe 100644 --- a/src/hartree_fock/fock_matrix_hf_complex.irp.f +++ b/src/hartree_fock/fock_matrix_hf_complex.irp.f @@ -33,7 +33,7 @@ !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & !$OMP c0,key1)& !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex,i_sign, & + !$OMP SCF_density_matrix_ao_beta_complex, & !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) @@ -116,7 +116,7 @@ !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & !$OMP c0,key1)& !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex,i_sign, & + !$OMP SCF_density_matrix_ao_beta_complex, & !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) From a28244e1d113f89364a5b685b828c67037daa864 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 10 Feb 2020 17:30:45 -0600 Subject: [PATCH 067/256] gfortran requires length in format specifier --- src/utils_periodic/dump_2e_from_map.irp.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/utils_periodic/dump_2e_from_map.irp.f b/src/utils_periodic/dump_2e_from_map.irp.f index e126fa06..d3a49886 100644 --- a/src/utils_periodic/dump_2e_from_map.irp.f +++ b/src/utils_periodic/dump_2e_from_map.irp.f @@ -50,7 +50,7 @@ subroutine run j = jj(k2) k = kk(k2) l = ll(k2) - print'((A),4(I4),1(E15.7),2(I),2(E9.1))','imag1 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) + print'((A),4(I4),1(E15.7),2(I4),2(E9.1))','imag1 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) !G_a(i,k) += D_{ab}(l,j)*() !G_b(i,k) += D_{ab}(l,j)*() @@ -67,7 +67,7 @@ subroutine run j = jj(k2) k = kk(k2) l = ll(k2) - print'((A),4(I4),1(E15.7),2(I))','real1 ',i,j,k,l,values(k1),k1,k2 + print'((A),4(I4),1(E15.7),2(I4))','real1 ',i,j,k,l,values(k1),k1,k2 enddo endif enddo @@ -98,7 +98,7 @@ subroutine run j = jj(k2) k = kk(k2) l = ll(k2) - print'((A),4(I4),1(E15.7),2(I),2(E9.1))','imag2 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) + print'((A),4(I4),1(E15.7),2(I4),2(E9.1))','imag2 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) enddo else ! real part do k2=1,4 @@ -109,7 +109,7 @@ subroutine run j = jj(k2) k = kk(k2) l = ll(k2) - print'((A),4(I4),1(E15.7),2(I))','real2 ',i,j,k,l,values(k1),k1,k2 + print'((A),4(I4),1(E15.7),2(I4))','real2 ',i,j,k,l,values(k1),k1,k2 enddo endif enddo From 8472e71df493b137f8054f32b5b6ebbcafdd02d8 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 11 Feb 2020 16:39:08 -0600 Subject: [PATCH 068/256] working on complex converter --- src/ao_two_e_ints/EZFIO.cfg | 5 ++ .../Gen_Ezfio_from_integral_complex_3idx.sh | 17 ++-- src/utils_periodic/MolPyscfToQPkpts.py | 25 +++++- .../create_ezfio_complex_3idx.py | 78 +++++++++++++------ 4 files changed, 92 insertions(+), 33 deletions(-) diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg index b18c65d1..a99a05d2 100644 --- a/src/ao_two_e_ints/EZFIO.cfg +++ b/src/ao_two_e_ints/EZFIO.cfg @@ -18,3 +18,8 @@ interface: ezfio,provider,ocaml default: False ezfio_name: direct +[df_num] +type: integer +doc: Size of df basis +interface: ezfio, provider + diff --git a/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh index 10d42223..e560ae38 100755 --- a/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh +++ b/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh @@ -1,17 +1,18 @@ #!/bin/bash ezfio=$1 +h5file=$2 # Create the integral echo 'Create Integral' echo 'Create EZFIO' -read nel nmo natom <<< $(cat param) -read e_nucl <<< $(cat e_nuc) -read nao <<< $(cat num_ao) -read nkpts <<< $(cat num_kpts) -read ndf <<< $(cat num_df) -#./create_ezfio_complex_4idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts -./create_ezfio_complex_3idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts $ndf +#read nel nmo natom <<< $(cat param) +#read e_nucl <<< $(cat e_nuc) +#read nao <<< $(cat num_ao) +#read nkpts <<< $(cat num_kpts) +#read ndf <<< $(cat num_df) +##./create_ezfio_complex_4idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts +./create_ezfio_complex_3idx.py $ezfio $h5file #$nel $natom $nmo $e_nucl $nao $nkpts $ndf #Handle the orbital consitensy check qp_edit -c $ezfio &> /dev/null cp $ezfio/{ao,mo}_basis/ao_md5 @@ -23,7 +24,7 @@ echo 'Read Integral' ################################################ ## using AO mono, 4-idx from pyscf ## ################################################ -qp_run import_integrals_ao_periodic $ezfio +#qp_run import_integrals_ao_periodic $ezfio ################################################ diff --git a/src/utils_periodic/MolPyscfToQPkpts.py b/src/utils_periodic/MolPyscfToQPkpts.py index 86db7285..0a83e082 100644 --- a/src/utils_periodic/MolPyscfToQPkpts.py +++ b/src/utils_periodic/MolPyscfToQPkpts.py @@ -489,6 +489,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, from pyscf.pbc import ao2mo from pyscf.pbc import tools from pyscf.pbc.gto import ecp + from pyscf.data import nist import h5py import scipy @@ -507,9 +508,21 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, natom = cell.natm nelec = cell.nelectron + atom_xyz = mf.cell.atom_coords() + if not(mf.cell.unit.startswith(('B','b','au','AU'))): + atom_xyz /= nist.BOHR # always convert to au + + strtype=h5py.special_dtype(vlen=str) + atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) + for i in range(natom): + atom_dset[i] = mf.cell.atom_pure_symbol(i) + qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) + qph5.create_dataset('nuclei/nucl_charge',data=mf.cell.atom_charges()) + + print('n_atom per kpt', natom) print('num_elec per kpt', nelec) - + mo_coeff = mf.mo_coeff # Mo_coeff actif mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) @@ -523,14 +536,20 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, naux = mf.with_df.auxcell.nao print("n df fitting functions", naux) - #in old version: param < nelec*Nk, nmo*Nk, natom*Nk + #in old version: param << nelec*Nk, nmo*Nk, natom*Nk qph5['electrons'].attrs['elec_alpha_num']=nelec*Nk qph5['electrons'].attrs['elec_beta_num']=nelec*Nk qph5['mo_basis'].attrs['mo_num']=Nk*nmo qph5['ao_basis'].attrs['ao_num']=Nk*nao qph5['nuclei'].attrs['nucl_num']=Nk*natom qph5['nuclei'].attrs['kpt_num']=Nk - qph5['ao_basis'].attrs['df_num']=naux + qph5.create_group('ao_two_e_ints') + qph5['ao_two_e_ints'].attrs['df_num']=naux + + qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis + ao_nucl=[mf.cell.bas_atom(i)+1 for i in range(nao)] + qph5.create_dataset('ao_basis/ao_nucl',data=Nk*ao_nucl) + # _ # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ diff --git a/src/utils_periodic/create_ezfio_complex_3idx.py b/src/utils_periodic/create_ezfio_complex_3idx.py index c0315d1e..ff7fbbd7 100755 --- a/src/utils_periodic/create_ezfio_complex_3idx.py +++ b/src/utils_periodic/create_ezfio_complex_3idx.py @@ -12,28 +12,38 @@ h5filename = sys.argv[2] #n_kpts = int(sys.argv[7]) #n_aux = int(sys.argv[8]) ezfio.set_file(filename) -qph5=h5py.File(h5filename.'r') +qph5=h5py.File(h5filename,'r') + +kpt_num = qph5['nuclei'].attrs['kpt_num'] +ezfio.set_nuclei_kpt_num(kpt_num) + +# should this be in ao_basis? ao_two_e_ints? +df_num = qph5['ao_two_e_ints'].attrs['df_num'] +ezfio.set_ao_two_e_ints_df_num(df_num) + +# these are totals (kpt_num * num_per_kpt) +# need to change if we want to truncate orbital space within pyscf ezfio.electrons_elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] ezfio.electrons_elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] - nucl_num = qph5['nuclei'].attrs['nucl_num'] -kpt_num = qph5['nuclei'].attrs['kpt_num'] -df_num = qph5['ao_basis'].attrs['df_num'] +nucl_num_per_kpt = nucl_num // kpt_num ao_num = qph5['ao_basis'].attrs['ao_num'] - mo_num = qph5['mo_basis'].attrs['mo_num'] + ezfio.set_mo_basis_mo_num(mo_num) -#ao_num = mo_num -#Important ! -import math -nelec_per_kpt = num_elec // n_kpts -nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) -nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) -ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) -ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + +##ao_num = mo_num +##Important ! +#import math +#nelec_per_kpt = num_elec // n_kpts +#nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) +#nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) +# +#ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) +#ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) @@ -41,13 +51,26 @@ ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) #ezfio.set_utils_num_kpts(n_kpts) #ezfio.set_integrals_bielec_df_num(n_aux) -#Important -ezfio.set_nuclei_nucl_num(nucl_num) -ezfio.set_nuclei_nucl_charge([0.]*nucl_num) -ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) -ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) +#(old)Important +#ezfio.set_nuclei_nucl_num(nucl_num) +#ezfio.set_nuclei_nucl_charge([0.]*nucl_num) +#ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) +#ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + +ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) + +nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() +ezfio.set_nuclei_nucl_charge(nucl_charge) + +nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() +ezfio.set_nuclei_nucl_coord(nucl_coord) + +nucl_label=qph5['nuclei/nucl_label'][()].tolist() +ezfio.set_nuclei_nucl_label(nucl_label) + ezfio.set_nuclei_io_nuclear_repulsion('Read') +nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) # Ao num @@ -56,7 +79,11 @@ ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") ezfio.set_ao_basis_ao_num(ao_num) ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff -#Just need one +#ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) +#ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + + +#Just need one (can clean this up later) ao_prim_num_max = 5 d = [ [0] *ao_prim_num_max]*ao_num @@ -72,8 +99,15 @@ ezfio.set_mo_basis_ao_md5(ao_md5) ezfio.set_mo_basis_mo_num(mo_num) -c_mo = [[1 if i==j else 0 for i in range(mo_num)] for j in range(ao_num)] -ezfio.set_mo_basis_mo_coef([ [0]*mo_num] * ao_num) -#ezfio.set_mo_basis_mo_coef_real(c_mo) +#c_mo = [[1 if i==j else 0 for i in range(mo_num)] for j in range(ao_num)] +#ezfio.set_mo_basis_mo_coef([ [0]*mo_num] * ao_num) +##ezfio.set_mo_basis_mo_coef_real(c_mo) + + +ezfio.set_mo_basis_mo_coef_real(qph5['mo_basis/mo_coef_real'][()].tolist()) +ezfio.set_mo_basis_mo_coef_imag(qph5['mo_basis/mo_coef_imag'][()].tolist()) + +#maybe fix qp so we don't need this? +ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) ezfio.set_nuclei_is_periodic(True) From 3ca3dc30611ac725358d78754276e441b4f476a1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 11 Feb 2020 17:35:28 -0600 Subject: [PATCH 069/256] working on complex 3-index integrals --- src/ao_basis/EZFIO.cfg | 5 ++ src/ao_basis/aos_complex.irp.f | 7 ++ src/ao_two_e_ints/EZFIO.cfg | 18 +++++ src/ao_two_e_ints/df_ao_ints.irp.f | 49 +++++++++++++ src/mo_basis/EZFIO.cfg | 5 ++ src/mo_basis/mos_complex.irp.f | 8 +++ src/mo_two_e_ints/EZFIO.cfg | 18 +++++ src/mo_two_e_ints/df_mo_ints.irp.f | 107 +++++++++++++++++++++++++++++ src/nuclei/EZFIO.cfg | 5 ++ src/nuclei/kconserv_complex.irp.f | 5 ++ 10 files changed, 227 insertions(+) create mode 100644 src/ao_basis/aos_complex.irp.f create mode 100644 src/ao_two_e_ints/df_ao_ints.irp.f create mode 100644 src/mo_two_e_ints/df_mo_ints.irp.f diff --git a/src/ao_basis/EZFIO.cfg b/src/ao_basis/EZFIO.cfg index c3e2761b..b23d8b22 100644 --- a/src/ao_basis/EZFIO.cfg +++ b/src/ao_basis/EZFIO.cfg @@ -55,3 +55,8 @@ doc: If |true|, use |AOs| in Cartesian coordinates (6d,10f,...) interface: ezfio, provider default: false +[ao_kpt_num] +type: integer +doc: Number of |AOs| per kpt +interface: ezfio + diff --git a/src/ao_basis/aos_complex.irp.f b/src/ao_basis/aos_complex.irp.f new file mode 100644 index 00000000..8ed10c43 --- /dev/null +++ b/src/ao_basis/aos_complex.irp.f @@ -0,0 +1,7 @@ +BEGIN_PROVIDER [ integer, ao_kpt_num ] + implicit none + BEGIN_DOC + ! number of aos per kpt. + END_DOC + ao_kpt_num = ao_num/kpt_num +END_PROVIDER diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg index a99a05d2..fad4c836 100644 --- a/src/ao_two_e_ints/EZFIO.cfg +++ b/src/ao_two_e_ints/EZFIO.cfg @@ -23,3 +23,21 @@ type: integer doc: Size of df basis interface: ezfio, provider +[io_df_ao_integrals] +type: Disk_access +doc: Read/Write df |AO| integrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + +[df_ao_integrals_real] +type: double precision +doc: Real part of the df integrals over AOs +size: (ao_basis.ao_kpt_num,ao_basis.ao_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +interface: ezfio + +[df_ao_integrals_imag] +type: double precision +doc: Imaginary part of the df integrals over AOs +size: (ao_basis.ao_kpt_num,ao_basis.ao_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +interface: ezfio + diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f new file mode 100644 index 00000000..20f5f21c --- /dev/null +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -0,0 +1,49 @@ + BEGIN_PROVIDER [double precision, df_ao_integrals_real, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [double precision, df_ao_integrals_imag, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] + implicit none + BEGIN_DOC + ! df AO integrals + END_DOC + integer :: i,j,k,l + + if (read_df_ao_integrals) then + df_ao_integrals_real = 0.d0 + df_ao_integrals_imag = 0.d0 + call ezfio_get_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) + call ezfio_get_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) + print *, 'df AO integrals read from disk' + do l=1,kpt_pair_num + do k=1,df_num + do j=1,ao_kpt_num + do i=1,ao_kpt_num + df_ao_integrals_complex(i,j,k,l) = dcmplx(df_ao_integrals_real(i,j,k,l), & + df_ao_integrals_imag(i,j,k,l)) + enddo + enddo + enddo + enddo + else + print*,'df ao integrals must be provided',irp_here + stop -1 + endif + + if (write_df_ao_integrals) then + ! this probably shouldn't happen + do l=1,kpt_pair_num + do k=1,df_num + do j=1,ao_kpt_num + do i=1,ao_kpt_num + df_ao_integrals_real(i,j,k,l) = dble(df_ao_integrals_complex(i,j,k,l)) + df_ao_integrals_imag(i,j,k,l) = dimag(df_ao_integrals_complex(i,j,k,l)) + enddo + enddo + enddo + enddo + call ezfio_set_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) + call ezfio_set_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) + print *, 'df AO integrals written to disk' + endif + +END_PROVIDER + diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index 7a1c3a0a..f667f04f 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -43,3 +43,8 @@ type: character*(32) doc: MD5 checksum characterizing the |AO| basis set. interface: ezfio +[mo_kpt_num] +type: integer +doc: Number of |MOs| per kpt +interface: ezfio + diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index 75d3e169..35987220 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -1,3 +1,11 @@ +BEGIN_PROVIDER [ integer, mo_kpt_num ] + implicit none + BEGIN_DOC + ! number of mos per kpt. + END_DOC + mo_kpt_num = mo_num/kpt_num +END_PROVIDER + BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] implicit none BEGIN_DOC diff --git a/src/mo_two_e_ints/EZFIO.cfg b/src/mo_two_e_ints/EZFIO.cfg index bec74552..92bc086c 100644 --- a/src/mo_two_e_ints/EZFIO.cfg +++ b/src/mo_two_e_ints/EZFIO.cfg @@ -11,3 +11,21 @@ interface: ezfio,provider,ocaml default: 1.e-15 ezfio_name: threshold_mo +[io_df_mo_integrals] +type: Disk_access +doc: Read/Write df |MO| integrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + +[df_mo_integrals_real] +type: double precision +doc: Real part of the df integrals over MOs +size: (mo_basis.mo_kpt_num,mo_basis.mo_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +interface: ezfio + +[df_mo_integrals_imag] +type: double precision +doc: Imaginary part of the df integrals over MOs +size: (mo_basis.mo_kpt_num,mo_basis.mo_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +interface: ezfio + diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f new file mode 100644 index 00000000..62eb683f --- /dev/null +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -0,0 +1,107 @@ + BEGIN_PROVIDER [double precision, df_mo_integrals_real, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [double precision, df_mo_integrals_imag, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] + implicit none + BEGIN_DOC + ! df AO integrals + END_DOC + integer :: i,j,k,l + + if (read_df_mo_integrals) then + df_mo_integrals_real = 0.d0 + df_mo_integrals_imag = 0.d0 + call ezfio_get_mo_two_e_ints_df_mo_integrals_real(df_mo_integrals_real) + call ezfio_get_mo_two_e_ints_df_mo_integrals_imag(df_mo_integrals_imag) + print *, 'df AO integrals read from disk' + do l=1,kpt_pair_num + do k=1,df_num + do j=1,mo_kpt_num + do i=1,mo_kpt_num + df_mo_integrals_complex(i,j,k,l) = dcmplx(df_mo_integrals_real(i,j,k,l), & + df_mo_integrals_imag(i,j,k,l)) + enddo + enddo + enddo + enddo + else + call df_mo_from_df_ao(df_mo_integrals_complex,df_ao_integrals_complex,mo_kpt_num,ao_kpt_num,df_num,kpt_pair_num) + endif + + if (write_df_mo_integrals) then + do l=1,kpt_pair_num + do k=1,df_num + do j=1,mo_kpt_num + do i=1,mo_kpt_num + df_mo_integrals_real(i,j,k,l) = dble(df_mo_integrals_complex(i,j,k,l)) + df_mo_integrals_imag(i,j,k,l) = dimag(df_mo_integrals_complex(i,j,k,l)) + enddo + enddo + enddo + enddo + call ezfio_set_mo_two_e_ints_df_mo_integrals_real(df_mo_integrals_real) + call ezfio_set_mo_two_e_ints_df_mo_integrals_imag(df_mo_integrals_imag) + print *, 'df AO integrals written to disk' + endif + +END_PROVIDER + +subroutine df_mo_from_df_ao(df_mo,df_ao,n_mo,n_ao,n_df,n_k_pairs) + use map_module + implicit none + BEGIN_DOC + ! create 3-idx mo ints from 3-idx ao ints + END_DOC + integer,intent(in) :: n_mo,n_ao,n_df,n_k_pairs + complex*16,intent(out) :: df_mo(n_mo,n_mo,n_df,n_k_pairs) + complex*16,intent(in) :: df_ao(n_ao,n_ao,n_df,n_k_pairs) + integer :: kl,kj,kjkl2,mu,p,q + complex*16,allocatable :: coef_l(:,:), coef_j(:,:), ints_jl(:,:), ints_tmp(:,:) + double precision :: wall_1,wall_2,cpu_1,cpu_2 + + print*,'providing 3-index MO integrals from 3-index AO integrals' + + call wall_time(wall_1) + call cpu_time(cpu_1) + allocate( & + coef_l(n_ao,n_mo),& + coef_j(n_ao,n_mo),& + ints_jl(n_ao,n_ao),& + ints_tmp(n_mo,n_ao)& + ) + + do kl=1, kpt_num + coef_l = mo_coef_kpts(:,:,kl) + do kj=1, kl + coef_j = mo_coef_kpts(:,:,kj) + kjkl2 = kj+shiftr(kl*kl-kl,1) + do mu=1, df_num + ints_jl = df_ao(:,:,mu,kjkl2) + call zgemm('C','N',n_mo,n_ao,n_ao, & + (1.d0,0.d0), coef_j, n_ao, & + ints_jl, n_ao, & + (0.d0,0.d0), ints_tmp, n_mo) + + call zgemm('N','N',n_mo,n_mo,n_ao, & + (1.d0,0.d0), ints_tmp, n_mo, & + coef_l, n_ao, & + (0.d0,0.d0), df_mo(:,:,mu,kjkl2), n_mo) + enddo + enddo + call wall_time(wall_2) + print*,100.*float(kl*(kl+1))/(2.*n_k_pairs), '% in ', & + wall_2-wall_1, 's' + enddo + + deallocate( & + coef_l, & + coef_j, & + ints_jl, & + ints_tmp & + ) + call wall_time(wall_2) + call cpu_time(cpu_2) + print*,' 3-idx MO provided' + print*,' cpu time:',cpu_2-cpu_1,'s' + print*,' wall time:',wall_2-wall_1,'s ( x ',(cpu_2-cpu_1)/(wall_2-wall_1),')' + +end subroutine df_mo_from_df_ao diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index b95385f5..1bd38194 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -49,6 +49,11 @@ doc: Number of k-points type: integer interface: ezfio, provider +[kpt_pair_num] +doc: Number of k-point pairs +type: integer +interface: ezfio + [kconserv] type: integer doc: array containing information about k-point symmetry diff --git a/src/nuclei/kconserv_complex.irp.f b/src/nuclei/kconserv_complex.irp.f index 11eb7daf..8978ed9b 100644 --- a/src/nuclei/kconserv_complex.irp.f +++ b/src/nuclei/kconserv_complex.irp.f @@ -1,3 +1,8 @@ +BEGIN_PROVIDER [integer, kpt_pair_num] + implicit none + kpt_pair_num = shiftr(kpt_num*kpt_num+kpt_num,1) +END_PROVIDER + BEGIN_PROVIDER [integer, kconserv, (kpt_num,kpt_num,kpt_num)] implicit none BEGIN_DOC From 4374145954f8a2edd4177d4ea71b01cf871a7b29 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 11 Feb 2020 18:23:34 -0600 Subject: [PATCH 070/256] rename periodic -> complex --- REPLACE | 30 ++++++++++ src/ao_one_e_ints/ao_overlap.irp.f | 2 +- src/ao_two_e_ints/map_integrals.irp.f | 8 +-- src/ao_two_e_ints/map_integrals_complex.irp.f | 46 +++++++------- src/ao_two_e_ints/two_e_integrals.irp.f | 6 +- src/bitmask/track_orb.irp.f | 4 +- src/hartree_fock/hf_energy.irp.f | 2 +- src/hartree_fock/scf.irp.f | 6 +- src/mo_basis/mos.irp.f | 2 +- src/mo_basis/utils.irp.f | 6 +- src/mo_guess/h_core_guess_routine.irp.f | 2 +- src/mo_one_e_ints/orthonormalize.irp.f | 2 +- src/mo_two_e_ints/core_quantities.irp.f | 8 +-- .../four_idx_novvvv_complex.irp.f | 10 ++-- src/mo_two_e_ints/integrals_3_index.irp.f | 10 ++-- src/mo_two_e_ints/map_integrals.irp.f | 4 +- src/mo_two_e_ints/map_integrals_complex.irp.f | 60 +++++++++---------- src/mo_two_e_ints/mo_bi_integrals.irp.f | 32 +++++----- src/nuclei/EZFIO.cfg | 2 +- src/scf_utils/fock_matrix.irp.f | 6 +- src/utils_periodic/dump_ao_2e_complex.irp.f | 4 +- .../export_integrals_ao_periodic.irp.f | 14 ++--- .../import_integrals_ao_periodic.irp.f | 8 +-- .../import_mo_coef_periodic.irp.f | 2 +- src/utils_periodic/qp2-pbc-diff.txt | 40 ++++++------- 25 files changed, 173 insertions(+), 143 deletions(-) diff --git a/REPLACE b/REPLACE index 1f9fff4b..42d530b0 100755 --- a/REPLACE +++ b/REPLACE @@ -839,3 +839,33 @@ qp_name nucl_elec_ref_bitmask_energy -r ref_bitmask_n_e_energy qp_name ref_bitmask_e_n_energy -r ref_bitmask_n_e_energy qp_name read_ao_integrals_e_n -r read_ao_integrals_n_e qp_name write_ao_integrals_e_n -r write_ao_integrals_n_e +qp_name is_periodic -r is_complex +qp_name two_e_integrals_index_periodic -r two_e_integrals_index_complex +qp_name get_ao_two_e_integral_periodic -r get_ao_two_e_integral_complex +qp_name import_ao_integrals_periodic -r import_ao_integrals_complex +qp_name ao_two_e_integral_periodic_map_idx_sign -r ao_two_e_integral_complex_map_idx_sign +qp_name ao_ints_periodic_1 -r ao_ints_complex_1 +qp_name ao_ints_periodic_2 -r ao_ints_complex_2 +qp_name import_mo_coef_periodic -r import_mo_coef_complex +qp_name is_periodic -r is_complex +qp_name get_ao_two_e_integral_periodic_simple -r get_ao_two_e_integral_complex_simple +qp_name ao_integrals_cache_periodic -r ao_integrals_cache_complex +qp_name get_two_e_integral_periodic -r get_two_e_integral_complex +qp_name get_ao_two_e_integrals_non_zero_periodic -r get_ao_two_e_integrals_non_zero_complex +qp_name get_mo_two_e_integrals_exch_ii_periodic -r get_mo_two_e_integrals_exch_ii_complex +qp_name mo_ints_periodic_2 -r mo_ints_complex_2 +qp_name mo_ints_periodic_1 -r mo_ints_complex_1 +qp_name get_mo_two_e_integrals_i1j1_periodic -r get_mo_two_e_integrals_i1j1_complex +qp_name get_mo_two_e_integrals_exch_ijji_periodic -r get_mo_two_e_integrals_exch_ijji_complex +qp_name get_mo_two_e_integrals_periodic -r get_mo_two_e_integrals_complex +qp_name mo_integrals_cache_periodic -r mo_integrals_cache_complex +qp_name get_two_e_integral_periodic_simple -r get_two_e_integral_complex_simple +qp_name big_array_coulomb_integrals_periodic -r big_array_coulomb_integrals_complex +qp_name big_array_exchange_integrals_periodic -r big_array_exchange_integrals_complex +qp_name get_ao_two_e_integrals_periodic -r get_ao_two_e_integrals_complex +qp_name get_ao_two_e_integrals_non_zero_jl_periodic -r get_ao_two_e_integrals_non_zero_jl_complex +qp_name get_ao_two_e_integrals_non_zero_jl_from_list_periodic -r get_ao_two_e_integrals_non_zero_jl_from_list_complex +qp_name mo_two_e_integral_periodic -r mo_two_e_integral_complex +qp_name get_mo_two_e_integrals_ij_periodic -r get_mo_two_e_integrals_ij_complex +qp_name get_mo_two_e_integrals_coulomb_ii_periodic -r get_mo_two_e_integrals_coulomb_ii_complex +qp_name get_mo_two_e_integrals_coulomb_ijij_periodic -r get_mo_two_e_integrals_coulomb_ijij_complex diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 49b75731..52a0ea1c 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -118,7 +118,7 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ] double precision :: A_center(3), B_center(3) integer :: power_A(3), power_B(3) double precision :: lower_exp_val, dx - if (is_periodic) then + if (is_complex) then do j=1,ao_num do i= 1,ao_num ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j)) diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 5fd3264b..8e213482 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [ type(map_type), ao_integrals_map ] integer(key_kind) :: key_max integer(map_size_kind) :: sze call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max) - if (is_periodic) then + if (is_complex) then sze = key_max*2 call map_init(ao_integrals_map,sze) call map_init(ao_integrals_map_2,sze) @@ -263,7 +263,7 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z integer :: i integer(key_kind) :: hash double precision :: thresh,tmp - if(is_periodic) then + if(is_complex) then print*,'not implemented for periodic:',irp_here stop -1 endif @@ -311,7 +311,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out integer(key_kind) :: hash double precision :: tmp - if(is_periodic) then + if(is_complex) then print*,'not implemented for periodic:',irp_here stop -1 endif @@ -361,7 +361,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s integer(key_kind) :: hash double precision :: tmp - if(is_periodic) then + if(is_complex) then print*,'not implemented for periodic:',irp_here stop -1 endif diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f index 3359d535..dc4e5542 100644 --- a/src/ao_two_e_ints/map_integrals_complex.irp.f +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -1,7 +1,7 @@ use map_module -subroutine two_e_integrals_index_periodic(i,j,k,l,i1,p,q) +subroutine two_e_integrals_index_complex(i,j,k,l,i1,p,q) use map_module implicit none BEGIN_DOC @@ -138,7 +138,7 @@ subroutine two_e_integrals_index_reverse_complex_2(i,j,k,l,i1) end -BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] +BEGIN_PROVIDER [ complex*16, ao_integrals_cache_complex, (0:64*64*64*64) ] implicit none BEGIN_DOC ! Cache of AO integrals for fast access @@ -151,7 +151,7 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] complex(integral_kind) :: integral integer(key_kind) :: p,q,r,s,ik,jl logical :: ilek, jlel, iklejl - complex*16 :: get_ao_two_e_integral_periodic_simple + complex*16 :: get_ao_two_e_integral_complex_simple !$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, & @@ -161,14 +161,14 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] do j=ao_integrals_cache_min,ao_integrals_cache_max do i=ao_integrals_cache_min,ao_integrals_cache_max !DIR$ FORCEINLINE - integral = get_ao_two_e_integral_periodic_simple(i,j,k,l,& + integral = get_ao_two_e_integral_complex_simple(i,j,k,l,& ao_integrals_map,ao_integrals_map_2) ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - ao_integrals_cache_periodic(ii) = integral + ao_integrals_cache_complex(ii) = integral enddo enddo enddo @@ -177,7 +177,7 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] END_PROVIDER -subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) +subroutine ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx,sign) use map_module implicit none BEGIN_DOC @@ -209,7 +209,7 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) double precision, intent(out) :: sign integer(key_kind) :: p,q,r,s,ik,jl,ij,kl !DIR$ FORCEINLINE - call two_e_integrals_index_periodic(i,j,k,l,idx,ik,jl) + call two_e_integrals_index_complex(i,j,k,l,idx,ik,jl) p = min(i,j) r = max(i,j) ij = p+shiftr(r*r-r,1) @@ -267,7 +267,7 @@ subroutine ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) endif end -complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) +complex*16 function get_ao_two_e_integral_complex_simple(i,j,k,l,map,map2) result(result) use map_module implicit none BEGIN_DOC @@ -285,7 +285,7 @@ complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) resu double precision :: sign ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) PROVIDE ao_two_e_integrals_in_map - call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx,sign) if (use_map1) then call map_get(map,idx,tmp_re) call map_get(map,idx+1,tmp_im) @@ -304,7 +304,7 @@ complex*16 function get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) resu end -complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(result) +complex*16 function get_ao_two_e_integral_complex(i,j,k,l,map,map2) result(result) use map_module implicit none BEGIN_DOC @@ -317,11 +317,11 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(resu type(map_type), intent(inout) :: map,map2 integer :: ii complex(integral_kind) :: tmp - complex(integral_kind) :: get_ao_two_e_integral_periodic_simple + complex(integral_kind) :: get_ao_two_e_integral_complex_simple integer(key_kind) :: p,q,r,s,ik,jl logical :: ilek, jlel, iklejl ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) - PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min + PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_complex ao_integrals_cache_min !DIR$ FORCEINLINE ! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then ! tmp = (0.d0,0.d0) @@ -334,20 +334,20 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map,map2) result(resu ii = ior(ii, j-ao_integrals_cache_min) ii = ior(ii, i-ao_integrals_cache_min) if (iand(ii, -64) /= 0) then - tmp = get_ao_two_e_integral_periodic_simple(i,j,k,l,map,map2) + tmp = get_ao_two_e_integral_complex_simple(i,j,k,l,map,map2) else ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - tmp = ao_integrals_cache_periodic(ii) + tmp = ao_integrals_cache_complex(ii) endif result = tmp endif end -subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) +subroutine get_ao_two_e_integrals_complex(j,k,l,sze,out_val) use map_module BEGIN_DOC ! Gets multiple AO bi-electronic integral from the AO map . @@ -369,14 +369,14 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) return endif - complex*16 :: get_ao_two_e_integral_periodic + complex*16 :: get_ao_two_e_integral_complex do i=1,sze - out_val(i) = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + out_val(i) = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) enddo end -subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_complex(j,k,l,sze,out_val,out_val_index,non_zero_int) print*,'not implemented for periodic',irp_here stop -1 ! use map_module @@ -392,7 +392,7 @@ subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_in ! integer :: i ! integer(key_kind) :: hash ! double precision :: thresh,tmp -! if(is_periodic) then +! if(is_complex) then ! print*,'not implemented for periodic:',irp_here ! stop -1 ! endif @@ -424,7 +424,7 @@ subroutine get_ao_two_e_integrals_non_zero_periodic(j,k,l,sze,out_val,out_val_in end -subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_jl_complex(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) print*,'not implemented for periodic',irp_here stop -1 ! use map_module @@ -442,7 +442,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,ou ! integer(key_kind) :: hash ! double precision :: tmp ! -! if(is_periodic) then +! if(is_complex) then ! print*,'not implemented for periodic:',irp_here ! stop -1 ! endif @@ -475,7 +475,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_periodic(j,l,thresh,sze_max,sze,ou end -subroutine get_ao_two_e_integrals_non_zero_jl_from_list_periodic(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) +subroutine get_ao_two_e_integrals_non_zero_jl_from_list_complex(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) print*,'not implemented for periodic',irp_here stop -1 ! use map_module @@ -494,7 +494,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list_periodic(j,l,thresh,list ! integer(key_kind) :: hash ! double precision :: tmp ! -! if(is_periodic) then +! if(is_complex) then ! print*,'not implemented for periodic:',irp_here ! stop -1 ! endif diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f index e3ca0566..f3bb5c20 100644 --- a/src/ao_two_e_ints/two_e_integrals.irp.f +++ b/src/ao_two_e_ints/two_e_integrals.irp.f @@ -351,11 +351,11 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ] double precision :: map_mb PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals - if (is_periodic) then + if (is_complex) then if (read_ao_two_e_integrals) then print*,'Reading the AO integrals (periodic)' - call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) - call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) + call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map) + call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2) print*, 'AO integrals provided (periodic)' ao_two_e_integrals_in_map = .True. return diff --git a/src/bitmask/track_orb.irp.f b/src/bitmask/track_orb.irp.f index 9c430467..73bf78f3 100644 --- a/src/bitmask/track_orb.irp.f +++ b/src/bitmask/track_orb.irp.f @@ -22,7 +22,7 @@ subroutine initialize_mo_coef_begin_iteration ! ! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef` END_DOC - if (is_periodic) then + if (is_complex) then mo_coef_begin_iteration_complex = mo_coef_complex else mo_coef_begin_iteration = mo_coef @@ -40,7 +40,7 @@ subroutine reorder_core_orb integer, allocatable :: index_core_orb(:),iorder(:) double precision, allocatable :: accu(:) integer :: i1,i2 - if (is_periodic) then + if (is_complex) then complex*16, allocatable :: accu_c(:) allocate(accu(mo_num),accu_c(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) do i = 1, n_core_orb diff --git a/src/hartree_fock/hf_energy.irp.f b/src/hartree_fock/hf_energy.irp.f index 66b9deb2..db723600 100644 --- a/src/hartree_fock/hf_energy.irp.f +++ b/src/hartree_fock/hf_energy.irp.f @@ -22,7 +22,7 @@ END_PROVIDER HF_energy = nuclear_repulsion HF_two_electron_energy = 0.d0 HF_one_electron_energy = 0.d0 - if (is_periodic) then + if (is_complex) then complex*16 :: hf_1e_tmp, hf_2e_tmp hf_1e_tmp = (0.d0,0.d0) hf_2e_tmp = (0.d0,0.d0) diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index fabe9dd1..8dddda92 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -48,7 +48,7 @@ subroutine create_guess call ezfio_has_mo_basis_mo_coef(exists) if (.not.exists) then if (mo_guess_type == "HCore") then - if (is_periodic) then + if (is_complex) then mo_coef_complex = ao_ortho_lowdin_coef_complex TOUCH mo_coef_complex mo_label = 'Guess' @@ -68,7 +68,7 @@ subroutine create_guess SOFT_TOUCH mo_coef mo_label endif else if (mo_guess_type == "Huckel") then - if (is_periodic) then + if (is_complex) then call huckel_guess_complex else call huckel_guess @@ -92,7 +92,7 @@ subroutine run integer :: i_it, i, j, k mo_label = "Orthonormalized" - if (is_periodic) then + if (is_complex) then call roothaan_hall_scf_complex else call roothaan_hall_scf diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 04386e6b..50ae3952 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -252,7 +252,7 @@ subroutine mix_mo_jk(j,k) dsqrt_2 = 1.d0/dsqrt(2.d0) i_plus = min(j,k) i_minus = max(j,k) - if (is_periodic) then + if (is_complex) then complex*16 :: array_tmp_c(ao_num,2) array_tmp_c = (0.d0,0.d0) do i = 1, ao_num diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 4db5d3e9..a84f9fb7 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -10,7 +10,7 @@ subroutine save_mos call ezfio_set_mo_basis_mo_num(mo_num) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) - if (is_periodic) then + if (is_complex) then allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) buffer = 0.d0 buffer_im = 0.d0 @@ -49,7 +49,7 @@ subroutine save_mos_no_occ !call ezfio_set_mo_basis_mo_num(mo_num) !call ezfio_set_mo_basis_mo_label(mo_label) !call ezfio_set_mo_basis_ao_md5(ao_md5) - if (is_periodic) then + if (is_complex) then allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) buffer = 0.d0 buffer_im = 0.d0 @@ -86,7 +86,7 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_num(n) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) - if (is_periodic) then + if (is_complex) then allocate ( buffer(ao_num,n),buffer_im(ao_num,n)) buffer = 0.d0 buffer_im = 0.d0 diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index 429f77ec..b3de1940 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -5,7 +5,7 @@ subroutine hcore_guess implicit none character*(64) :: label label = "Guess" - if (is_periodic) then + if (is_complex) then call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_complex, & size(mo_one_e_integrals_complex,1), & size(mo_one_e_integrals_complex,2),label,1,.false.) diff --git a/src/mo_one_e_ints/orthonormalize.irp.f b/src/mo_one_e_ints/orthonormalize.irp.f index aa8d85bc..d9675bc8 100644 --- a/src/mo_one_e_ints/orthonormalize.irp.f +++ b/src/mo_one_e_ints/orthonormalize.irp.f @@ -1,7 +1,7 @@ subroutine orthonormalize_mos implicit none integer :: m,p,s - if (is_periodic) then + if (is_complex) then m = size(mo_coef_complex,1) p = size(mo_overlap_complex,1) call ortho_lowdin_complex(mo_overlap_complex,p,mo_num,mo_coef_complex,m,ao_num) diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f index 349b0cd1..8afbcd83 100644 --- a/src/mo_two_e_ints/core_quantities.irp.f +++ b/src/mo_two_e_ints/core_quantities.irp.f @@ -5,7 +5,7 @@ BEGIN_PROVIDER [double precision, core_energy] END_DOC integer :: i,j,k,l core_energy = 0.d0 - if (is_periodic) then + if (is_complex) then do i = 1, n_core_orb j = list_core(i) core_energy += 2.d0 * dble(mo_one_e_integrals_complex(j,j)) + mo_two_e_integrals_jj(j,j) @@ -51,7 +51,7 @@ END_PROVIDER BEGIN_PROVIDER [complex*16, core_fock_operator_complex, (mo_num,mo_num)] implicit none integer :: i,j,k,l,m,n - complex*16 :: get_two_e_integral_periodic + complex*16 :: get_two_e_integral_complex BEGIN_DOC ! this is the contribution to the Fock operator from the core electrons END_DOC @@ -63,8 +63,8 @@ BEGIN_PROVIDER [complex*16, core_fock_operator_complex, (mo_num,mo_num)] do m = 1, n_core_orb n = list_core(m) core_fock_operator_complex(j,l) += 2.d0 * & - get_two_e_integral_periodic(j,n,l,n,mo_integrals_map,mo_integrals_map_2) - & - get_two_e_integral_periodic(j,n,n,l,mo_integrals_map,mo_integrals_map_2) + get_two_e_integral_complex(j,n,l,n,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex(j,n,n,l,mo_integrals_map,mo_integrals_map_2) enddo enddo enddo diff --git a/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f b/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f index e02de3b7..0f129256 100644 --- a/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f +++ b/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f @@ -79,7 +79,7 @@ subroutine four_idx_novvvv_complex integer :: i,j,k,l,n_integrals1,n_integrals2 logical :: use_map1 complex*16, allocatable :: f(:,:,:), f2(:,:,:), d(:,:), T(:,:,:,:), T2(:,:,:,:) - complex*16, external :: get_ao_two_e_integral_periodic + complex*16, external :: get_ao_two_e_integral_complex integer(key_kind), allocatable :: idx1(:),idx2(:) complex(integral_kind), allocatable :: values1(:),values2(:) double precision :: sign_tmp @@ -107,8 +107,8 @@ subroutine four_idx_novvvv_complex do r=1,ao_num do q=1,ao_num do p=1,r - f (p,q,r) = get_ao_two_e_integral_periodic(p,q,r,s,ao_integrals_map,ao_integrals_map_2) - f (r,q,p) = get_ao_two_e_integral_periodic(r,q,p,s,ao_integrals_map,ao_integrals_map_2) + f (p,q,r) = get_ao_two_e_integral_complex(p,q,r,s,ao_integrals_map,ao_integrals_map_2) + f (r,q,p) = get_ao_two_e_integral_complex(r,q,p,s,ao_integrals_map,ao_integrals_map_2) enddo enddo enddo @@ -146,7 +146,7 @@ subroutine four_idx_novvvv_complex n_integrals2 = 0 do l=1,mo_num do k=1,mo_num - call ao_two_e_integral_periodic_map_idx_sign(list_core_inact_act(i),list_core_inact_act(j),k,l,use_map1,idx_tmp,sign_tmp) + call ao_two_e_integral_complex_map_idx_sign(list_core_inact_act(i),list_core_inact_act(j),k,l,use_map1,idx_tmp,sign_tmp) if (use_map1) then n_integrals1+=1 values1(n_integrals1) = dble(d(k,l)) @@ -176,7 +176,7 @@ subroutine four_idx_novvvv_complex n_integrals2 = 0 do l=1,mo_num do k=1,mo_num - call ao_two_e_integral_periodic_map_idx_sign(list_core_inact_act(i),k,list_core_inact_act(j),l,use_map1,idx_tmp,sign_tmp) + call ao_two_e_integral_complex_map_idx_sign(list_core_inact_act(i),k,list_core_inact_act(j),l,use_map1,idx_tmp,sign_tmp) if (use_map1) then n_integrals1+=1 values1(n_integrals1) = dble(d(k,l)) diff --git a/src/mo_two_e_ints/integrals_3_index.irp.f b/src/mo_two_e_ints/integrals_3_index.irp.f index 33d201d8..811ae493 100644 --- a/src/mo_two_e_ints/integrals_3_index.irp.f +++ b/src/mo_two_e_ints/integrals_3_index.irp.f @@ -25,8 +25,8 @@ END_PROVIDER - BEGIN_PROVIDER [complex*16, big_array_coulomb_integrals_periodic, (mo_num,mo_num, mo_num)] -&BEGIN_PROVIDER [complex*16, big_array_exchange_integrals_periodic,(mo_num,mo_num, mo_num)] + BEGIN_PROVIDER [complex*16, big_array_coulomb_integrals_complex, (mo_num,mo_num, mo_num)] +&BEGIN_PROVIDER [complex*16, big_array_exchange_integrals_complex,(mo_num,mo_num, mo_num)] implicit none BEGIN_DOC ! big_array_coulomb_integrals(j,i,k) = = (ik|jj) @@ -37,17 +37,17 @@ END_PROVIDER ! b_a_exch_int(j,i,k) = b_a_exch_int(j,k,i)* END_DOC integer :: i,j,k,l - complex*16 :: get_two_e_integral_periodic + complex*16 :: get_two_e_integral_complex complex*16 :: integral do k = 1, mo_num do i = 1, mo_num do j = 1, mo_num l = j - integral = get_two_e_integral_periodic(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + integral = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) big_array_coulomb_integrals(j,i,k) = integral l = j - integral = get_two_e_integral_periodic(i,j,l,k,mo_integrals_map,mo_integrals_map_2) + integral = get_two_e_integral_complex(i,j,l,k,mo_integrals_map,mo_integrals_map_2) big_array_exchange_integrals(j,i,k) = integral enddo enddo diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 9374ea80..bc69e10a 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/src/mo_two_e_ints/map_integrals.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [ type(map_type), mo_integrals_map ] integer(key_kind) :: key_max integer(map_size_kind) :: sze call two_e_integrals_index(mo_num,mo_num,mo_num,mo_num,key_max) - if (is_periodic) then + if (is_complex) then sze = key_max*2 call map_init(mo_integrals_map,sze) call map_init(mo_integrals_map_2,sze) @@ -379,7 +379,7 @@ integer*8 function get_mo_map_size() ! Return the number of elements in the MO map END_DOC get_mo_map_size = mo_integrals_map % n_elements - if (is_periodic) then + if (is_complex) then get_mo_map_size += mo_integrals_map_2 % n_elements endif end diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_complex.irp.f index 20970a15..b4b6215b 100644 --- a/src/mo_two_e_ints/map_integrals_complex.irp.f +++ b/src/mo_two_e_ints/map_integrals_complex.irp.f @@ -16,7 +16,7 @@ subroutine insert_into_mo_integrals_map_2(n_integrals, & call map_update(mo_integrals_map_2, buffer_i, buffer_values, n_integrals, thr) end -BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8*128_8) ] +BEGIN_PROVIDER [ complex*16, mo_integrals_cache_complex, (0_8:128_8*128_8*128_8*128_8) ] implicit none BEGIN_DOC ! Cache of MO integrals for fast access @@ -27,7 +27,7 @@ BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8 integer*8 :: ii integer(key_kind) :: idx complex(integral_kind) :: integral - complex*16 :: get_two_e_integral_periodic_simple + complex*16 :: get_two_e_integral_complex_simple FREE ao_integrals_cache !$OMP PARALLEL DO PRIVATE (i,j,k,l,i4,j4,k4,l4,idx,ii,integral) do l=mo_integrals_cache_min_8,mo_integrals_cache_max_8 @@ -39,13 +39,13 @@ BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8 do i=mo_integrals_cache_min_8,mo_integrals_cache_max_8 i4 = int(i,4) !DIR$ FORCEINLINE - integral = get_two_e_integral_periodic_simple(i,j,k,l,& + integral = get_two_e_integral_complex_simple(i,j,k,l,& mo_integrals_map,mo_integrals_map_2) ii = l-mo_integrals_cache_min_8 ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8) ii = ior( shiftl(ii,7), j-mo_integrals_cache_min_8) ii = ior( shiftl(ii,7), i-mo_integrals_cache_min_8) - mo_integrals_cache_periodic(ii) = integral + mo_integrals_cache_complex(ii) = integral enddo enddo enddo @@ -55,7 +55,7 @@ BEGIN_PROVIDER [ complex*16, mo_integrals_cache_periodic, (0_8:128_8*128_8*128_8 END_PROVIDER -complex*16 function get_two_e_integral_periodic_simple(i,j,k,l,map,map2) result(result) +complex*16 function get_two_e_integral_complex_simple(i,j,k,l,map,map2) result(result) use map_module implicit none BEGIN_DOC @@ -70,7 +70,7 @@ complex*16 function get_two_e_integral_periodic_simple(i,j,k,l,map,map2) result( logical :: use_map1 double precision :: sign PROVIDE mo_two_e_integrals_in_map - call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx,sign) + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx,sign) if (use_map1) then call map_get(map,idx,tmp_re) call map_get(map,idx+1,tmp_im) @@ -88,7 +88,7 @@ complex*16 function get_two_e_integral_periodic_simple(i,j,k,l,map,map2) result( result = tmp end -complex*16 function get_two_e_integral_periodic(i,j,k,l,map,map2) +complex*16 function get_two_e_integral_complex(i,j,k,l,map,map2) use map_module implicit none BEGIN_DOC @@ -101,39 +101,39 @@ complex*16 function get_two_e_integral_periodic(i,j,k,l,map,map2) integer*8 :: ii_8 type(map_type), intent(inout) :: map,map2 complex(integral_kind) :: tmp - complex(integral_kind) :: get_two_e_integral_periodic_simple - PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + complex(integral_kind) :: get_two_e_integral_complex_simple + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_complex ii = l-mo_integrals_cache_min ii = ior(ii, k-mo_integrals_cache_min) ii = ior(ii, j-mo_integrals_cache_min) ii = ior(ii, i-mo_integrals_cache_min) if (iand(ii, -128) /= 0) then - tmp = get_two_e_integral_periodic_simple(i,j,k,l,map,map2) + tmp = get_two_e_integral_complex_simple(i,j,k,l,map,map2) else ii_8 = int(l,8)-mo_integrals_cache_min_8 ii_8 = ior( shiftl(ii_8,7), int(k,8)-mo_integrals_cache_min_8) ii_8 = ior( shiftl(ii_8,7), int(j,8)-mo_integrals_cache_min_8) ii_8 = ior( shiftl(ii_8,7), int(i,8)-mo_integrals_cache_min_8) - tmp = mo_integrals_cache_periodic(ii_8) + tmp = mo_integrals_cache_complex(ii_8) endif - get_two_e_integral_periodic = tmp + get_two_e_integral_complex = tmp end -complex*16 function mo_two_e_integral_periodic(i,j,k,l) +complex*16 function mo_two_e_integral_complex(i,j,k,l) implicit none BEGIN_DOC ! Returns one integral in the MO basis END_DOC integer, intent(in) :: i,j,k,l - complex*16 :: get_two_e_integral_periodic - PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + complex*16 :: get_two_e_integral_complex + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_complex PROVIDE mo_two_e_integrals_in_map !DIR$ FORCEINLINE - mo_two_e_integral_periodic = get_two_e_integral_periodic(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + mo_two_e_integral_complex = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) return end -subroutine get_mo_two_e_integrals_periodic(j,k,l,sze,out_val,map,map2) +subroutine get_mo_two_e_integrals_complex(j,k,l,sze,out_val,map,map2) use map_module implicit none BEGIN_DOC @@ -144,18 +144,18 @@ subroutine get_mo_two_e_integrals_periodic(j,k,l,sze,out_val,map,map2) complex*16, intent(out) :: out_val(sze) type(map_type), intent(inout) :: map,map2 integer :: i - complex*16, external :: get_two_e_integral_periodic_simple + complex*16, external :: get_two_e_integral_complex_simple integer :: ii, ii0 integer*8 :: ii_8, ii0_8 complex(integral_kind) :: tmp integer(key_kind) :: i1, idx integer(key_kind) :: p,q,r,s,i2 - PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_periodic + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_complex !DEBUG ! do i=1,sze -! out_val(i) = get_two_e_integral_periodic(i,j,k,l,map,map2) +! out_val(i) = get_two_e_integral_complex(i,j,k,l,map,map2) ! enddo ! return !DEBUG @@ -172,14 +172,14 @@ subroutine get_mo_two_e_integrals_periodic(j,k,l,sze,out_val,map,map2) ii = ior(ii0, i-mo_integrals_cache_min) if (iand(ii, -128) == 0) then ii_8 = ior( shiftl(ii0_8,7), int(i,8)-mo_integrals_cache_min_8) - out_val(i) = mo_integrals_cache_periodic(ii_8) + out_val(i) = mo_integrals_cache_complex(ii_8) else - out_val(i) = get_two_e_integral_periodic_simple(i,j,k,l,map,map2) + out_val(i) = get_two_e_integral_complex_simple(i,j,k,l,map,map2) endif enddo end -!subroutine get_mo_two_e_integrals_ij_periodic(k,l,sze,out_array,map) +!subroutine get_mo_two_e_integrals_ij_complex(k,l,sze,out_array,map) ! use map_module ! implicit none ! BEGIN_DOC @@ -233,7 +233,7 @@ end ! deallocate(pairs,hash,iorder,tmp_val) !end -!subroutine get_mo_two_e_integrals_i1j1_periodic(k,l,sze,out_array,map) +!subroutine get_mo_two_e_integrals_i1j1_complex(k,l,sze,out_array,map) ! use map_module ! implicit none ! BEGIN_DOC @@ -287,7 +287,7 @@ end ! deallocate(pairs,hash,iorder,tmp_val) !end -subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map,map2) +subroutine get_mo_two_e_integrals_coulomb_ii_complex(k,l,sze,out_val,map,map2) use map_module implicit none BEGIN_DOC @@ -311,7 +311,7 @@ subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map,map2) PROVIDE mo_two_e_integrals_in_map if (k.eq.l) then ! real, call other function - call get_mo_two_e_integrals_coulomb_ijij_periodic(k,sze,out_re,map2) + call get_mo_two_e_integrals_coulomb_ijij_complex(k,sze,out_re,map2) do i=1,sze out_val(i) = dcmplx(out_re(i),0.d0) enddo @@ -347,7 +347,7 @@ subroutine get_mo_two_e_integrals_coulomb_ii_periodic(k,l,sze,out_val,map,map2) endif end -subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map2) +subroutine get_mo_two_e_integrals_coulomb_ijij_complex(j,sze,out_val,map2) use map_module implicit none BEGIN_DOC @@ -382,7 +382,7 @@ subroutine get_mo_two_e_integrals_coulomb_ijij_periodic(j,sze,out_val,map2) endif end -subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) +subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) use map_module implicit none BEGIN_DOC @@ -410,7 +410,7 @@ subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) if (k.eq.l) then ! real, call other function - call get_mo_two_e_integrals_exch_ijji_periodic(k,sze,out_re,map,map2) + call get_mo_two_e_integrals_exch_ijji_complex(k,sze,out_re,map,map2) do i=1,sze out_val(i) = dcmplx(out_re(i),0.d0) enddo @@ -457,7 +457,7 @@ subroutine get_mo_two_e_integrals_exch_ii_periodic(k,l,sze,out_val,map,map2) endif end -subroutine get_mo_two_e_integrals_exch_ijji_periodic(j,sze,out_val,map,map2) +subroutine get_mo_two_e_integrals_exch_ijji_complex(j,sze,out_val,map,map2) use map_module implicit none BEGIN_DOC diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index bb998c26..bdaa86c9 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -33,12 +33,12 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] PROVIDE mo_class - if (is_periodic) then + if (is_complex) then mo_two_e_integrals_in_map = .True. if (read_mo_two_e_integrals) then print*,'Reading the MO integrals' - call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_1',mo_integrals_map) - call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_2',mo_integrals_map_2) + call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) print*, 'MO integrals provided (periodic)' return else @@ -77,8 +77,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] if (write_mo_two_e_integrals.and.mpi_master) then call ezfio_set_work_empty(.False.) - call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_1',mo_integrals_map) - call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_periodic_2',mo_integrals_map_2) + call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') endif else @@ -986,7 +986,7 @@ end double precision :: c integer :: n, pp integer, allocatable :: int_idx(:) - if (is_periodic) then + if (is_complex) then complex(integral_kind) :: integral2 complex(integral_kind), allocatable :: int_value2(:) complex*16 :: cz @@ -1022,7 +1022,7 @@ end do r=1,ao_num - call get_ao_two_e_integrals_non_zero_periodic(q,r,s,ao_num,int_value2,int_idx,n) + call get_ao_two_e_integrals_non_zero_complex(q,r,s,ao_num,int_value2,int_idx,n) do pp=1,n p = int_idx(pp) integral2 = int_value2(pp) @@ -1032,7 +1032,7 @@ end enddo endif enddo - call get_ao_two_e_integrals_non_zero_periodic(q,s,r,ao_num,int_value2,int_idx,n) + call get_ao_two_e_integrals_non_zero_complex(q,s,r,ao_num,int_value2,int_idx,n) do pp=1,n p = int_idx(pp) integral2 = int_value2(pp) @@ -1196,7 +1196,7 @@ END_PROVIDER integer :: n, pp integer, allocatable :: int_idx(:) - if (is_periodic) then + if (is_complex) then complex*16 :: cz complex(integral_kind) :: integral2 complex(integral_kind), allocatable :: int_value2(:) @@ -1236,7 +1236,7 @@ END_PROVIDER do r=1,ao_num - call get_ao_two_e_integrals_non_zero_periodic(q,r,s,ao_num,int_value2,int_idx,n) + call get_ao_two_e_integrals_non_zero_complex(q,r,s,ao_num,int_value2,int_idx,n) do pp=1,n p = int_idx(pp) integral2 = int_value2(pp) @@ -1247,7 +1247,7 @@ END_PROVIDER enddo endif enddo - call get_ao_two_e_integrals_non_zero_periodic(q,s,r,ao_num,int_value2,int_idx,n) + call get_ao_two_e_integrals_non_zero_complex(q,s,r,ao_num,int_value2,int_idx,n) do pp=1,n p = int_idx(pp) integral2 = int_value2(pp) @@ -1428,13 +1428,13 @@ END_PROVIDER PROVIDE mo_two_e_integrals_in_map mo_two_e_integrals_jj = 0.d0 mo_two_e_integrals_jj_exchange = 0.d0 - if (is_periodic) then - complex*16 :: get_two_e_integral_periodic + if (is_complex) then + complex*16 :: get_two_e_integral_complex do j=1,mo_num do i=1,mo_num - mo_two_e_integrals_jj(i,j) = dble(get_two_e_integral_periodic(i,j,i,j,& + mo_two_e_integrals_jj(i,j) = dble(get_two_e_integral_complex(i,j,i,j,& mo_integrals_map,mo_integrals_map_2)) - mo_two_e_integrals_jj_exchange(i,j) = dble(get_two_e_integral_periodic(i,j,j,i,& + mo_two_e_integrals_jj_exchange(i,j) = dble(get_two_e_integral_complex(i,j,j,i,& mo_integrals_map,mo_integrals_map_2)) mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j) enddo @@ -1458,7 +1458,7 @@ subroutine clear_mo_map ! Frees the memory of the MO map END_DOC call map_deinit(mo_integrals_map) - if (is_periodic) then + if (is_complex) then call map_deinit(mo_integrals_map_2) endif FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index 1bd38194..a700d9b2 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -32,7 +32,7 @@ doc: Nuclear repulsion (Computed automaticaly or Read in the |EZFIO|) type:double precision interface: ezfio -[is_periodic] +[is_complex] type: logical doc: If true, the calculation uses periodic boundary conditions interface: ezfio, provider, ocaml diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index b59f921b..a77a78fc 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -101,7 +101,7 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_mo_alpha, (mo_num,mo_num) ] BEGIN_DOC ! Fock matrix on the MO basis END_DOC - if (is_periodic) then + if (is_complex) then print*,'error',irp_here stop -1 else @@ -115,7 +115,7 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_mo_beta, (mo_num,mo_num) ] BEGIN_DOC ! Fock matrix on the MO basis END_DOC - if (is_periodic) then + if (is_complex) then print*,'error',irp_here stop -1 else @@ -158,7 +158,7 @@ BEGIN_PROVIDER [ double precision, SCF_energy ] SCF_energy = nuclear_repulsion integer :: i,j - if (is_periodic) then + if (is_complex) then complex*16 :: scf_e_tmp scf_e_tmp = dcmplx(SCF_energy,0.d0) do j=1,ao_num diff --git a/src/utils_periodic/dump_ao_2e_complex.irp.f b/src/utils_periodic/dump_ao_2e_complex.irp.f index 3d553f01..6ed197b4 100644 --- a/src/utils_periodic/dump_ao_2e_complex.irp.f +++ b/src/utils_periodic/dump_ao_2e_complex.irp.f @@ -9,12 +9,12 @@ subroutine run integer ::i,j,k,l provide ao_two_e_integrals_in_map - complex*16 :: get_ao_two_e_integral_periodic, tmp_cmplx + complex*16 :: get_ao_two_e_integral_complex, tmp_cmplx do i=1,ao_num do j=1,ao_num do k=1,ao_num do l=1,ao_num - tmp_cmplx = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + tmp_cmplx = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) print'(4(I4),2(E15.7))',i,j,k,l,tmp_cmplx enddo enddo diff --git a/src/utils_periodic/export_integrals_ao_periodic.irp.f b/src/utils_periodic/export_integrals_ao_periodic.irp.f index 8f268c3e..d24a51e2 100644 --- a/src/utils_periodic/export_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/export_integrals_ao_periodic.irp.f @@ -130,7 +130,7 @@ provide ao_two_e_integrals_in_map ! call ezfio_set_ao_one_e_ints_ao_integrals_n_e(A(1:ao_num, 1:ao_num)) ! call ezfio_set_ao_one_e_ints_ao_integrals_n_e_imag(B(1:ao_num, 1:ao_num)) ! call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e("Read") - complex*16 :: int2e_tmp1,int2e_tmp2,get_ao_two_e_integral_periodic_simple,get_ao_two_e_integral_periodic, tmp_cmplx + complex*16 :: int2e_tmp1,int2e_tmp2,get_ao_two_e_integral_complex_simple,get_ao_two_e_integral_complex, tmp_cmplx double precision :: tmp3,tmp4,tmp5,tmp6 double precision :: thr0 thr0 = 1.d-10 @@ -144,11 +144,11 @@ provide ao_two_e_integrals_in_map do read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im tmp_cmplx = dcmplx(tmp_re,tmp_im) - int2e_tmp1 = get_ao_two_e_integral_periodic_simple(i,j,k,l,ao_integrals_map,ao_integrals_map_2) - int2e_tmp2 = get_ao_two_e_integral_periodic(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + int2e_tmp1 = get_ao_two_e_integral_complex_simple(i,j,k,l,ao_integrals_map,ao_integrals_map_2) + int2e_tmp2 = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) ! print'(4(I4),3(E15.7))',i,j,k,l,tmp_re,real(int2e_tmp1),real(int2e_tmp2) ! print'(4(I4),3(E15.7))',i,j,k,l,tmp_im,imag(int2e_tmp1),imag(int2e_tmp2) - call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) ! print*,use_map1,idx_tmp,sign call map_get(ao_integrals_map,idx_tmp,tmp3) call map_get(ao_integrals_map_2,idx_tmp,tmp4) @@ -164,7 +164,7 @@ provide ao_two_e_integrals_in_map ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) -! print*,'cache(pbc)=', ao_integrals_cache_periodic(ii) +! print*,'cache(pbc)=', ao_integrals_cache_complex(ii) ! print*,'cache(old)=', ao_integrals_cache(ii) ! print* ! if (use_map1) then @@ -210,8 +210,8 @@ provide ao_two_e_integrals_in_map ! call map_sort(ao_integrals_map_2) ! call map_unique(ao_integrals_map_2) ! -! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) -! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) +! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map) +! call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2) ! call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read' print*,'map1' do i=0,ao_integrals_map%map_size diff --git a/src/utils_periodic/import_integrals_ao_periodic.irp.f b/src/utils_periodic/import_integrals_ao_periodic.irp.f index e352cabd..bc20fc17 100644 --- a/src/utils_periodic/import_integrals_ao_periodic.irp.f +++ b/src/utils_periodic/import_integrals_ao_periodic.irp.f @@ -1,4 +1,4 @@ -program import_ao_integrals_periodic +program import_ao_integrals_complex call run end @@ -117,7 +117,7 @@ subroutine run buffer_values_2 = 0.d0 do read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im - call ao_two_e_integral_periodic_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) print'(4(I4),(L3),(I6),(F7.1))',i,j,k,l,use_map1,idx_tmp,sign if (use_map1) then n_integrals_1 += 1 @@ -166,8 +166,8 @@ subroutine run call map_sort(ao_integrals_map_2) call map_unique(ao_integrals_map_2) - call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_1',ao_integrals_map) - call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_periodic_2',ao_integrals_map_2) + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map) + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2) call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') end diff --git a/src/utils_periodic/import_mo_coef_periodic.irp.f b/src/utils_periodic/import_mo_coef_periodic.irp.f index 8cff838c..bc87b744 100644 --- a/src/utils_periodic/import_mo_coef_periodic.irp.f +++ b/src/utils_periodic/import_mo_coef_periodic.irp.f @@ -1,4 +1,4 @@ -program import_mo_coef_periodic +program import_mo_coef_complex PROVIDE ezfio_filename call run diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_periodic/qp2-pbc-diff.txt index d1953c8b..0b3378c3 100644 --- a/src/utils_periodic/qp2-pbc-diff.txt +++ b/src/utils_periodic/qp2-pbc-diff.txt @@ -50,12 +50,12 @@ ao_one_e_ints ao_integrals_n_e_per_atom_complex (should be simple, but currently we only use dummy nuclei) ao_two_e_ints (todo) - get_ao_two_e_integrals_non_zero_periodic - get_ao_two_e_integrals_non_zero_jl_periodic - get_ao_two_e_integrals_non_zero_jl_from_list_periodic + get_ao_two_e_integrals_non_zero_complex + get_ao_two_e_integrals_non_zero_jl_complex + get_ao_two_e_integrals_non_zero_jl_from_list_complex mo_two_e_ints (todo) - get_mo_two_e_integrals_ij_periodic + get_mo_two_e_integrals_ij_complex add_integrals_to_map_complex add_integrals_to_map_three_indices_complex add_integrals_to_map_no_exit_34_complex @@ -103,7 +103,7 @@ ocaml/Input_mo_basis.ml still needs mo_coef_to_string and to_string? src/nuclei/EZFIO.cfg - [is_periodic] + [is_complex] if true use periodic parts of code src/utils/linear_algebra.irp.f @@ -123,7 +123,7 @@ src/utils_periodic/import_integrals_ao_periodic.irp.f read ints from pyscf TODO: don't read ao_num from stdin -src/utils_periodic/import_mo_coef_periodic.irp.f +src/utils_periodic/import_mo_coef_complex.irp.f read mo_coef from pyscf @@ -154,7 +154,7 @@ src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f each complex array is formed by combining real and imag arrays imag arrays can only be read from disk no complex/imag versions of ao_integrals_n_e_per_atom, but this should be straightforward if we need it later? - changed ao_overlap_abs so that it is set to cdabs(ao_overlap_complex) if (is_periodic) + changed ao_overlap_abs so that it is set to cdabs(ao_overlap_complex) if (is_complex) TODO: (maybe not the behavior we want) added S_inv_complex TODO: (no S_half_inv_complex yet) @@ -172,7 +172,7 @@ src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f ao_ortho_canonical_num_complex similar to real version providers are linked, so easier to just make num_complex instead of using original num (even though they will both have the same value) - need to make sure this doesn't require any other downstream changes (i.e. replace ao_ortho_canonical_num with complex version if (is_periodic)) + need to make sure this doesn't require any other downstream changes (i.e. replace ao_ortho_canonical_num with complex version if (is_complex)) ao_ortho_canonical_overlap_complex similar to real version @@ -184,20 +184,20 @@ src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f src/ao_two_e_ints/map_integrals.irp.f added ao_integrals_map_2 (provider linked to ao_integrals_map) - double size of both maps if (is_periodic) - subroutine two_e_integrals_index_periodic + double size of both maps if (is_complex) + subroutine two_e_integrals_index_complex same as real version, but return compound (2) indices to avoid recomputing - ao_integrals_cache_periodic + ao_integrals_cache_complex similar to real version - subroutine ao_two_e_integral_periodic_map_idx_sign + subroutine ao_two_e_integral_complex_map_idx_sign from i,j,k,l, return which map to use (T->1, F->2), location of real part of integral, sign of imaginary part of integral - complex*16 function get_ao_two_e_integral_periodic_simple + complex*16 function get_ao_two_e_integral_complex_simple args i,j,k,l,map1,map2 return complex integral composed of correct elements from one of the maps - complex*16 function get_ao_two_e_integral_periodic + complex*16 function get_ao_two_e_integral_complex same behavior as _simple version, but checks cache first returns integral from cache if possible, otherwise retrieves from map - subroutine get_ao_two_e_integrals_periodic + subroutine get_ao_two_e_integrals_complex same functionality as real version subroutine insert_into_ao_integrals_map_2 needed for second map @@ -323,8 +323,8 @@ src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f for periodic AOs, we always read (can't compute) for MOs, we can either read from disk or transform from AOs simplest way might be to link all three providers (integrals{,_imag,_complex}) - if (.not.is_periodic), just ignore imag and complex arrays? - if (is_periodic) + if (.not.is_complex), just ignore imag and complex arrays? + if (is_complex) either read real/imag from disk and combine to form complex or transform complex MO ints from complex AO ints and also assign real/imag parts to separate arrays? @@ -354,7 +354,7 @@ src/hartree_fock/scf.irp.f subroutine create_guess should work for periodic TODO: decide what to do about mo_coef_complex and imag/real parts for touch/save!!! - TODO: call roothaan_hall_scf_complex if (is_periodic) + TODO: call roothaan_hall_scf_complex if (is_complex) src/scf_utils/diagonalize_fock_complex.irp.f @@ -373,7 +373,7 @@ src/scf_utils/diis_complex.irp.f src/scf_utils/fock_matrix.irp.f - added checks to make sure we don't end up in real providers if (is_periodic) + added checks to make sure we don't end up in real providers if (is_complex) probably not necessary? [ double precision, SCF_energy ] modified for periodic @@ -391,7 +391,7 @@ src/scf_utils/fock_matrix_complex.irp.f src/scf_utils/huckel_complex.irp.f similar to real version - could just put if (is_periodic) branch in real version? (instead of making separate subroutine) + could just put if (is_complex) branch in real version? (instead of making separate subroutine) has soft_touch mo_coef_complex and call to save_mos (see other notes on real/imag parts) From d80fefe1ce22a3331d40427ebe6d39c1d2feb102 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 11 Feb 2020 18:24:13 -0600 Subject: [PATCH 071/256] rename --- .../Gen_Ezfio_from_integral_complex_3idx.sh | 0 src/{utils_periodic => utils_complex}/MolPyscfToQPkpts.py | 0 src/{utils_periodic => utils_complex}/NEED | 0 src/{utils_periodic => utils_complex}/README.rst | 0 .../create_ezfio_complex_3idx.py | 0 src/{utils_periodic => utils_complex}/dump_2e_from_map.irp.f | 0 src/{utils_periodic => utils_complex}/dump_ao_1e_complex.irp.f | 0 src/{utils_periodic => utils_complex}/dump_ao_2e_complex.irp.f | 0 .../export_integrals_ao_periodic.irp.f | 0 .../import_integrals_ao_periodic.irp.f | 0 src/{utils_periodic => utils_complex}/import_kconserv.irp.f | 0 .../import_mo_coef_periodic.irp.f | 0 src/{utils_periodic => utils_complex}/qp2-pbc-diff.txt | 0 13 files changed, 0 insertions(+), 0 deletions(-) rename src/{utils_periodic => utils_complex}/Gen_Ezfio_from_integral_complex_3idx.sh (100%) rename src/{utils_periodic => utils_complex}/MolPyscfToQPkpts.py (100%) rename src/{utils_periodic => utils_complex}/NEED (100%) rename src/{utils_periodic => utils_complex}/README.rst (100%) rename src/{utils_periodic => utils_complex}/create_ezfio_complex_3idx.py (100%) rename src/{utils_periodic => utils_complex}/dump_2e_from_map.irp.f (100%) rename src/{utils_periodic => utils_complex}/dump_ao_1e_complex.irp.f (100%) rename src/{utils_periodic => utils_complex}/dump_ao_2e_complex.irp.f (100%) rename src/{utils_periodic => utils_complex}/export_integrals_ao_periodic.irp.f (100%) rename src/{utils_periodic => utils_complex}/import_integrals_ao_periodic.irp.f (100%) rename src/{utils_periodic => utils_complex}/import_kconserv.irp.f (100%) rename src/{utils_periodic => utils_complex}/import_mo_coef_periodic.irp.f (100%) rename src/{utils_periodic => utils_complex}/qp2-pbc-diff.txt (100%) diff --git a/src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh similarity index 100% rename from src/utils_periodic/Gen_Ezfio_from_integral_complex_3idx.sh rename to src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh diff --git a/src/utils_periodic/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py similarity index 100% rename from src/utils_periodic/MolPyscfToQPkpts.py rename to src/utils_complex/MolPyscfToQPkpts.py diff --git a/src/utils_periodic/NEED b/src/utils_complex/NEED similarity index 100% rename from src/utils_periodic/NEED rename to src/utils_complex/NEED diff --git a/src/utils_periodic/README.rst b/src/utils_complex/README.rst similarity index 100% rename from src/utils_periodic/README.rst rename to src/utils_complex/README.rst diff --git a/src/utils_periodic/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py similarity index 100% rename from src/utils_periodic/create_ezfio_complex_3idx.py rename to src/utils_complex/create_ezfio_complex_3idx.py diff --git a/src/utils_periodic/dump_2e_from_map.irp.f b/src/utils_complex/dump_2e_from_map.irp.f similarity index 100% rename from src/utils_periodic/dump_2e_from_map.irp.f rename to src/utils_complex/dump_2e_from_map.irp.f diff --git a/src/utils_periodic/dump_ao_1e_complex.irp.f b/src/utils_complex/dump_ao_1e_complex.irp.f similarity index 100% rename from src/utils_periodic/dump_ao_1e_complex.irp.f rename to src/utils_complex/dump_ao_1e_complex.irp.f diff --git a/src/utils_periodic/dump_ao_2e_complex.irp.f b/src/utils_complex/dump_ao_2e_complex.irp.f similarity index 100% rename from src/utils_periodic/dump_ao_2e_complex.irp.f rename to src/utils_complex/dump_ao_2e_complex.irp.f diff --git a/src/utils_periodic/export_integrals_ao_periodic.irp.f b/src/utils_complex/export_integrals_ao_periodic.irp.f similarity index 100% rename from src/utils_periodic/export_integrals_ao_periodic.irp.f rename to src/utils_complex/export_integrals_ao_periodic.irp.f diff --git a/src/utils_periodic/import_integrals_ao_periodic.irp.f b/src/utils_complex/import_integrals_ao_periodic.irp.f similarity index 100% rename from src/utils_periodic/import_integrals_ao_periodic.irp.f rename to src/utils_complex/import_integrals_ao_periodic.irp.f diff --git a/src/utils_periodic/import_kconserv.irp.f b/src/utils_complex/import_kconserv.irp.f similarity index 100% rename from src/utils_periodic/import_kconserv.irp.f rename to src/utils_complex/import_kconserv.irp.f diff --git a/src/utils_periodic/import_mo_coef_periodic.irp.f b/src/utils_complex/import_mo_coef_periodic.irp.f similarity index 100% rename from src/utils_periodic/import_mo_coef_periodic.irp.f rename to src/utils_complex/import_mo_coef_periodic.irp.f diff --git a/src/utils_periodic/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt similarity index 100% rename from src/utils_periodic/qp2-pbc-diff.txt rename to src/utils_complex/qp2-pbc-diff.txt From 0b22e78da16640d07c9c27ea5dd6904c2889ff2f Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 11 Feb 2020 18:26:28 -0600 Subject: [PATCH 072/256] rename --- src/mo_basis/{utils_periodic.irp.f => utils_complex.irp.f} | 0 ...egrals_ao_periodic.irp.f => export_integrals_ao_complex.irp.f} | 0 ...egrals_ao_periodic.irp.f => import_integrals_ao_complex.irp.f} | 0 ...import_mo_coef_periodic.irp.f => import_mo_coef_complex.irp.f} | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename src/mo_basis/{utils_periodic.irp.f => utils_complex.irp.f} (100%) rename src/utils_complex/{export_integrals_ao_periodic.irp.f => export_integrals_ao_complex.irp.f} (100%) rename src/utils_complex/{import_integrals_ao_periodic.irp.f => import_integrals_ao_complex.irp.f} (100%) rename src/utils_complex/{import_mo_coef_periodic.irp.f => import_mo_coef_complex.irp.f} (100%) diff --git a/src/mo_basis/utils_periodic.irp.f b/src/mo_basis/utils_complex.irp.f similarity index 100% rename from src/mo_basis/utils_periodic.irp.f rename to src/mo_basis/utils_complex.irp.f diff --git a/src/utils_complex/export_integrals_ao_periodic.irp.f b/src/utils_complex/export_integrals_ao_complex.irp.f similarity index 100% rename from src/utils_complex/export_integrals_ao_periodic.irp.f rename to src/utils_complex/export_integrals_ao_complex.irp.f diff --git a/src/utils_complex/import_integrals_ao_periodic.irp.f b/src/utils_complex/import_integrals_ao_complex.irp.f similarity index 100% rename from src/utils_complex/import_integrals_ao_periodic.irp.f rename to src/utils_complex/import_integrals_ao_complex.irp.f diff --git a/src/utils_complex/import_mo_coef_periodic.irp.f b/src/utils_complex/import_mo_coef_complex.irp.f similarity index 100% rename from src/utils_complex/import_mo_coef_periodic.irp.f rename to src/utils_complex/import_mo_coef_complex.irp.f From 059efc649d499aa1581a5b0eb7a4f692285f9156 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 12 Feb 2020 08:28:41 -0600 Subject: [PATCH 073/256] working on converter find cleaner way to provide kpt_pair_num --- src/ao_basis/EZFIO.cfg | 1 + src/utils_complex/MolPyscfToQPkpts.py | 25 +++++++++------- .../create_ezfio_complex_3idx.py | 30 ++++++++++++++++++- 3 files changed, 44 insertions(+), 12 deletions(-) diff --git a/src/ao_basis/EZFIO.cfg b/src/ao_basis/EZFIO.cfg index b23d8b22..4b17acad 100644 --- a/src/ao_basis/EZFIO.cfg +++ b/src/ao_basis/EZFIO.cfg @@ -58,5 +58,6 @@ default: false [ao_kpt_num] type: integer doc: Number of |AOs| per kpt +default: =(ao_basis.ao_num/nuclei.kpt_num) interface: ezfio diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 0a83e082..d76085d1 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -588,13 +588,16 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ne_ao = ('V',v_kpts_ao,ne_threshold) ovlp_ao = ('S',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) kin_ao = ('T',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) - - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic', data=kin_ao[1].real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao[1].imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap', data=ovlp_ao[1].real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao[1].imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=v_kpts_ao.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=v_kpts_ao.imag) + + kin_ao_blocked=scipy.linalg.block_diag(*kin_ao[1]) + ovlp_ao_blocked=scipy.linalg.block_diag(*ovlp_ao[1]) + ne_ao_blocked=scipy.linalg.block_diag(*v_kpts_ao) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) @@ -680,8 +683,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) df_ao_tmp[i,j,iaux,k]=v - qph5.create_dataset('ao_two_e_ints/df_ao_array_real',data=df_ao_tmp.real) - qph5.create_dataset('ao_two_e_ints/df_ao_array_imag',data=df_ao_tmp.imag) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) if print_mo_ints_df: kpair_list=[] @@ -701,8 +704,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if (abs(v) > bielec_int_threshold): outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) df_mo_tmp[i,j,iaux,k]=v - qph5.create_dataset('mo_two_e_ints/df_mo_array_real',data=df_mo_tmp.real) - qph5.create_dataset('mo_two_e_ints/df_mo_array_imag',data=df_mo_tmp.imag) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index ff7fbbd7..449050e8 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -17,6 +17,8 @@ qph5=h5py.File(h5filename,'r') kpt_num = qph5['nuclei'].attrs['kpt_num'] ezfio.set_nuclei_kpt_num(kpt_num) +kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 +ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) # should this be in ao_basis? ao_two_e_ints? df_num = qph5['ao_two_e_ints'].attrs['df_num'] @@ -110,4 +112,30 @@ ezfio.set_mo_basis_mo_coef_imag(qph5['mo_basis/mo_coef_imag'][()].tolist()) #maybe fix qp so we don't need this? ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) -ezfio.set_nuclei_is_periodic(True) +ezfio.set_nuclei_is_complex(True) + + +kin_ao_re=qph5['ao_one_e_ints/ao_integrals_kinetic_real'][()].T.tolist() +kin_ao_im=qph5['ao_one_e_ints/ao_integrals_kinetic_imag'][()].T.tolist() +ovlp_ao_re=qph5['ao_one_e_ints/ao_integrals_overlap_real'][()].T.tolist() +ovlp_ao_im=qph5['ao_one_e_ints/ao_integrals_overlap_imag'][()].T.tolist() +ne_ao_re=qph5['ao_one_e_ints/ao_integrals_n_e_real'][()].T.tolist() +ne_ao_im=qph5['ao_one_e_ints/ao_integrals_n_e_imag'][()].T.tolist() + +ezfio.set_ao_one_e_ints_ao_integrals_kinetic(kin_ao_re) +ezfio.set_ao_one_e_ints_ao_integrals_kinetic_imag(kin_ao_im) +ezfio.set_ao_one_e_ints_ao_integrals_overlap(ovlp_ao_re) +ezfio.set_ao_one_e_ints_ao_integrals_overlap_imag(ovlp_ao_im) +ezfio.set_ao_one_e_ints_ao_integrals_n_e(ne_ao_re) +ezfio.set_ao_one_e_ints_ao_integrals_n_e_imag(ne_ao_im) + +dfao_re=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)).tolist() +dfao_im=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)).tolist() +ezfio.set_ao_two_e_ints_df_ao_integrals_real(dfao_re) +ezfio.set_ao_two_e_ints_df_ao_integrals_imag(dfao_im) + +#TODO: add check and only do this if ints exist +#dfmo_re=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)).tolist() +#dfmo_im=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)).tolist() +#ezfio.set_mo_two_e_ints_df_mo_integrals_real(dfmo_re) +#ezfio.set_mo_two_e_ints_df_mo_integrals_imag(dfmo_im) From 2cffbdcc9d253f4feb1e0eeb5b13ba1afba77fca Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 12 Feb 2020 16:34:32 -0600 Subject: [PATCH 074/256] significant restructuring of complex int parts instead of real/imag parts read separately, use ezfio to read/write complex arrays with extra dimension of size 2 converter needs to be tested (might need to transpose some axes in arrays) converter has extra garbage that needs to be removed after testing --- REPLACE | 3 + ocaml/Input_mo_basis.ml | 86 ++---- ocaml/qptypes_generator.ml | 1 + src/ao_basis/EZFIO.cfg | 2 +- src/ao_basis/aos_complex.irp.f | 4 +- src/ao_one_e_ints/EZFIO.cfg | 30 +- src/ao_one_e_ints/ao_one_e_ints.irp.f | 77 +++-- src/ao_one_e_ints/ao_overlap.irp.f | 48 +-- src/ao_one_e_ints/kin_ao_ints.irp.f | 60 ++-- src/ao_one_e_ints/pot_ao_ints.irp.f | 55 ++-- src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f | 49 +-- src/ao_two_e_ints/EZFIO.cfg | 10 +- src/ao_two_e_ints/df_ao_ints.irp.f | 281 ++++++++++++++++-- src/ao_two_e_ints/map_integrals_complex.irp.f | 20 ++ src/ao_two_e_ints/two_e_integrals.irp.f | 5 + src/mo_basis/EZFIO.cfg | 14 +- src/mo_basis/mos_complex.irp.f | 90 ++++-- src/mo_basis/utils.irp.f | 48 ++- src/mo_two_e_ints/EZFIO.cfg | 4 +- src/mo_two_e_ints/df_mo_ints.irp.f | 16 +- src/scf_utils/huckel_complex.irp.f | 4 +- .../Gen_Ezfio_from_integral_complex_3idx.sh | 6 +- src/utils_complex/MolPyscfToQPkpts.py | 2 +- .../create_ezfio_complex_3idx.py | 70 +++-- 24 files changed, 648 insertions(+), 337 deletions(-) diff --git a/REPLACE b/REPLACE index 42d530b0..8ec6d09d 100755 --- a/REPLACE +++ b/REPLACE @@ -869,3 +869,6 @@ qp_name mo_two_e_integral_periodic -r mo_two_e_integral_complex qp_name get_mo_two_e_integrals_ij_periodic -r get_mo_two_e_integrals_ij_complex qp_name get_mo_two_e_integrals_coulomb_ii_periodic -r get_mo_two_e_integrals_coulomb_ii_complex qp_name get_mo_two_e_integrals_coulomb_ijij_periodic -r get_mo_two_e_integrals_coulomb_ijij_complex +qp_name ao_kpt_num -r ao_num_per_kpt +qp_name mo_kpt_num -r mo_num_per_kpt +qp_name num_kpts -r kpt_num diff --git a/ocaml/Input_mo_basis.ml b/ocaml/Input_mo_basis.ml index 94435349..46f8240e 100644 --- a/ocaml/Input_mo_basis.ml +++ b/ocaml/Input_mo_basis.ml @@ -2,7 +2,6 @@ open Qptypes open Qputils open Sexplib.Std - module Mo_basis : sig type t = { mo_num : MO_number.t ; @@ -10,7 +9,6 @@ module Mo_basis : sig mo_class : MO_class.t array; mo_occ : MO_occ.t array; mo_coef : (MO_coef.t array) array; - mo_coef_imag : (MO_coef.t array) array option; ao_md5 : MD5.t; } [@@deriving sexp] val read : unit -> t option @@ -25,11 +23,13 @@ end = struct mo_class : MO_class.t array; mo_occ : MO_occ.t array; mo_coef : (MO_coef.t array) array; - mo_coef_imag : (MO_coef.t array) array option; ao_md5 : MD5.t; } [@@deriving sexp] + let get_default = Qpackage.get_ezfio_default "mo_basis" + let is_complex = lazy (Ezfio.get_nuclei_is_complex () ) + let read_mo_label () = if not (Ezfio.has_mo_basis_mo_label ()) then Ezfio.set_mo_basis_mo_label "None" @@ -43,14 +43,7 @@ end = struct mo_coef = Array.map (fun mo -> Array.init (Array.length mo) (fun i -> mo.(ordering.(i))) - ) b.mo_coef ; - mo_coef_imag = - match b.mo_coef_imag with - | None -> None - | Some x -> Some ( Array.map (fun mo -> - Array.init (Array.length mo) - (fun i -> mo.(ordering.(i))) - ) x ) + ) b.mo_coef } let read_ao_md5 () = @@ -69,7 +62,10 @@ end = struct |> MD5.of_string in if (ao_md5 <> result) then - failwith "The current MOs don't correspond to the current AOs."; + begin + Printf.eprintf ":%s:\n:%s:\n%!" (MD5.to_string ao_md5) (MD5.to_string result); + failwith "The current MOs don't correspond to the current AOs." + end; result @@ -120,29 +116,21 @@ end = struct let read_mo_coef () = - let a = Ezfio.get_mo_basis_mo_coef () - |> Ezfio.flattened_ezfio - |> Array.map MO_coef.of_float + let a = + ( + if Lazy.force is_complex then + Ezfio.get_mo_basis_mo_coef_complex () + else + Ezfio.get_mo_basis_mo_coef () + ) + |> Ezfio.flattened_ezfio + |> Array.map MO_coef.of_float in let mo_num = read_mo_num () |> MO_number.to_int in let ao_num = (Array.length a)/mo_num in - Array.init mo_num (fun j -> - Array.sub a (j*ao_num) (ao_num) - ) - - let read_mo_coef_imag () = - if Ezfio.has_mo_basis_mo_coef_imag () then - let a = - Ezfio.get_mo_basis_mo_coef_imag () - |> Ezfio.flattened_ezfio - |> Array.map MO_coef.of_float - in - let mo_num = read_mo_num () |> MO_number.to_int in - let ao_num = (Array.length a)/mo_num in - Some (Array.init mo_num (fun j -> + Array.init mo_num (fun j -> Array.sub a (j*ao_num) (ao_num) - ) ) - else None + ) let read () = @@ -153,7 +141,6 @@ end = struct mo_class = read_mo_class (); mo_occ = read_mo_occ (); mo_coef = read_mo_coef (); - mo_coef_imag = read_mo_coef_imag (); ao_md5 = read_ao_md5 (); } else @@ -161,7 +148,6 @@ end = struct let mo_coef_to_string mo_coef = - (*TODO : add imaginary part here *) let ao_num = Array.length mo_coef.(0) and mo_num = Array.length mo_coef in let rec print_five imin imax = @@ -247,7 +233,6 @@ MO coefficients :: let to_string b = - (*TODO : add imaginary part here *) Printf.sprintf " mo_label = \"%s\" mo_num = %s @@ -300,31 +285,22 @@ mo_coef = %s let write_mo_coef a = let mo_num = Array.length a in - let ao_num = Array.length a.(0) in + let ao_num = + let x = Array.length a.(0) in + if Lazy.force is_complex then x/2 else x + in let data = Array.map (fun mo -> Array.map MO_coef.to_float mo |> Array.to_list) a |> Array.to_list |> List.concat - in Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; mo_num |] ~data - |> Ezfio.set_mo_basis_mo_coef - - - let write_mo_coef_imag a = - match a with - | None -> () - | Some a -> - begin - let mo_num = Array.length a in - let ao_num = Array.length a.(0) in - let data = - Array.map (fun mo -> Array.map MO_coef.to_float mo - |> Array.to_list) a - |> Array.to_list - |> List.concat - in Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; mo_num |] ~data - |> Ezfio.set_mo_basis_mo_coef_imag - end + in + if Lazy.force is_complex then + (Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; ao_num ; mo_num |] ~data + |> Ezfio.set_mo_basis_mo_coef_complex ) + else + (Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; mo_num |] ~data + |> Ezfio.set_mo_basis_mo_coef ) let write @@ -333,7 +309,6 @@ mo_coef = %s mo_class : MO_class.t array; mo_occ : MO_occ.t array; mo_coef : (MO_coef.t array) array; - mo_coef_imag : (MO_coef.t array) array option; ao_md5 : MD5.t; } = write_mo_num mo_num; @@ -341,7 +316,6 @@ mo_coef = %s write_mo_class mo_class; write_mo_occ mo_occ; write_mo_coef mo_coef; - write_mo_coef_imag mo_coef_imag; write_md5 ao_md5 diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index 2c54a218..610b67d1 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -166,6 +166,7 @@ let input_ezfio = " let untouched = " + module MO_guess : sig type t [@@deriving sexp] val to_string : t -> string diff --git a/src/ao_basis/EZFIO.cfg b/src/ao_basis/EZFIO.cfg index 4b17acad..337b1fee 100644 --- a/src/ao_basis/EZFIO.cfg +++ b/src/ao_basis/EZFIO.cfg @@ -55,7 +55,7 @@ doc: If |true|, use |AOs| in Cartesian coordinates (6d,10f,...) interface: ezfio, provider default: false -[ao_kpt_num] +[ao_num_per_kpt] type: integer doc: Number of |AOs| per kpt default: =(ao_basis.ao_num/nuclei.kpt_num) diff --git a/src/ao_basis/aos_complex.irp.f b/src/ao_basis/aos_complex.irp.f index 8ed10c43..afec0548 100644 --- a/src/ao_basis/aos_complex.irp.f +++ b/src/ao_basis/aos_complex.irp.f @@ -1,7 +1,7 @@ -BEGIN_PROVIDER [ integer, ao_kpt_num ] +BEGIN_PROVIDER [ integer, ao_num_per_kpt ] implicit none BEGIN_DOC ! number of aos per kpt. END_DOC - ao_kpt_num = ao_num/kpt_num + ao_num_per_kpt = ao_num/kpt_num END_PROVIDER diff --git a/src/ao_one_e_ints/EZFIO.cfg b/src/ao_one_e_ints/EZFIO.cfg index 9ef019fa..583c7757 100644 --- a/src/ao_one_e_ints/EZFIO.cfg +++ b/src/ao_one_e_ints/EZFIO.cfg @@ -4,10 +4,10 @@ doc: Nucleus-electron integrals in |AO| basis set size: (ao_basis.ao_num,ao_basis.ao_num) interface: ezfio -[ao_integrals_n_e_imag] +[ao_integrals_n_e_complex] type: double precision -doc: Imaginary part of the nucleus-electron integrals in |AO| basis set -size: (ao_basis.ao_num,ao_basis.ao_num) +doc: Complex nucleus-electron integrals in |AO| basis set +size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio [io_ao_integrals_n_e] @@ -23,10 +23,10 @@ doc: Kinetic energy integrals in |AO| basis set size: (ao_basis.ao_num,ao_basis.ao_num) interface: ezfio -[ao_integrals_kinetic_imag] +[ao_integrals_kinetic_complex] type: double precision -doc: Imaginary part of the kinetic energy integrals in |AO| basis set -size: (ao_basis.ao_num,ao_basis.ao_num) +doc: Complex kinetic energy integrals in |AO| basis set +size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio [io_ao_integrals_kinetic] @@ -42,10 +42,10 @@ doc: Pseudopotential integrals in |AO| basis set size: (ao_basis.ao_num,ao_basis.ao_num) interface: ezfio -[ao_integrals_pseudo_imag] +[ao_integrals_pseudo_complex] type: double precision -doc: Imaginary part of the pseudopotential integrals in |AO| basis set -size: (ao_basis.ao_num,ao_basis.ao_num) +doc: Complex pseudopotential integrals in |AO| basis set +size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio [io_ao_integrals_pseudo] @@ -61,10 +61,10 @@ doc: Overlap integrals in |AO| basis set size: (ao_basis.ao_num,ao_basis.ao_num) interface: ezfio -[ao_integrals_overlap_imag] +[ao_integrals_overlap_complex] type: double precision -doc: Imaginary part of the overlap integrals in |AO| basis set -size: (ao_basis.ao_num,ao_basis.ao_num) +doc: Complex overlap integrals in |AO| basis set +size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio [io_ao_integrals_overlap] @@ -80,10 +80,10 @@ doc: Combined integrals in |AO| basis set size: (ao_basis.ao_num,ao_basis.ao_num) interface: ezfio -[ao_one_e_integrals_imag] +[ao_one_e_integrals_complex] type: double precision -doc: Imaginary part of the combined integrals in |AO| basis set -size: (ao_basis.ao_num,ao_basis.ao_num) +doc: Complex combined integrals in |AO| basis set +size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio [io_ao_one_e_integrals] diff --git a/src/ao_one_e_ints/ao_one_e_ints.irp.f b/src/ao_one_e_ints/ao_one_e_ints.irp.f index b5e8872e..be70bf23 100644 --- a/src/ao_one_e_ints/ao_one_e_ints.irp.f +++ b/src/ao_one_e_ints/ao_one_e_ints.irp.f @@ -5,7 +5,10 @@ BEGIN_DOC ! One-electron Hamiltonian in the |AO| basis. END_DOC - + if (is_complex) then + print*,"you shouldn't be here for complex",irp_here + stop -1 + endif IF (read_ao_one_e_integrals) THEN call ezfio_get_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals) ELSE @@ -27,43 +30,55 @@ END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_one_e_integrals_imag,(ao_num,ao_num)] - implicit none - integer :: i,j,n,l - BEGIN_DOC - ! One-electron Hamiltonian in the |AO| basis. - END_DOC +!BEGIN_PROVIDER [ double precision, ao_one_e_integrals_imag,(ao_num,ao_num)] +! implicit none +! integer :: i,j,n,l +! BEGIN_DOC +! ! One-electron Hamiltonian in the |AO| basis. +! END_DOC +! +! IF (read_ao_one_e_integrals) THEN +! call ezfio_get_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) +! ELSE +! ao_one_e_integrals_imag = ao_integrals_n_e_imag + ao_kinetic_integrals_imag +! +! IF (DO_PSEUDO) THEN +! ao_one_e_integrals_imag += ao_pseudo_integrals_imag +! ENDIF +! ENDIF +! +! IF (write_ao_one_e_integrals) THEN +! call ezfio_set_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) +! print *, 'AO one-e integrals written to disk' +! ENDIF +! +!END_PROVIDER - IF (read_ao_one_e_integrals) THEN - call ezfio_get_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) - ELSE - ao_one_e_integrals_imag = ao_integrals_n_e_imag + ao_kinetic_integrals_imag - - IF (DO_PSEUDO) THEN - ao_one_e_integrals_imag += ao_pseudo_integrals_imag - ENDIF - ENDIF - - IF (write_ao_one_e_integrals) THEN - call ezfio_set_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag) - print *, 'AO one-e integrals written to disk' - ENDIF - -END_PROVIDER - -BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_complex,(ao_num,ao_num)] + BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_complex,(ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, ao_one_e_integrals_diag_complex,(ao_num)] implicit none integer :: i,j,n,l BEGIN_DOC ! One-electron Hamiltonian in the |AO| basis. END_DOC - do i=1,ao_num - do j=1,ao_num - ao_one_e_integrals_complex(j,i)=dcmplx(ao_one_e_integrals(j,i), & - ao_one_e_integrals_imag(j,i)) - enddo - enddo + IF (read_ao_one_e_integrals) THEN + call ezfio_get_ao_one_e_ints_ao_one_e_integrals_complex(ao_one_e_integrals_complex) + ELSE + ao_one_e_integrals_complex = ao_integrals_n_e_complex + ao_kinetic_integrals_complex + IF (DO_PSEUDO) THEN + ao_one_e_integrals_complex += ao_pseudo_integrals_complex + ENDIF + ENDIF + + DO j = 1, ao_num + ao_one_e_integrals_diag_complex(j) = dble(ao_one_e_integrals_complex(j,j)) + ENDDO + + IF (write_ao_one_e_integrals) THEN + call ezfio_set_ao_one_e_ints_ao_one_e_integrals_complex(ao_one_e_integrals_complex) + print *, 'AO one-e integrals written to disk' + ENDIF END_PROVIDER diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 52a0ea1c..5afadbbe 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -70,34 +70,38 @@ END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ] - implicit none - BEGIN_DOC - ! Imaginary part of the overlap - END_DOC - if (read_ao_integrals_overlap) then - call ezfio_get_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) - print *, 'AO overlap integrals read from disk' - else - ao_overlap_imag = 0.d0 - endif - if (write_ao_integrals_overlap) then - call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) - print *, 'AO overlap integrals written to disk' - endif -END_PROVIDER +!BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ] +! implicit none +! BEGIN_DOC +! ! Imaginary part of the overlap +! END_DOC +! if (read_ao_integrals_overlap) then +! call ezfio_get_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) +! print *, 'AO overlap integrals read from disk' +! else +! ao_overlap_imag = 0.d0 +! endif +! if (write_ao_integrals_overlap) then +! call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num)) +! print *, 'AO overlap integrals written to disk' +! endif +!END_PROVIDER BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ] implicit none BEGIN_DOC ! Overlap for complex AOs END_DOC - integer :: i,j - do j=1,ao_num - do i=1,ao_num - ao_overlap_complex(i,j) = dcmplx( ao_overlap(i,j), ao_overlap_imag(i,j) ) - enddo - enddo + if (read_ao_integrals_overlap) then + call ezfio_get_ao_one_e_ints_ao_integrals_overlap_complex(ao_overlap_complex) + print *, 'AO overlap integrals read from disk' + else + print*,'complex AO overlap ints must be provided',irp_here + endif + if (write_ao_integrals_overlap) then + call ezfio_set_ao_one_e_ints_ao_integrals_overlap_complex(ao_overlap_complex) + print *, 'AO overlap integrals written to disk' + endif END_PROVIDER diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f index ca50114c..f352d1c4 100644 --- a/src/ao_one_e_ints/kin_ao_ints.irp.f +++ b/src/ao_one_e_ints/kin_ao_ints.irp.f @@ -149,27 +149,27 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)] endif END_PROVIDER -BEGIN_PROVIDER [double precision, ao_kinetic_integrals_imag, (ao_num,ao_num)] - implicit none - BEGIN_DOC - ! Kinetic energy integrals in the |AO| basis. - ! - ! $\langle \chi_i |\hat{T}| \chi_j \rangle$ - ! - END_DOC - integer :: i,j,k,l - - if (read_ao_integrals_kinetic) then - call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) - print *, 'AO kinetic integrals read from disk' - else - print *, irp_here, ': Not yet implemented' - endif - if (write_ao_integrals_kinetic) then - call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) - print *, 'AO kinetic integrals written to disk' - endif -END_PROVIDER +!BEGIN_PROVIDER [double precision, ao_kinetic_integrals_imag, (ao_num,ao_num)] +! implicit none +! BEGIN_DOC +! ! Kinetic energy integrals in the |AO| basis. +! ! +! ! $\langle \chi_i |\hat{T}| \chi_j \rangle$ +! ! +! END_DOC +! integer :: i,j,k,l +! +! if (read_ao_integrals_kinetic) then +! call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) +! print *, 'AO kinetic integrals read from disk' +! else +! print *, irp_here, ': Not yet implemented' +! endif +! if (write_ao_integrals_kinetic) then +! call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag) +! print *, 'AO kinetic integrals written to disk' +! endif +!END_PROVIDER BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_complex, (ao_num,ao_num)] implicit none @@ -179,11 +179,15 @@ BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_complex, (ao_num,ao_num)] ! $\langle \chi_i |\hat{T}| \chi_j \rangle$ ! END_DOC - integer :: i,j - do i=1,ao_num - do j=1,ao_num - ao_kinetic_integrals_complex(j,i) = dcmplx(ao_kinetic_integrals(j,i), & - ao_kinetic_integrals_imag(j,i)) - enddo - enddo + if (read_ao_integrals_kinetic) then + call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_complex(ao_kinetic_integrals_complex) + print *, 'AO kinetic integrals read from disk' + else + print *, irp_here, ': Not yet implemented' + stop -1 + endif + if (write_ao_integrals_kinetic) then + call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_complex(ao_kinetic_integrals_complex) + print *, 'AO kinetic integrals written to disk' + endif END_PROVIDER diff --git a/src/ao_one_e_ints/pot_ao_ints.irp.f b/src/ao_one_e_ints/pot_ao_ints.irp.f index 63c02dd2..08c78464 100644 --- a/src/ao_one_e_ints/pot_ao_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_ints.irp.f @@ -83,27 +83,27 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)] END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)] - BEGIN_DOC - ! Nucleus-electron interaction, in the |AO| basis set. - ! - ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` - END_DOC - implicit none - double precision :: alpha, beta, gama, delta - integer :: num_A,num_B - double precision :: A_center(3),B_center(3),C_center(3) - integer :: power_A(3),power_B(3) - integer :: i,j,k,l,n_pt_in,m - double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult - - if (read_ao_integrals_n_e) then - call ezfio_get_ao_one_e_ints_ao_integrals_n_e_imag(ao_integrals_n_e_imag) - print *, 'AO N-e integrals read from disk' - else - print *, irp_here, ': Not yet implemented' - endif -END_PROVIDER +!BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)] +! BEGIN_DOC +! ! Nucleus-electron interaction, in the |AO| basis set. +! ! +! ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` +! END_DOC +! implicit none +! double precision :: alpha, beta, gama, delta +! integer :: num_A,num_B +! double precision :: A_center(3),B_center(3),C_center(3) +! integer :: power_A(3),power_B(3) +! integer :: i,j,k,l,n_pt_in,m +! double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult +! +! if (read_ao_integrals_n_e) then +! call ezfio_get_ao_one_e_ints_ao_integrals_n_e_imag(ao_integrals_n_e_imag) +! print *, 'AO N-e integrals read from disk' +! else +! print *, irp_here, ': Not yet implemented' +! endif +!END_PROVIDER BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)] implicit none @@ -112,13 +112,12 @@ BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)] ! ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` END_DOC - integer :: i,j - do i=1,ao_num - do j=1,ao_num - ao_integrals_n_e_complex(j,i) = dcmplx(ao_integrals_n_e(j,i), & - ao_integrals_n_e_imag(j,i)) - enddo - enddo + if (read_ao_integrals_n_e) then + call ezfio_get_ao_one_e_ints_ao_integrals_n_e_complex(ao_integrals_n_e_complex) + print *, 'AO N-e integrals read from disk' + else + print *, irp_here, ': Not yet implemented' + endif END_PROVIDER BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)] diff --git a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f index a92ba1f4..0032b2ae 100644 --- a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f @@ -27,34 +27,39 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)] END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_imag, (ao_num, ao_num) ] - implicit none - BEGIN_DOC - ! Imaginary part of the pseudo_integrals - END_DOC - if (read_ao_integrals_pseudo) then - call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) - print *, 'AO pseudo_integrals integrals read from disk' - else - ao_pseudo_integrals_imag = 0.d0 - endif - if (write_ao_integrals_pseudo) then - call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) - print *, 'AO pseudo_integrals integrals written to disk' - endif -END_PROVIDER +!BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_imag, (ao_num, ao_num) ] +! implicit none +! BEGIN_DOC +! ! Imaginary part of the pseudo_integrals +! END_DOC +! if (read_ao_integrals_pseudo) then +! call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) +! print *, 'AO pseudo_integrals integrals read from disk' +! else +! ao_pseudo_integrals_imag = 0.d0 +! endif +! if (write_ao_integrals_pseudo) then +! call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num)) +! print *, 'AO pseudo_integrals integrals written to disk' +! endif +!END_PROVIDER BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_complex, (ao_num, ao_num) ] implicit none BEGIN_DOC ! Overlap for complex AOs END_DOC - integer :: i,j - do j=1,ao_num - do i=1,ao_num - ao_pseudo_integrals_complex(i,j) = dcmplx( ao_pseudo_integrals(i,j), ao_pseudo_integrals_imag(i,j) ) - enddo - enddo + if (read_ao_integrals_pseudo) then + call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_complex(ao_pseudo_integrals_complex) + print *, 'AO pseudo_integrals integrals read from disk' + else + print*,irp_here,'not implemented' + stop -1 + endif + if (write_ao_integrals_pseudo) then + call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_complex(ao_pseudo_integrals_complex) + print *, 'AO pseudo_integrals integrals written to disk' + endif END_PROVIDER BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)] diff --git a/src/ao_two_e_ints/EZFIO.cfg b/src/ao_two_e_ints/EZFIO.cfg index fad4c836..5b50f718 100644 --- a/src/ao_two_e_ints/EZFIO.cfg +++ b/src/ao_two_e_ints/EZFIO.cfg @@ -29,15 +29,9 @@ doc: Read/Write df |AO| integrals from/to disk [ Write | Read | None ] interface: ezfio,provider,ocaml default: None -[df_ao_integrals_real] +[df_ao_integrals_complex] type: double precision doc: Real part of the df integrals over AOs -size: (ao_basis.ao_kpt_num,ao_basis.ao_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) -interface: ezfio - -[df_ao_integrals_imag] -type: double precision -doc: Imaginary part of the df integrals over AOs -size: (ao_basis.ao_kpt_num,ao_basis.ao_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) interface: ezfio diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f index 20f5f21c..dd936519 100644 --- a/src/ao_two_e_ints/df_ao_ints.irp.f +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -1,6 +1,52 @@ - BEGIN_PROVIDER [double precision, df_ao_integrals_real, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [double precision, df_ao_integrals_imag, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_kpt_num,ao_kpt_num,df_num,kpt_pair_num)] +! BEGIN_PROVIDER [double precision, df_ao_integrals_real, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] +! &BEGIN_PROVIDER [double precision, df_ao_integrals_imag, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] +! &BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] +! implicit none +! BEGIN_DOC +! ! df AO integrals +! END_DOC +! integer :: i,j,k,l +! +! if (read_df_ao_integrals) then +! df_ao_integrals_real = 0.d0 +! df_ao_integrals_imag = 0.d0 +! call ezfio_get_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) +! call ezfio_get_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) +! print *, 'df AO integrals read from disk' +! do l=1,kpt_pair_num +! do k=1,df_num +! do j=1,ao_num_per_kpt +! do i=1,ao_num_per_kpt +! df_ao_integrals_complex(i,j,k,l) = dcmplx(df_ao_integrals_real(i,j,k,l), & +! df_ao_integrals_imag(i,j,k,l)) +! enddo +! enddo +! enddo +! enddo +! else +! print*,'df ao integrals must be provided',irp_here +! stop -1 +! endif +! +! if (write_df_ao_integrals) then +! ! this probably shouldn't happen +! do l=1,kpt_pair_num +! do k=1,df_num +! do j=1,ao_num_per_kpt +! do i=1,ao_num_per_kpt +! df_ao_integrals_real(i,j,k,l) = dble(df_ao_integrals_complex(i,j,k,l)) +! df_ao_integrals_imag(i,j,k,l) = dimag(df_ao_integrals_complex(i,j,k,l)) +! enddo +! enddo +! enddo +! enddo +! call ezfio_set_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) +! call ezfio_set_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) +! print *, 'df AO integrals written to disk' +! endif +! +! END_PROVIDER + BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] implicit none BEGIN_DOC ! df AO integrals @@ -8,42 +54,217 @@ integer :: i,j,k,l if (read_df_ao_integrals) then - df_ao_integrals_real = 0.d0 - df_ao_integrals_imag = 0.d0 - call ezfio_get_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) - call ezfio_get_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) + call ezfio_get_ao_two_e_ints_df_ao_integrals_complex(df_ao_integrals_complex) print *, 'df AO integrals read from disk' - do l=1,kpt_pair_num - do k=1,df_num - do j=1,ao_kpt_num - do i=1,ao_kpt_num - df_ao_integrals_complex(i,j,k,l) = dcmplx(df_ao_integrals_real(i,j,k,l), & - df_ao_integrals_imag(i,j,k,l)) - enddo - enddo - enddo - enddo else print*,'df ao integrals must be provided',irp_here stop -1 endif if (write_df_ao_integrals) then - ! this probably shouldn't happen - do l=1,kpt_pair_num - do k=1,df_num - do j=1,ao_kpt_num - do i=1,ao_kpt_num - df_ao_integrals_real(i,j,k,l) = dble(df_ao_integrals_complex(i,j,k,l)) - df_ao_integrals_imag(i,j,k,l) = dimag(df_ao_integrals_complex(i,j,k,l)) - enddo - enddo - enddo - enddo - call ezfio_set_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) - call ezfio_set_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) + call ezfio_set_ao_two_e_ints_df_ao_integrals_complex(df_ao_integrals_complex) print *, 'df AO integrals written to disk' endif END_PROVIDER + +subroutine ao_map_fill_from_df + use map_module + implicit none + BEGIN_DOC + ! fill ao bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_ao,j_ao,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:) + + complex*16 :: integral + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: ao_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(keY_kind) :: idx_tmp + double precision :: sign + + ao_num_kpt_2 = ao_num_per_kpt * ao_num_per_kpt + + size_buffer = min(ao_num_per_kpt*ao_num_per_kpt*ao_num_per_kpt,16000000) + print*, 'Providing the ao_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(ao_num_per_kpt,ao_num_per_kpt,df_num)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) + + !$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, & + !$OMP ints_ik, ints_ikjl, i_ao, j_ao, i_df, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, ao_num_per_kpt, ao_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP kconserv, df_ao_integrals_complex, ao_integrals_threshold, ao_integrals_map, ao_integrals_map_2) + + allocate( & + ints_ik(ao_num_per_kpt,ao_num_per_kpt,df_num), & + ints_ikjl(ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt), & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + !$OMP DO SCHEDULE(guided) + do kk=1,kl + ki=kconserv(kl,kk,kj) + if ((kl == kj) .and. (ki > kk)) cycle + call idx2_tri_int(ki,kk,kikk2) + if (kikk2 > kjkl2) cycle + if (ki >= kk) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_ao_integrals_complex(:,:,:,kikk2) + endif + + call zgemm('N','T', ao_num_kpt_2, ao_num_kpt_2, df_num, & + (1.d0,0.d0), ints_ik, ao_num_kpt_2, & + ints_jl, ao_num_kpt_2, & + (0.d0,0.d0), ints_ikjl, ao_num_kpt_2) + + n_integrals_1=0 + n_integrals_2=0 + do il=1,ao_num_per_kpt + l=il+(kl-1)*ao_num_per_kpt + do ij=1,ao_num_per_kpt + j=ij+(kj-1)*ao_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,ao_num_per_kpt + k=ik+(kk-1)*ao_num_per_kpt + if (k>l) exit + do ii=1,ao_num_per_kpt + i=ii+(ki-1)*ao_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = ints_ikjl(ii,ik,ij,il) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < ao_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + + if (n_integrals_1 > 0) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + enddo !kk + !$OMP END DO NOWAIT + deallocate( & + ints_ik, & + ints_ikjl, & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(ao_integrals_map),'+',map_mb(ao_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl ) + + call map_sort(ao_integrals_map) + call map_unique(ao_integrals_map) + call map_sort(ao_integrals_map_2) + call map_unique(ao_integrals_map_2) + !call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map) + !call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2) + !call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_ao_map_size, ao_map_size + ao_map_size = get_ao_map_size() + + print*,'AO integrals provided:' + print*,' Size of AO map ', map_mb(ao_integrals_map),'+',map_mb(ao_integrals_map_2),'MB' + print*,' Number of AO integrals: ', ao_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine ao_map_fill_from_df + diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_complex.irp.f index dc4e5542..449bca02 100644 --- a/src/ao_two_e_ints/map_integrals_complex.irp.f +++ b/src/ao_two_e_ints/map_integrals_complex.irp.f @@ -1,6 +1,26 @@ use map_module +subroutine idx2_tri_int(i,j,ij) + implicit none + integer, intent(in) :: i,j + integer, intent(out) :: ij + integer :: p,q + p = max(i,j) + q = min(i,j) + ij = q+ishft(p*p-p,-1) +end + +subroutine idx2_tri_key(i,j,ij) + use map_module + implicit none + integer, intent(in) :: i,j + integer(key_kind), intent(out) :: ij + integer(key_kind) :: p,q + p = max(i,j) + q = min(i,j) + ij = q+ishft(p*p-p,-1) +end subroutine two_e_integrals_index_complex(i,j,k,l,i1,p,q) use map_module implicit none diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f index f3bb5c20..8cfd29fb 100644 --- a/src/ao_two_e_ints/two_e_integrals.irp.f +++ b/src/ao_two_e_ints/two_e_integrals.irp.f @@ -359,6 +359,11 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ] print*, 'AO integrals provided (periodic)' ao_two_e_integrals_in_map = .True. return + else if (read_df_ao_integrals) then + call ao_map_fill_from_df + print*, 'AO integrals provided from 3-index ao ints (periodic)' + ao_two_e_integrals_in_map = .True. + return else print*,'calculation of periodic AOs not implemented' stop -1 diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index f667f04f..fd9303aa 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -9,17 +9,11 @@ doc: Coefficient of the i-th |AO| on the j-th |MO| interface: ezfio size: (ao_basis.ao_num,mo_basis.mo_num) -[mo_coef_real] +[mo_coef_complex] type: double precision -doc: Imaginary part of the MO coefficient of the i-th |AO| on the j-th |MO| +doc: Complex MO coefficient of the i-th |AO| on the j-th |MO| interface: ezfio -size: (ao_basis.ao_num,mo_basis.mo_num) - -[mo_coef_imag] -type: double precision -doc: Imaginary part of the MO coefficient of the i-th |AO| on the j-th |MO| -interface: ezfio -size: (ao_basis.ao_num,mo_basis.mo_num) +size: (2,ao_basis.ao_num,mo_basis.mo_num) [mo_label] type: character*(64) @@ -43,7 +37,7 @@ type: character*(32) doc: MD5 checksum characterizing the |AO| basis set. interface: ezfio -[mo_kpt_num] +[mo_num_per_kpt] type: integer doc: Number of |MOs| per kpt interface: ezfio diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index 35987220..2e2f0786 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -1,11 +1,74 @@ -BEGIN_PROVIDER [ integer, mo_kpt_num ] +BEGIN_PROVIDER [ integer, mo_num_per_kpt ] implicit none BEGIN_DOC ! number of mos per kpt. END_DOC - mo_kpt_num = mo_num/kpt_num + mo_num_per_kpt = mo_num/kpt_num END_PROVIDER +!BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] +! implicit none +! BEGIN_DOC +! ! Molecular orbital coefficients on |AO| basis set +! ! +! ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| +! ! +! ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) +! END_DOC +! integer :: i, j +! double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) +! logical :: exists_re,exists_im,exists +! PROVIDE ezfio_filename +! +! +! if (mpi_master) then +! ! Coefs +! call ezfio_has_mo_basis_mo_coef_real(exists_re) +! call ezfio_has_mo_basis_mo_coef_imag(exists_im) +! exists = (exists_re.and.exists_im) +! endif +! IRP_IF MPI_DEBUG +! print *, irp_here, mpi_rank +! call MPI_BARRIER(MPI_COMM_WORLD, ierr) +! IRP_ENDIF +! IRP_IF MPI +! include 'mpif.h' +! integer :: ierr +! call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read mo_coef_real/imag with MPI' +! endif +! IRP_ENDIF +! +! if (exists) then +! if (mpi_master) then +! allocate(buffer_re(ao_num,mo_num),buffer_im(ao_num,mo_num)) +! call ezfio_get_mo_basis_mo_coef_real(buffer_re) +! call ezfio_get_mo_basis_mo_coef_imag(buffer_im) +! write(*,*) 'Read mo_coef_real/imag' +! do i=1,mo_num +! do j=1,ao_num +! mo_coef_complex(j,i) = dcmplx(buffer_re(j,i),buffer_im(j,i)) +! enddo +! enddo +! deallocate(buffer_re,buffer_im) +! endif +! IRP_IF MPI +! call MPI_BCAST( mo_coef_complex, mo_num*ao_num, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) +! if (ierr /= MPI_SUCCESS) then +! stop 'Unable to read mo_coef_real with MPI' +! endif +! IRP_ENDIF +! else +! ! Orthonormalized AO basis +! do i=1,mo_num +! do j=1,ao_num +! mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i) +! enddo +! enddo +! endif +!END_PROVIDER + BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] implicit none BEGIN_DOC @@ -16,16 +79,13 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) END_DOC integer :: i, j - double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) - logical :: exists_re,exists_im,exists + logical :: exists PROVIDE ezfio_filename if (mpi_master) then ! Coefs - call ezfio_has_mo_basis_mo_coef_real(exists_re) - call ezfio_has_mo_basis_mo_coef_imag(exists_im) - exists = (exists_re.and.exists_im) + call ezfio_has_mo_basis_mo_coef_complex(exists) endif IRP_IF MPI_DEBUG print *, irp_here, mpi_rank @@ -36,27 +96,19 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] integer :: ierr call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_real/imag with MPI' + stop 'Unable to read mo_coef_complex with MPI' endif IRP_ENDIF if (exists) then if (mpi_master) then - allocate(buffer_re(ao_num,mo_num),buffer_im(ao_num,mo_num)) - call ezfio_get_mo_basis_mo_coef_real(buffer_re) - call ezfio_get_mo_basis_mo_coef_imag(buffer_im) - write(*,*) 'Read mo_coef_real/imag' - do i=1,mo_num - do j=1,ao_num - mo_coef_complex(j,i) = dcmplx(buffer_re(j,i),buffer_im(j,i)) - enddo - enddo - deallocate(buffer_re,buffer_im) + call ezfio_get_mo_basis_mo_coef_complex(mo_coef_complex) + write(*,*) 'Read mo_coef_complex' endif IRP_IF MPI call MPI_BCAST( mo_coef_complex, mo_num*ao_num, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then - stop 'Unable to read mo_coef_real with MPI' + stop 'Unable to read mo_coef_complex with MPI' endif IRP_ENDIF else diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index a84f9fb7..5f93bb2f 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -1,6 +1,7 @@ subroutine save_mos implicit none - double precision, allocatable :: buffer(:,:),buffer_im(:,:) + double precision, allocatable :: buffer(:,:) + complex*16, allocatable :: buffer_c(:,:) integer :: i,j !TODO: change this for periodic? ! save real/imag parts of mo_coef_complex @@ -11,18 +12,15 @@ subroutine save_mos call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then - allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) - buffer = 0.d0 - buffer_im = 0.d0 + allocate ( buffer_c(ao_num,mo_num)) + buffer_c = (0.d0,0.d0) do j = 1, mo_num do i = 1, ao_num - buffer(i,j) = dble(mo_coef_complex(i,j)) - buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + buffer_c(i,j) = mo_coef_complex(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_real(buffer) - call ezfio_set_mo_basis_mo_coef_imag(buffer_im) - deallocate (buffer,buffer_im) + call ezfio_set_mo_basis_mo_coef_complex(buffer_c) + deallocate (buffer_c) else allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 @@ -42,7 +40,8 @@ end subroutine save_mos_no_occ implicit none - double precision, allocatable :: buffer(:,:),buffer_im(:,:) + double precision, allocatable :: buffer(:,:) + complex*16, allocatable :: buffer_c(:,:) integer :: i,j call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename)) @@ -50,18 +49,15 @@ subroutine save_mos_no_occ !call ezfio_set_mo_basis_mo_label(mo_label) !call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then - allocate ( buffer(ao_num,mo_num),buffer_im(ao_num,mo_num)) - buffer = 0.d0 - buffer_im = 0.d0 + allocate ( buffer_c(ao_num,mo_num)) + buffer_c = (0.d0,0.d0) do j = 1, mo_num do i = 1, ao_num - buffer(i,j) = dble(mo_coef_complex(i,j)) - buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + buffer_c(i,j) = mo_coef_complex(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_real(buffer) - call ezfio_set_mo_basis_mo_coef_imag(buffer_im) - deallocate (buffer,buffer_im) + call ezfio_set_mo_basis_mo_coef_complex(buffer_c) + deallocate (buffer_c) else allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 @@ -78,7 +74,8 @@ end subroutine save_mos_truncated(n) implicit none - double precision, allocatable :: buffer(:,:),buffer_im(:,:) + double precision, allocatable :: buffer(:,:) + complex*16, allocatable :: buffer_c(:,:) integer :: i,j,n call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename)) @@ -87,18 +84,15 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then - allocate ( buffer(ao_num,n),buffer_im(ao_num,n)) - buffer = 0.d0 - buffer_im = 0.d0 + allocate ( buffer_c(ao_num,mo_num)) + buffer_c = (0.d0,0.d0) do j = 1, n do i = 1, ao_num - buffer(i,j) = dble(mo_coef_complex(i,j)) - buffer_im(i,j) = dimag(mo_coef_complex(i,j)) + buffer_c(i,j) = mo_coef_complex(i,j) enddo enddo - call ezfio_set_mo_basis_mo_coef_real(buffer) - call ezfio_set_mo_basis_mo_coef_imag(buffer_im) - deallocate (buffer,buffer_im) + call ezfio_set_mo_basis_mo_coef_complex(buffer_c) + deallocate (buffer_c) else allocate ( buffer(ao_num,n) ) buffer = 0.d0 diff --git a/src/mo_two_e_ints/EZFIO.cfg b/src/mo_two_e_ints/EZFIO.cfg index 92bc086c..fc1ff2e1 100644 --- a/src/mo_two_e_ints/EZFIO.cfg +++ b/src/mo_two_e_ints/EZFIO.cfg @@ -20,12 +20,12 @@ default: None [df_mo_integrals_real] type: double precision doc: Real part of the df integrals over MOs -size: (mo_basis.mo_kpt_num,mo_basis.mo_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +size: (mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) interface: ezfio [df_mo_integrals_imag] type: double precision doc: Imaginary part of the df integrals over MOs -size: (mo_basis.mo_kpt_num,mo_basis.mo_kpt_num,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +size: (mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) interface: ezfio diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 62eb683f..5d85056b 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -1,6 +1,6 @@ - BEGIN_PROVIDER [double precision, df_mo_integrals_real, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [double precision, df_mo_integrals_imag, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_kpt_num,mo_kpt_num,df_num,kpt_pair_num)] + BEGIN_PROVIDER [double precision, df_mo_integrals_real, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [double precision, df_mo_integrals_imag, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] +&BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] implicit none BEGIN_DOC ! df AO integrals @@ -15,8 +15,8 @@ print *, 'df AO integrals read from disk' do l=1,kpt_pair_num do k=1,df_num - do j=1,mo_kpt_num - do i=1,mo_kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt df_mo_integrals_complex(i,j,k,l) = dcmplx(df_mo_integrals_real(i,j,k,l), & df_mo_integrals_imag(i,j,k,l)) enddo @@ -24,14 +24,14 @@ enddo enddo else - call df_mo_from_df_ao(df_mo_integrals_complex,df_ao_integrals_complex,mo_kpt_num,ao_kpt_num,df_num,kpt_pair_num) + call df_mo_from_df_ao(df_mo_integrals_complex,df_ao_integrals_complex,mo_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num) endif if (write_df_mo_integrals) then do l=1,kpt_pair_num do k=1,df_num - do j=1,mo_kpt_num - do i=1,mo_kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt df_mo_integrals_real(i,j,k,l) = dble(df_mo_integrals_complex(i,j,k,l)) df_mo_integrals_imag(i,j,k,l) = dimag(df_mo_integrals_complex(i,j,k,l)) enddo diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_complex.irp.f index 8f448d42..d6da7ffb 100644 --- a/src/scf_utils/huckel_complex.irp.f +++ b/src/scf_utils/huckel_complex.irp.f @@ -15,9 +15,9 @@ subroutine huckel_guess_complex A = 0.d0 do j=1,ao_num do i=1,ao_num - A(i,j) = c * ao_overlap_complex(i,j) * (ao_one_e_integrals_diag(i) + ao_one_e_integrals_diag(j)) + A(i,j) = c * ao_overlap_complex(i,j) * (ao_one_e_integrals_diag_complex(i) + ao_one_e_integrals_diag_complex(j)) enddo - A(j,j) = ao_one_e_integrals_diag(j) + dble(ao_two_e_integral_alpha_complex(j,j)) + A(j,j) = ao_one_e_integrals_diag_complex(j) + dble(ao_two_e_integral_alpha_complex(j,j)) if (dabs(dimag(ao_two_e_integral_alpha_complex(j,j))) .gt. 1.0d-10) then stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' endif diff --git a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh index e560ae38..31d273c1 100755 --- a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh +++ b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh @@ -9,16 +9,16 @@ echo 'Create EZFIO' #read nel nmo natom <<< $(cat param) #read e_nucl <<< $(cat e_nuc) #read nao <<< $(cat num_ao) -#read nkpts <<< $(cat num_kpts) +#read nkpts <<< $(cat kpt_num) #read ndf <<< $(cat num_df) ##./create_ezfio_complex_4idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts ./create_ezfio_complex_3idx.py $ezfio $h5file #$nel $natom $nmo $e_nucl $nao $nkpts $ndf #Handle the orbital consitensy check qp_edit -c $ezfio &> /dev/null -cp $ezfio/{ao,mo}_basis/ao_md5 +#cp $ezfio/{ao,mo}_basis/ao_md5 #Read the integral -echo 'Read Integral' +#echo 'Read Integral' ################################################ diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index d76085d1..d909c99e 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -251,7 +251,7 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, with open('num_ao','w') as f: f.write(str(nao*Nk)) - with open('num_kpts','w') as f: + with open('kpt_num','w') as f: f.write(str(Nk)) # _ # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 449050e8..a786f993 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -3,6 +3,7 @@ from ezfio import ezfio import h5py import sys +import numpy as np filename = sys.argv[1] h5filename = sys.argv[2] #num_elec, nucl_num, mo_num = map(int,sys.argv[2:5]) @@ -94,10 +95,6 @@ ezfio.set_ao_basis_ao_power(d) ezfio.set_ao_basis_ao_coef(d) ezfio.set_ao_basis_ao_expo(d) -#Dummy one -ao_md5 = '3b8b464dfc95f282129bde3efef3c502' -ezfio.set_ao_basis_ao_md5(ao_md5) -ezfio.set_mo_basis_ao_md5(ao_md5) ezfio.set_mo_basis_mo_num(mo_num) @@ -105,34 +102,63 @@ ezfio.set_mo_basis_mo_num(mo_num) #ezfio.set_mo_basis_mo_coef([ [0]*mo_num] * ao_num) ##ezfio.set_mo_basis_mo_coef_real(c_mo) +mo_coef_re0 = qph5['mo_basis/mo_coef_real'][()].T +mo_coef_im0 = qph5['mo_basis/mo_coef_imag'][()].T +mo_coef_cmplx0 = np.stack((mo_coef_re0,mo_coef_im0),axis=-1).tolist() -ezfio.set_mo_basis_mo_coef_real(qph5['mo_basis/mo_coef_real'][()].tolist()) -ezfio.set_mo_basis_mo_coef_imag(qph5['mo_basis/mo_coef_imag'][()].tolist()) +#ezfio.set_mo_basis_mo_coef_real(qph5['mo_basis/mo_coef_real'][()].tolist()) +#ezfio.set_mo_basis_mo_coef_imag(qph5['mo_basis/mo_coef_imag'][()].tolist()) +ezfio.set_mo_basis_mo_coef_complex(mo_coef_cmplx0) #maybe fix qp so we don't need this? ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) ezfio.set_nuclei_is_complex(True) +# fortran-ordered re,im parts +kin_ao_re0=qph5['ao_one_e_ints/ao_integrals_kinetic_real'][()].T +kin_ao_im0=qph5['ao_one_e_ints/ao_integrals_kinetic_imag'][()].T +#test where to stack? (axis=0 or -1?) +kin_ao_cmplx0=np.stack((kin_ao_re0,kin_ao_im0),axis=-1).tolist() -kin_ao_re=qph5['ao_one_e_ints/ao_integrals_kinetic_real'][()].T.tolist() -kin_ao_im=qph5['ao_one_e_ints/ao_integrals_kinetic_imag'][()].T.tolist() -ovlp_ao_re=qph5['ao_one_e_ints/ao_integrals_overlap_real'][()].T.tolist() -ovlp_ao_im=qph5['ao_one_e_ints/ao_integrals_overlap_imag'][()].T.tolist() -ne_ao_re=qph5['ao_one_e_ints/ao_integrals_n_e_real'][()].T.tolist() -ne_ao_im=qph5['ao_one_e_ints/ao_integrals_n_e_imag'][()].T.tolist() +ovlp_ao_re0=qph5['ao_one_e_ints/ao_integrals_overlap_real'][()].T +ovlp_ao_im0=qph5['ao_one_e_ints/ao_integrals_overlap_imag'][()].T +#test where to stack? (axis=0 or -1?) +ovlp_ao_cmplx0=np.stack((ovlp_ao_re0,ovlp_ao_im0),axis=-1).tolist() -ezfio.set_ao_one_e_ints_ao_integrals_kinetic(kin_ao_re) -ezfio.set_ao_one_e_ints_ao_integrals_kinetic_imag(kin_ao_im) -ezfio.set_ao_one_e_ints_ao_integrals_overlap(ovlp_ao_re) -ezfio.set_ao_one_e_ints_ao_integrals_overlap_imag(ovlp_ao_im) -ezfio.set_ao_one_e_ints_ao_integrals_n_e(ne_ao_re) -ezfio.set_ao_one_e_ints_ao_integrals_n_e_imag(ne_ao_im) +ne_ao_re0=qph5['ao_one_e_ints/ao_integrals_n_e_real'][()].T +ne_ao_im0=qph5['ao_one_e_ints/ao_integrals_n_e_imag'][()].T +#test where to stack? (axis=0 or -1?) +ne_ao_cmplx0=np.stack((ne_ao_re0,ne_ao_im0),axis=-1).tolist() + +kin_ao_re=kin_ao_re0.tolist() +kin_ao_im=kin_ao_im0.tolist() +ovlp_ao_re=ovlp_ao_re0.tolist() +ovlp_ao_im=ovlp_ao_im0.tolist() +ne_ao_re=ne_ao_re0.tolist() +ne_ao_im=ne_ao_im0.tolist() + +#kin_ao_c = np.stack(kin_ao_re0,kin_ao_im0 + +#ezfio.set_ao_one_e_ints_ao_integrals_kinetic(kin_ao_re) +#ezfio.set_ao_one_e_ints_ao_integrals_kinetic_imag(kin_ao_im) +ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_cmplx0) + +#ezfio.set_ao_one_e_ints_ao_integrals_overlap(ovlp_ao_re) +#ezfio.set_ao_one_e_ints_ao_integrals_overlap_imag(ovlp_ao_im) +ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_cmplx0) + +#ezfio.set_ao_one_e_ints_ao_integrals_n_e(ne_ao_re) +#ezfio.set_ao_one_e_ints_ao_integrals_n_e_imag(ne_ao_im) +ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_cmplx0) + +dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) +dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) +#ezfio.set_ao_two_e_ints_df_ao_integrals_real(dfao_re.tolist()) +#ezfio.set_ao_two_e_ints_df_ao_integrals_imag(dfao_im.tolist()) +dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() +ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) -dfao_re=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)).tolist() -dfao_im=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)).tolist() -ezfio.set_ao_two_e_ints_df_ao_integrals_real(dfao_re) -ezfio.set_ao_two_e_ints_df_ao_integrals_imag(dfao_im) #TODO: add check and only do this if ints exist #dfmo_re=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)).tolist() From 07f09acd9981865b1704461d78ae63b2c52426b4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 13 Feb 2020 16:33:11 -0600 Subject: [PATCH 075/256] working on 3->4 --- src/ao_two_e_ints/df_ao_ints.irp.f | 4 ++ .../create_ezfio_complex_3idx.py | 32 +++------- src/utils_complex/dump_ao_2e_complex.irp.f | 2 +- src/utils_complex/dump_df_ao.irp.f | 26 ++++++++ .../import_integrals_ao_complex.irp.f | 62 +++++++------------ 5 files changed, 65 insertions(+), 61 deletions(-) create mode 100644 src/utils_complex/dump_df_ao.irp.f diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f index dd936519..6cd508ca 100644 --- a/src/ao_two_e_ints/df_ao_ints.irp.f +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -116,6 +116,7 @@ subroutine ao_map_fill_from_df do kl=1, kpt_num do kj=1, kl call idx2_tri_int(kj,kl,kjkl2) + print*,'kj,kl,kjkl2',kj,kl,kjkl2 ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) !$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, & @@ -142,12 +143,15 @@ subroutine ao_map_fill_from_df ki=kconserv(kl,kk,kj) if ((kl == kj) .and. (ki > kk)) cycle call idx2_tri_int(ki,kk,kikk2) + print*,'ki,kk,kikk2',ki,kk,kikk2 if (kikk2 > kjkl2) cycle if (ki >= kk) then + !if (ki < kk) then !this didn't fix the problem do i_ao=1,ao_num_per_kpt do j_ao=1,ao_num_per_kpt do i_df=1,df_num ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) + !ints_ik(j_ao,i_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) enddo enddo enddo diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index a786f993..31107376 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -78,12 +78,12 @@ ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) # Ao num #ao_num = mo_num -ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") +#ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") ezfio.set_ao_basis_ao_num(ao_num) -ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff +#ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff -#ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) -#ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) +ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) +ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) #Just need one (can clean this up later) @@ -111,7 +111,7 @@ mo_coef_cmplx0 = np.stack((mo_coef_re0,mo_coef_im0),axis=-1).tolist() ezfio.set_mo_basis_mo_coef_complex(mo_coef_cmplx0) #maybe fix qp so we don't need this? -ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) +#ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) ezfio.set_nuclei_is_complex(True) @@ -131,33 +131,21 @@ ne_ao_im0=qph5['ao_one_e_ints/ao_integrals_n_e_imag'][()].T #test where to stack? (axis=0 or -1?) ne_ao_cmplx0=np.stack((ne_ao_re0,ne_ao_im0),axis=-1).tolist() -kin_ao_re=kin_ao_re0.tolist() -kin_ao_im=kin_ao_im0.tolist() -ovlp_ao_re=ovlp_ao_re0.tolist() -ovlp_ao_im=ovlp_ao_im0.tolist() -ne_ao_re=ne_ao_re0.tolist() -ne_ao_im=ne_ao_im0.tolist() - -#kin_ao_c = np.stack(kin_ao_re0,kin_ao_im0 - -#ezfio.set_ao_one_e_ints_ao_integrals_kinetic(kin_ao_re) -#ezfio.set_ao_one_e_ints_ao_integrals_kinetic_imag(kin_ao_im) ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_cmplx0) - -#ezfio.set_ao_one_e_ints_ao_integrals_overlap(ovlp_ao_re) -#ezfio.set_ao_one_e_ints_ao_integrals_overlap_imag(ovlp_ao_im) ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_cmplx0) - -#ezfio.set_ao_one_e_ints_ao_integrals_n_e(ne_ao_re) -#ezfio.set_ao_one_e_ints_ao_integrals_n_e_imag(ne_ao_im) ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_cmplx0) +ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') +ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') +ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) #ezfio.set_ao_two_e_ints_df_ao_integrals_real(dfao_re.tolist()) #ezfio.set_ao_two_e_ints_df_ao_integrals_imag(dfao_im.tolist()) dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) +ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') #TODO: add check and only do this if ints exist diff --git a/src/utils_complex/dump_ao_2e_complex.irp.f b/src/utils_complex/dump_ao_2e_complex.irp.f index 6ed197b4..2db5f614 100644 --- a/src/utils_complex/dump_ao_2e_complex.irp.f +++ b/src/utils_complex/dump_ao_2e_complex.irp.f @@ -15,7 +15,7 @@ subroutine run do k=1,ao_num do l=1,ao_num tmp_cmplx = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) - print'(4(I4),2(E15.7))',i,j,k,l,tmp_cmplx + print'(4(I4),2(E23.15))',i,j,k,l,tmp_cmplx enddo enddo enddo diff --git a/src/utils_complex/dump_df_ao.irp.f b/src/utils_complex/dump_df_ao.irp.f new file mode 100644 index 00000000..5659bd58 --- /dev/null +++ b/src/utils_complex/dump_df_ao.irp.f @@ -0,0 +1,26 @@ +program dump_df_ao + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,mu + complex*16 :: integral + + provide df_ao_integrals_complex + do k=1,kpt_pair_num + do mu=1,df_num + do i=1,ao_num_per_kpt + do j=1,ao_num_per_kpt + integral = df_ao_integrals_complex(i,j,mu,k) + if (cdabs(integral).gt.1.d-12) then + print'(4(I4),4(E15.7))',i,j,mu,k,integral,dble(integral),dimag(integral) + endif + enddo + enddo + enddo + enddo + +end diff --git a/src/utils_complex/import_integrals_ao_complex.irp.f b/src/utils_complex/import_integrals_ao_complex.irp.f index bc20fc17..bf4f3693 100644 --- a/src/utils_complex/import_integrals_ao_complex.irp.f +++ b/src/utils_complex/import_integrals_ao_complex.irp.f @@ -11,7 +11,7 @@ subroutine run integer ::i,j,k,l double precision :: integral - double precision, allocatable :: A(:,:), B(:,:) + complex*16, allocatable :: C(:,:) double precision :: tmp_re, tmp_im integer :: n_integrals_1, n_integrals_2 @@ -24,90 +24,76 @@ subroutine run ! call ezfio_set_ao_basis_ao_num(ao_num) - allocate (A(ao_num,ao_num), B(ao_num,ao_num) ) + allocate (C(ao_num,ao_num)) - A(1,1) = huge(1.d0) + integral = huge(1.d0) iunit = getunitandopen('E.qp','r') - read (iunit,*,end=9) A(1,1) + read (iunit,*,end=9) integral 9 continue close(iunit) - if (A(1,1) /= huge(1.d0)) then - call ezfio_set_nuclei_nuclear_repulsion(A(1,1)) + if (integral /= huge(1.d0)) then + call ezfio_set_nuclei_nuclear_repulsion(integral) call ezfio_set_nuclei_io_nuclear_repulsion("Read") endif - A = 0.d0 - B = 0.d0 + C = (0.d0,0.d0) iunit = getunitandopen('T.qp','r') do read (iunit,*,end=10) i,j, tmp_re, tmp_im - A(i,j) = tmp_re - B(i,j) = tmp_im + C(i,j) = dcmplx(tmp_re,tmp_im) if (i.ne.j) then - A(j,i) = tmp_re - B(j,i) = -tmp_im + C(j,i) = dcmplx(tmp_re,-tmp_im) endif enddo 10 continue close(iunit) - call ezfio_set_ao_one_e_ints_ao_integrals_kinetic(A(1:ao_num, 1:ao_num)) - call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(B(1:ao_num, 1:ao_num)) + call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_complex(C) call ezfio_set_ao_one_e_ints_io_ao_integrals_kinetic("Read") - A = 0.d0 - B = 0.d0 + C = (0.d0,0.d0) iunit = getunitandopen('S.qp','r') do read (iunit,*,end=11) i,j, tmp_re, tmp_im - A(i,j) = tmp_re - B(i,j) = tmp_im + C(i,j) = dcmplx(tmp_re,tmp_im) if (i.ne.j) then - A(j,i) = tmp_re - B(j,i) = -tmp_im + C(j,i) = dcmplx(tmp_re,-tmp_im) endif enddo 11 continue close(iunit) - call ezfio_set_ao_one_e_ints_ao_integrals_overlap(A(1:ao_num, 1:ao_num)) - call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(B(1:ao_num, 1:ao_num)) + call ezfio_set_ao_one_e_ints_ao_integrals_overlap_complex(C) call ezfio_set_ao_one_e_ints_io_ao_integrals_overlap("Read") - A = 0.d0 - B = 0.d0 + C = (0.d0,0.d0) iunit = getunitandopen('P.qp','r') do read (iunit,*,end=14) i,j, tmp_re, tmp_im - A(i,j) = tmp_re - B(i,j) = tmp_im + C(i,j) = dcmplx(tmp_re,tmp_im) if (i.ne.j) then - A(j,i) = tmp_re - B(j,i) = -tmp_im + C(j,i) = dcmplx(tmp_re,-tmp_im) endif enddo 14 continue close(iunit) - call ezfio_set_ao_one_e_ints_ao_integrals_pseudo(A(1:ao_num,1:ao_num)) - call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(B(1:ao_num,1:ao_num)) + call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_complex(C) call ezfio_set_ao_one_e_ints_io_ao_integrals_pseudo("Read") - A = 0.d0 - B = 0.d0 + C = (0.d0,0.d0) iunit = getunitandopen('V.qp','r') do read (iunit,*,end=12) i,j, tmp_re, tmp_im - A(i,j) = tmp_re - B(i,j) = tmp_im + C(i,j) = dcmplx(tmp_re,tmp_im) if (i.ne.j) then - A(j,i) = tmp_re - B(j,i) = -tmp_im + C(j,i) = dcmplx(tmp_re,-tmp_im) endif enddo 12 continue close(iunit) - call ezfio_set_ao_one_e_ints_ao_integrals_n_e(A(1:ao_num, 1:ao_num)) - call ezfio_set_ao_one_e_ints_ao_integrals_n_e_imag(B(1:ao_num, 1:ao_num)) + call ezfio_set_ao_one_e_ints_ao_integrals_n_e_complex(C) call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e("Read") + deallocate(C) + allocate(buffer_i_1(ao_num**3), buffer_values_1(ao_num**3)) allocate(buffer_i_2(ao_num**3), buffer_values_2(ao_num**3)) iunit = getunitandopen('W.qp','r') From 8794296f37a4704d99c34fe0d7f8ecadb3520aee Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 17 Feb 2020 16:16:46 -0600 Subject: [PATCH 076/256] updated converters and fixed ao df ints --- src/ao_one_e_ints/ao_overlap.irp.f | 2 +- src/ao_two_e_ints/df_ao_ints.irp.f | 19 ++-- src/hartree_fock/hf_energy.irp.f | 32 +++---- src/hartree_fock/print_e_scf.irp.f | 19 ++++ src/hartree_fock/scf.irp.f | 4 + src/scf_utils/print_debug_scf_complex.irp.f | 24 +++-- .../scf_density_matrix_ao_complex.irp.f | 18 ++-- .../Gen_Ezfio_from_integral_complex_3idx.sh | 3 + src/utils_complex/MolPyscfToQPkpts.py | 17 +++- src/utils_complex/import_ao_2e_complex.irp.f | 89 +++++++++++++++++++ src/utils_complex/import_kconserv.irp.f | 2 +- 11 files changed, 187 insertions(+), 42 deletions(-) create mode 100644 src/hartree_fock/print_e_scf.irp.f create mode 100644 src/utils_complex/import_ao_2e_complex.irp.f diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 5afadbbe..ad9fcff5 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -260,7 +260,7 @@ BEGIN_PROVIDER [ complex*16, S_half_inv_complex, (AO_num,AO_num) ] integer :: info, i, j, k double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6 - LDA = size(AO_overlap,1) + LDA = size(AO_overlap_complex,1) LDC = size(S_half_inv_complex,1) allocate( & diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f index 6cd508ca..2200fbb5 100644 --- a/src/ao_two_e_ints/df_ao_ints.irp.f +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -116,8 +116,18 @@ subroutine ao_map_fill_from_df do kl=1, kpt_num do kj=1, kl call idx2_tri_int(kj,kl,kjkl2) - print*,'kj,kl,kjkl2',kj,kl,kjkl2 - ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) + !print*,'kj,kl,kjkl2',kj,kl,kjkl2 + if (kj < kl) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_jl(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) + endif !$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, & !$OMP ints_ik, ints_ikjl, i_ao, j_ao, i_df, & @@ -143,15 +153,12 @@ subroutine ao_map_fill_from_df ki=kconserv(kl,kk,kj) if ((kl == kj) .and. (ki > kk)) cycle call idx2_tri_int(ki,kk,kikk2) - print*,'ki,kk,kikk2',ki,kk,kikk2 if (kikk2 > kjkl2) cycle - if (ki >= kk) then - !if (ki < kk) then !this didn't fix the problem + if (ki < kk) then do i_ao=1,ao_num_per_kpt do j_ao=1,ao_num_per_kpt do i_df=1,df_num ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) - !ints_ik(j_ao,i_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) enddo enddo enddo diff --git a/src/hartree_fock/hf_energy.irp.f b/src/hartree_fock/hf_energy.irp.f index db723600..9a5e6d1d 100644 --- a/src/hartree_fock/hf_energy.irp.f +++ b/src/hartree_fock/hf_energy.irp.f @@ -11,50 +11,50 @@ BEGIN_PROVIDER [double precision, extra_e_contrib_density] END_PROVIDER - BEGIN_PROVIDER [ double precision, HF_energy] -&BEGIN_PROVIDER [ double precision, HF_two_electron_energy] -&BEGIN_PROVIDER [ double precision, HF_one_electron_energy] + BEGIN_PROVIDER [ double precision, hf_energy] +&BEGIN_PROVIDER [ double precision, hf_two_electron_energy] +&BEGIN_PROVIDER [ double precision, hf_one_electron_energy] implicit none BEGIN_DOC ! Hartree-Fock energy containing the nuclear repulsion, and its one- and two-body components. END_DOC integer :: i,j - HF_energy = nuclear_repulsion - HF_two_electron_energy = 0.d0 - HF_one_electron_energy = 0.d0 + hf_energy = nuclear_repulsion + hf_two_electron_energy = 0.d0 + hf_one_electron_energy = 0.d0 if (is_complex) then complex*16 :: hf_1e_tmp, hf_2e_tmp hf_1e_tmp = (0.d0,0.d0) hf_2e_tmp = (0.d0,0.d0) do j=1,ao_num do i=1,ao_num - hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_complex(i,j) * SCF_density_matrix_ao_alpha_complex(j,i) & - +ao_two_e_integral_beta_complex(i,j) * SCF_density_matrix_ao_beta_complex(j,i) ) - hf_1e_tmp += ao_one_e_integrals_complex(i,j) * (SCF_density_matrix_ao_alpha_complex(j,i) & - + SCF_density_matrix_ao_beta_complex (j,i) ) + hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_complex(i,j) * scf_density_matrix_ao_alpha_complex(j,i) & + +ao_two_e_integral_beta_complex(i,j) * scf_density_matrix_ao_beta_complex(j,i) ) + hf_1e_tmp += ao_one_e_integrals_complex(i,j) * (scf_density_matrix_ao_alpha_complex(j,i) & + + scf_density_matrix_ao_beta_complex (j,i) ) enddo enddo if (dabs(dimag(hf_2e_tmp)).gt.1.d-10) then print*,'HF_2e energy should be real:',irp_here stop -1 else - HF_two_electron_energy = dble(hf_2e_tmp) + hf_two_electron_energy = dble(hf_2e_tmp) endif if (dabs(dimag(hf_1e_tmp)).gt.1.d-10) then print*,'HF_1e energy should be real:',irp_here stop -1 else - HF_one_electron_energy = dble(hf_1e_tmp) + hf_one_electron_energy = dble(hf_1e_tmp) endif else do j=1,ao_num do i=1,ao_num - HF_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * SCF_density_matrix_ao_alpha(i,j) & - +ao_two_e_integral_beta(i,j) * SCF_density_matrix_ao_beta(i,j) ) - HF_one_electron_energy += ao_one_e_integrals(i,j) * (SCF_density_matrix_ao_alpha(i,j) + SCF_density_matrix_ao_beta (i,j) ) + hf_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * scf_density_matrix_ao_alpha(i,j) & + +ao_two_e_integral_beta(i,j) * scf_density_matrix_ao_beta(i,j) ) + hf_one_electron_energy += ao_one_e_integrals(i,j) * (scf_density_matrix_ao_alpha(i,j) + scf_density_matrix_ao_beta (i,j) ) enddo enddo endif - HF_energy += HF_two_electron_energy + HF_one_electron_energy + hf_energy += hf_two_electron_energy + hf_one_electron_energy END_PROVIDER diff --git a/src/hartree_fock/print_e_scf.irp.f b/src/hartree_fock/print_e_scf.irp.f new file mode 100644 index 00000000..65e97a56 --- /dev/null +++ b/src/hartree_fock/print_e_scf.irp.f @@ -0,0 +1,19 @@ +program print_e_scf + call run +end + +subroutine run + + use bitmasks + implicit none + + call print_debug_scf_complex + + print*,'hf 1e,2e,total energy' + print*,hf_one_electron_energy + print*,hf_two_electron_energy + print*,hf_energy + +end + + diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 8dddda92..276b4e65 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -98,6 +98,10 @@ subroutine run call roothaan_hall_scf endif call ezfio_set_hartree_fock_energy(SCF_energy) + print*,'hf 1e,2e,total energy' + print*,hf_one_electron_energy + print*,hf_two_electron_energy + print*,hf_energy end diff --git a/src/scf_utils/print_debug_scf_complex.irp.f b/src/scf_utils/print_debug_scf_complex.irp.f index 91311c58..65a047c3 100644 --- a/src/scf_utils/print_debug_scf_complex.irp.f +++ b/src/scf_utils/print_debug_scf_complex.irp.f @@ -15,26 +15,36 @@ subroutine print_debug_scf_complex do i=1,ao_num write(*,'(200(E24.15))') scf_density_matrix_ao_alpha_complex(i,:) enddo - write(*,'(A)') 'scf_density_matrix_ao_beta_complex' + write(*,'(A)') 'ao_one_e_integrals_complex' write(*,'(A)') '---------------' do i=1,ao_num - write(*,'(200(E24.15))') scf_density_matrix_ao_beta_complex(i,:) + write(*,'(200(E24.15))') ao_one_e_integrals_complex(i,:) enddo write(*,'(A)') 'ao_two_e_integral_alpha_complex' write(*,'(A)') '---------------' do i=1,ao_num write(*,'(200(E24.15))') ao_two_e_integral_alpha_complex(i,:) enddo - write(*,'(A)') 'ao_two_e_integral_beta_complex' - write(*,'(A)') '---------------' - do i=1,ao_num - write(*,'(200(E24.15))') ao_two_e_integral_beta_complex(i,:) - enddo write(*,'(A)') 'fock_matrix_ao_alpha_complex' write(*,'(A)') '---------------' do i=1,ao_num write(*,'(200(E24.15))') fock_matrix_ao_alpha_complex(i,:) enddo + write(*,'(A)') 'ao_overlap_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_overlap_complex(i,:) + enddo + write(*,'(A)') 'scf_density_matrix_ao_beta_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') scf_density_matrix_ao_beta_complex(i,:) + enddo + write(*,'(A)') 'ao_two_e_integral_beta_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_two_e_integral_beta_complex(i,:) + enddo write(*,'(A)') 'fock_matrix_ao_beta_complex' write(*,'(A)') '---------------' do i=1,ao_num diff --git a/src/scf_utils/scf_density_matrix_ao_complex.irp.f b/src/scf_utils/scf_density_matrix_ao_complex.irp.f index 2bf7b77e..6e22e209 100644 --- a/src/scf_utils/scf_density_matrix_ao_complex.irp.f +++ b/src/scf_utils/scf_density_matrix_ao_complex.irp.f @@ -1,4 +1,4 @@ -BEGIN_PROVIDER [complex*16, SCF_density_matrix_ao_alpha_complex, (ao_num,ao_num) ] +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_alpha_complex, (ao_num,ao_num) ] implicit none BEGIN_DOC ! $C.C^t$ over $\alpha$ MOs @@ -7,11 +7,11 @@ BEGIN_PROVIDER [complex*16, SCF_density_matrix_ao_alpha_complex, (ao_num,ao_num) call zgemm('N','C',ao_num,ao_num,elec_alpha_num,(1.d0,0.d0), & mo_coef_complex, size(mo_coef_complex,1), & mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & - SCF_density_matrix_ao_alpha_complex, size(SCF_density_matrix_ao_alpha_complex,1)) + scf_density_matrix_ao_alpha_complex, size(scf_density_matrix_ao_alpha_complex,1)) END_PROVIDER -BEGIN_PROVIDER [ complex*16, SCF_density_matrix_ao_beta_complex, (ao_num,ao_num) ] +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_beta_complex, (ao_num,ao_num) ] implicit none BEGIN_DOC ! $C.C^t$ over $\beta$ MOs @@ -20,21 +20,21 @@ BEGIN_PROVIDER [ complex*16, SCF_density_matrix_ao_beta_complex, (ao_num,ao_num call zgemm('N','C',ao_num,ao_num,elec_beta_num,(1.d0,0.d0), & mo_coef_complex, size(mo_coef_complex,1), & mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & - SCF_density_matrix_ao_beta_complex, size(SCF_density_matrix_ao_beta_complex,1)) + scf_density_matrix_ao_beta_complex, size(scf_density_matrix_ao_beta_complex,1)) END_PROVIDER -BEGIN_PROVIDER [ complex*16, SCF_density_matrix_ao_complex, (ao_num,ao_num) ] +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_complex, (ao_num,ao_num) ] implicit none BEGIN_DOC ! Sum of $\alpha$ and $\beta$ density matrices END_DOC - ASSERT (size(SCF_density_matrix_ao_complex,1) == size(SCF_density_matrix_ao_alpha_complex,1)) + ASSERT (size(scf_density_matrix_ao_complex,1) == size(scf_density_matrix_ao_alpha_complex,1)) if (elec_alpha_num== elec_beta_num) then - SCF_density_matrix_ao_complex = SCF_density_matrix_ao_alpha_complex + SCF_density_matrix_ao_alpha_complex + scf_density_matrix_ao_complex = scf_density_matrix_ao_alpha_complex + scf_density_matrix_ao_alpha_complex else - ASSERT (size(SCF_density_matrix_ao_complex,1) == size(SCF_density_matrix_ao_beta_complex ,1)) - SCF_density_matrix_ao_complex = SCF_density_matrix_ao_alpha_complex + SCF_density_matrix_ao_beta_complex + ASSERT (size(scf_density_matrix_ao_complex,1) == size(scf_density_matrix_ao_beta_complex ,1)) + scf_density_matrix_ao_complex = scf_density_matrix_ao_alpha_complex + scf_density_matrix_ao_beta_complex endif END_PROVIDER diff --git a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh index 31d273c1..9bce8816 100755 --- a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh +++ b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh @@ -17,6 +17,9 @@ echo 'Create EZFIO' qp_edit -c $ezfio &> /dev/null #cp $ezfio/{ao,mo}_basis/ao_md5 +qp_run import_kconserv $ezfio +#qp_run import_ao_2e_complex $ezfio +#qp_run dump_ao_2e_from_df $ezfio #Read the integral #echo 'Read Integral' diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index d909c99e..e0284096 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -508,6 +508,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, natom = cell.natm nelec = cell.nelectron + neleca,nelecb = cell.nelec atom_xyz = mf.cell.atom_coords() if not(mf.cell.unit.startswith(('B','b','au','AU'))): atom_xyz /= nist.BOHR # always convert to au @@ -537,8 +538,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print("n df fitting functions", naux) #in old version: param << nelec*Nk, nmo*Nk, natom*Nk - qph5['electrons'].attrs['elec_alpha_num']=nelec*Nk - qph5['electrons'].attrs['elec_beta_num']=nelec*Nk + qph5['electrons'].attrs['elec_alpha_num']=neleca*Nk + qph5['electrons'].attrs['elec_beta_num']=nelecb*Nk qph5['mo_basis'].attrs['mo_num']=Nk*nmo qph5['ao_basis'].attrs['ao_num']=Nk*nao qph5['nuclei'].attrs['nucl_num']=Nk*natom @@ -572,6 +573,18 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + + with open('C.qp','w') as outfile: + c_kpts = np.reshape(mo_k,(Nk,nao,nmo)) + + for ik in range(Nk): + shift1=ik*nao+1 + shift2=ik*nmo+1 + for i in range(nao): + for j in range(nmo): + cij = c_kpts[ik,i,j] + if abs(cij) > mo_coef_threshold: + outfile.write('%s %s %s %s\n' % (i+shift1, j+shift2, cij.real, cij.imag)) # ___ # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ diff --git a/src/utils_complex/import_ao_2e_complex.irp.f b/src/utils_complex/import_ao_2e_complex.irp.f new file mode 100644 index 00000000..f22e6c50 --- /dev/null +++ b/src/utils_complex/import_ao_2e_complex.irp.f @@ -0,0 +1,89 @@ +program import_ao_2e_complex + call run +end + +subroutine run + use map_module + implicit none + + integer :: iunit + integer :: getunitandopen + + integer ::i,j,k,l + double precision :: integral + complex*16, allocatable :: C(:,:) + double precision :: tmp_re, tmp_im + + integer :: n_integrals_1, n_integrals_2 + integer(key_kind), allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind), allocatable :: buffer_values_1(:), buffer_values_2(:) + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + + +! call ezfio_set_ao_basis_ao_num(ao_num) + + allocate(buffer_i_1(ao_num**3), buffer_values_1(ao_num**3)) + allocate(buffer_i_2(ao_num**3), buffer_values_2(ao_num**3)) + iunit = getunitandopen('W.qp','r') + n_integrals_1=0 + n_integrals_2=0 + buffer_values_1 = 0.d0 + buffer_values_2 = 0.d0 + do + read (iunit,*,end=13) i,j,k,l, tmp_re, tmp_im + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) +! print'(4(I4),(L3),(I6),(F7.1))',i,j,k,l,use_map1,idx_tmp,sign + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re +! print'(A,4(I4),(I6),(E15.7))','map1',i,j,k,l,idx_tmp,tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign +! print'(A,4(I4),(I6),(E15.7))','map1',i,j,k,l,idx_tmp+1,tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re +! print'(A,4(I4),(I6),(E15.7))','map2',i,j,k,l,idx_tmp,tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign +! print'(A,4(I4),(I6),(E15.7))','map2',i,j,k,l,idx_tmp+1,tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + enddo + 13 continue + close(iunit) + + if (n_integrals_1 > 0) then + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + + call map_sort(ao_integrals_map) + call map_unique(ao_integrals_map) + call map_sort(ao_integrals_map_2) + call map_unique(ao_integrals_map_2) + + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map) + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2) + call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read') + +end diff --git a/src/utils_complex/import_kconserv.irp.f b/src/utils_complex/import_kconserv.irp.f index 0dff268b..d15b1eed 100644 --- a/src/utils_complex/import_kconserv.irp.f +++ b/src/utils_complex/import_kconserv.irp.f @@ -22,7 +22,7 @@ subroutine run allocate(A(kpt_num,kpt_num,kpt_num)) A = 0 - iunit = getunitandopen('kconserv','r') + iunit = getunitandopen('K.qp','r') do read (iunit,*,end=10) i,j,k,l A(i,j,k) = l From 3c0ef34836d184a488b0cd69fc2e11f6093aea0d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 18 Feb 2020 10:50:00 -0600 Subject: [PATCH 077/256] ao 3idx testing --- src/ao_two_e_ints/df_ao_ints.irp.f | 1 - src/utils_complex/dump_ao_2e_from_df.irp.f | 116 +++++++++++++++++++++ 2 files changed, 116 insertions(+), 1 deletion(-) create mode 100644 src/utils_complex/dump_ao_2e_from_df.irp.f diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f index 2200fbb5..289b7777 100644 --- a/src/ao_two_e_ints/df_ao_ints.irp.f +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -116,7 +116,6 @@ subroutine ao_map_fill_from_df do kl=1, kpt_num do kj=1, kl call idx2_tri_int(kj,kl,kjkl2) - !print*,'kj,kl,kjkl2',kj,kl,kjkl2 if (kj < kl) then do i_ao=1,ao_num_per_kpt do j_ao=1,ao_num_per_kpt diff --git a/src/utils_complex/dump_ao_2e_from_df.irp.f b/src/utils_complex/dump_ao_2e_from_df.irp.f new file mode 100644 index 00000000..2115a872 --- /dev/null +++ b/src/utils_complex/dump_ao_2e_from_df.irp.f @@ -0,0 +1,116 @@ +program dump_ao_2e_from_df + call run_ao_dump +end + +subroutine run_ao_dump + use map_module + implicit none + BEGIN_DOC + ! fill ao bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_ao,j_ao,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:) + + complex*16 :: integral,intmap, get_ao_two_e_integral_complex + double precision :: tmp_re,tmp_im + integer :: ao_num_kpt_2 + + logical :: use_map1 + integer(keY_kind) :: idx_tmp + double precision :: sign + + ao_num_kpt_2 = ao_num_per_kpt * ao_num_per_kpt + + + allocate( ints_jl(ao_num_per_kpt,ao_num_per_kpt,df_num)) + + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_jl(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) + endif + + allocate( & + ints_ik(ao_num_per_kpt,ao_num_per_kpt,df_num), & + ints_ikjl(ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt) & + ) + + do kk=1,kl + ki=kconserv(kl,kk,kj) + if ((kl == kj) .and. (ki > kk)) cycle + call idx2_tri_int(ki,kk,kikk2) + if (kikk2 > kjkl2) cycle + if (ki < kk) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_ao_integrals_complex(:,:,:,kikk2) + endif + + call zgemm('N','T', ao_num_kpt_2, ao_num_kpt_2, df_num, & + (1.d0,0.d0), ints_ik, ao_num_kpt_2, & + ints_jl, ao_num_kpt_2, & + (0.d0,0.d0), ints_ikjl, ao_num_kpt_2) + + do il=1,ao_num_per_kpt + l=il+(kl-1)*ao_num_per_kpt + do ij=1,ao_num_per_kpt + j=ij+(kj-1)*ao_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,ao_num_per_kpt + k=ik+(kk-1)*ao_num_per_kpt + if (k>l) exit + do ii=1,ao_num_per_kpt + i=ii+(ki-1)*ao_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = ints_ikjl(ii,ik,ij,il) + intmap = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) +! print*,i,k,j,l,real(integral),imag(integral) + if ((cdabs(integral) + cdabs(intmap)) < ao_integrals_threshold) then + cycle + endif + if (cdabs(integral-intmap) < 1.d-8) then + print'(4(I4),4(E15.7))',i,j,k,l,integral,intmap + else + print'(4(I4),4(E15.7),(A))',i,j,k,l,integral,intmap,'***' + endif + enddo !ii + enddo !ik + enddo !ij + enddo !il + enddo !kk + deallocate( & + ints_ik, & + ints_ikjl & + ) + enddo !kj + enddo !kl + deallocate( ints_jl ) + + +end + From 02c6539daadd972760c06cd479008f749efe61c1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 18 Feb 2020 14:11:22 -0600 Subject: [PATCH 078/256] fixed problem with iterating over unique 2-electron integrals should loop over union of two sets of integrals: set 1: i<=k j<=l ik<=jl set 2: i>k j kk)) cycle + if (ki>kl) cycle + ! if ((kl == kj) .and. (ki > kk)) cycle call idx2_tri_int(ki,kk,kikk2) - if (kikk2 > kjkl2) cycle + ! if (kikk2 > kjkl2) cycle if (ki < kk) then do i_ao=1,ao_num_per_kpt do j_ao=1,ao_num_per_kpt diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index e0284096..707599df 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -472,6 +472,199 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) +def testprintbi(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8): + ''' + kpts = List of kpoints coordinates. Cannot be null, for gamma is other script + kmesh = Mesh of kpoints (optional) + cas_idx = List of active MOs. If not specified all MOs are actives + int_threshold = The integral will be not printed in they are bellow that + ''' + + from pyscf.pbc import ao2mo + from pyscf.pbc import tools + from pyscf.pbc.gto import ecp + from pyscf.data import nist + import h5py + import scipy + + + bielec_int_threshold = int_threshold + + natom = cell.natm + nelec = cell.nelectron + neleca,nelecb = cell.nelec + atom_xyz = mf.cell.atom_coords() + if not(mf.cell.unit.startswith(('B','b','au','AU'))): + atom_xyz /= nist.BOHR # always convert to au + + strtype=h5py.special_dtype(vlen=str) + atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) + for i in range(natom): + atom_dset[i] = mf.cell.atom_pure_symbol(i) + qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) + qph5.create_dataset('nuclei/nucl_charge',data=mf.cell.atom_charges()) + + + print('n_atom per kpt', natom) + print('num_elec per kpt', nelec) + + mo_coeff = mf.mo_coeff + # Mo_coeff actif + mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) + e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) + + Nk, nao, nmo = mo_k.shape + print("n Kpts", Nk) + print("n active Mos per kpt", nmo) + print("n AOs per kpt", nao) + + naux = mf.with_df.auxcell.nao + print("n df fitting functions", naux) + + #in old version: param << nelec*Nk, nmo*Nk, natom*Nk + + + + # ___ _ + # | ._ _|_ _ _ ._ _. | _ |_) o + # _|_ | | |_ (/_ (_| | (_| | _> |_) | + # _| + # + kconserv = tools.get_kconserv(cell, kpts) + qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) + kcon_test = np.zeros((Nk,Nk,Nk),dtype=int) + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + kcon_test[a,c,b] = kconserv[a,b,c]+1 + qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) + + + with open('K.qp','w') as outfile: + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + d = kconserv[a,b,c] + outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) + + + intfile=h5py.File(mf.with_df._cderi,'r') + + j3c = intfile.get('j3c') + naosq = nao*nao + naotri = (nao*(nao+1))//2 + j3ckeys = list(j3c.keys()) + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + j3clist = [j3c.get(i+'/0') for i in j3ckeys] + if j3clist==[None]*len(j3clist): + # if using older version, stop before last level + j3clist = [j3c.get(i) for i in j3ckeys] + + nkinvsq = 1./np.sqrt(Nk) + + # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j + # output dimensions should be reversed (nao, nao, naux, nkptpairs) + j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + + nkpt_pairs = j3arr.shape[0] + df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) + + if print_ao_ints_df: + with open('D.qp','w') as outfile: + pass + with open('D.qp','a') as outfile: + for k,kpt_pair in enumerate(j3arr): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + df_ao_tmp[i,j,iaux,k]=v + + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) + + if print_mo_ints_df: + kpair_list=[] + for i in range(Nk): + for j in range(Nk): + if(i>=j): + kpair_list.append((i,j,idx2_tri((i,j)))) + j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) + df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) + with open('D_mo.qp','w') as outfile: + pass + with open('D_mo.qp','a') as outfile: + for k,kpt_pair in enumerate(j3mo): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + df_mo_tmp[i,j,iaux,k]=v + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) + + + +# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) +# for d, kd in enumerate(kpts): +# for c, kc in enumerate(kpts): +# if c > d: break +# idx2_cd = idx2_tri(c,d) +# for b, kb in enumerate(kpts): +# if b > d: break +# a = kconserv[b,c,d] +# if idx2_tri(a,b) > idx2_cd: continue +# if ((c==d) and (a>b)): continue +# ka = kpts[a] +# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) +# v *= 1./Nk +# eri_4d_ao[a,:,b,:,c,:,d] = v +# +# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) + + + with open('W.qp','w') as outfile: + pass + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + #if idx2_tri((a,b)) > idx2_cd: continue + if a>d: continue + #if ((c==d) and (a>b)): continue + ka = kpts[a] + + with open('W.qp','a') as outfile: + eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) + eri_4d_ao_kpt *= 1./Nk + for l in range(nao): + ll=l+d*nao + for j in range(nao): + jj=j+c*nao + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nao): + kk=k+b*nao + if kk>ll: break + for i in range(nao): + ii=i+a*nao + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_ao_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + + + def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_ao_ints_bi=False, print_mo_ints_bi=False, @@ -754,8 +947,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for b, kb in enumerate(kpts): if b > d: break a = kconserv[b,c,d] - if idx2_tri((a,b)) > idx2_cd: continue - if ((c==d) and (a>b)): continue + #if idx2_tri((a,b)) > idx2_cd: continue + if a > d: continue + #if ((c==d) and (a>b)): continue ka = kpts[a] if print_ao_ints_bi: diff --git a/src/utils_complex/dump_ao_2e_from_df.irp.f b/src/utils_complex/dump_ao_2e_from_df.irp.f index 2115a872..1ca00e09 100644 --- a/src/utils_complex/dump_ao_2e_from_df.irp.f +++ b/src/utils_complex/dump_ao_2e_from_df.irp.f @@ -52,9 +52,10 @@ subroutine run_ao_dump do kk=1,kl ki=kconserv(kl,kk,kj) - if ((kl == kj) .and. (ki > kk)) cycle + if (ki > kl) cycle + !if ((kl == kj) .and. (ki > kk)) cycle call idx2_tri_int(ki,kk,kikk2) - if (kikk2 > kjkl2) cycle + !if (kikk2 > kjkl2) cycle if (ki < kk) then do i_ao=1,ao_num_per_kpt do j_ao=1,ao_num_per_kpt @@ -72,7 +73,7 @@ subroutine run_ao_dump (1.d0,0.d0), ints_ik, ao_num_kpt_2, & ints_jl, ao_num_kpt_2, & (0.d0,0.d0), ints_ikjl, ao_num_kpt_2) - + print'((A),4(I4))','IJKL',ki,kj,kk,kl do il=1,ao_num_per_kpt l=il+(kl-1)*ao_num_per_kpt do ij=1,ao_num_per_kpt diff --git a/src/utils_complex/dump_ao_2e_from_df_all.irp.f b/src/utils_complex/dump_ao_2e_from_df_all.irp.f new file mode 100644 index 00000000..5ca67f11 --- /dev/null +++ b/src/utils_complex/dump_ao_2e_from_df_all.irp.f @@ -0,0 +1,117 @@ +program dump_ao_2e_from_df + call run_ao_dump +end + +subroutine run_ao_dump + use map_module + implicit none + BEGIN_DOC + ! fill ao bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_ao,j_ao,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:) + + complex*16 :: integral,intmap, get_ao_two_e_integral_complex + double precision :: tmp_re,tmp_im + integer :: ao_num_kpt_2 + + logical :: use_map1 + integer(keY_kind) :: idx_tmp + double precision :: sign + + ao_num_kpt_2 = ao_num_per_kpt * ao_num_per_kpt + + + allocate( ints_jl(ao_num_per_kpt,ao_num_per_kpt,df_num)) + + do kl=1, kpt_num + do kj=1, kpt_num + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_jl(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_ao_integrals_complex(:,:,:,kjkl2) + endif + + allocate( & + ints_ik(ao_num_per_kpt,ao_num_per_kpt,df_num), & + ints_ikjl(ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt) & + ) + + do kk=1,kpt_num + ki=kconserv(kl,kk,kj) +! if ((kl == kj) .and. (ki > kk)) cycle + call idx2_tri_int(ki,kk,kikk2) +! if (kikk2 > kjkl2) cycle + if (ki < kk) then + do i_ao=1,ao_num_per_kpt + do j_ao=1,ao_num_per_kpt + do i_df=1,df_num + ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_ao_integrals_complex(:,:,:,kikk2) + endif + + call zgemm('N','T', ao_num_kpt_2, ao_num_kpt_2, df_num, & + (1.d0,0.d0), ints_ik, ao_num_kpt_2, & + ints_jl, ao_num_kpt_2, & + (0.d0,0.d0), ints_ikjl, ao_num_kpt_2) + print'((A),4(I4))','IJKL',ki,kj,kk,kl + do il=1,ao_num_per_kpt + l=il+(kl-1)*ao_num_per_kpt + do ij=1,ao_num_per_kpt + j=ij+(kj-1)*ao_num_per_kpt +! if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,ao_num_per_kpt + k=ik+(kk-1)*ao_num_per_kpt +! if (k>l) exit + do ii=1,ao_num_per_kpt + i=ii+(ki-1)*ao_num_per_kpt +! if ((j==l) .and. (i>k)) exit +! call idx2_tri_int(i,k,ik2) +! if (ik2 > jl2) exit + integral = ints_ikjl(ii,ik,ij,il) + intmap = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2) +! print*,i,k,j,l,real(integral),imag(integral) + if ((cdabs(integral) + cdabs(intmap)) < ao_integrals_threshold) then + cycle + endif + if (cdabs(integral-intmap) < 1.d-14) then + cycle + !print'(4(I4),4(E15.7))',i,j,k,l,integral,intmap + else + print'(4(I4),4(E15.7),(A))',i,j,k,l,integral,intmap,'***' + endif + enddo !ii + enddo !ik + enddo !ij + enddo !il + enddo !kk + deallocate( & + ints_ik, & + ints_ikjl & + ) + enddo !kj + enddo !kl + deallocate( ints_jl ) + + +end + From b3390f2fa38025108c194430ea6ac686b25c1626 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 18 Feb 2020 14:20:49 -0600 Subject: [PATCH 079/256] cleanup --- src/ao_two_e_ints/df_ao_ints.irp.f | 50 +----------------------------- 1 file changed, 1 insertion(+), 49 deletions(-) diff --git a/src/ao_two_e_ints/df_ao_ints.irp.f b/src/ao_two_e_ints/df_ao_ints.irp.f index 3c82c703..870f81be 100644 --- a/src/ao_two_e_ints/df_ao_ints.irp.f +++ b/src/ao_two_e_ints/df_ao_ints.irp.f @@ -1,52 +1,4 @@ -! BEGIN_PROVIDER [double precision, df_ao_integrals_real, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] -! &BEGIN_PROVIDER [double precision, df_ao_integrals_imag, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] -! &BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] -! implicit none -! BEGIN_DOC -! ! df AO integrals -! END_DOC -! integer :: i,j,k,l -! -! if (read_df_ao_integrals) then -! df_ao_integrals_real = 0.d0 -! df_ao_integrals_imag = 0.d0 -! call ezfio_get_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) -! call ezfio_get_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) -! print *, 'df AO integrals read from disk' -! do l=1,kpt_pair_num -! do k=1,df_num -! do j=1,ao_num_per_kpt -! do i=1,ao_num_per_kpt -! df_ao_integrals_complex(i,j,k,l) = dcmplx(df_ao_integrals_real(i,j,k,l), & -! df_ao_integrals_imag(i,j,k,l)) -! enddo -! enddo -! enddo -! enddo -! else -! print*,'df ao integrals must be provided',irp_here -! stop -1 -! endif -! -! if (write_df_ao_integrals) then -! ! this probably shouldn't happen -! do l=1,kpt_pair_num -! do k=1,df_num -! do j=1,ao_num_per_kpt -! do i=1,ao_num_per_kpt -! df_ao_integrals_real(i,j,k,l) = dble(df_ao_integrals_complex(i,j,k,l)) -! df_ao_integrals_imag(i,j,k,l) = dimag(df_ao_integrals_complex(i,j,k,l)) -! enddo -! enddo -! enddo -! enddo -! call ezfio_set_ao_two_e_ints_df_ao_integrals_real(df_ao_integrals_real) -! call ezfio_set_ao_two_e_ints_df_ao_integrals_imag(df_ao_integrals_imag) -! print *, 'df AO integrals written to disk' -! endif -! -! END_PROVIDER - BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] +BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)] implicit none BEGIN_DOC ! df AO integrals From 1c09b7dcbcc95887aa5e1a471c823b48f175c54e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 18 Feb 2020 15:34:55 -0600 Subject: [PATCH 080/256] converter cleanup --- src/utils_complex/MolPyscfToQPkpts.py | 339 ++++++++------------------ 1 file changed, 101 insertions(+), 238 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 707599df..55e4800d 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -27,6 +27,19 @@ def pad(arr_in,outshape): arr_out[dataslice] = arr_in return arr_out +def idx40(i,j,k,l): + return idx2_tri((idx2_tri((i,k)),idx2_tri((j,l)))) + +def idx4(i,j,k,l): + return idx2_tri((idx2_tri((i-1,k-1)),idx2_tri((j-1,l-1))))+1 + +def stri4z(i,j,k,l,zr,zi): + return (4*'{:5d}'+2*'{:25.16e}').format(i,j,k,l,zr,zi) + +def strijklikjli4z(i,j,k,l,zr,zi): + return ('{:10d}'+ 2*'{:8d}'+4*'{:5d}'+2*'{:25.16e}').format(idx4(i,j,k,l),idx2_tri((i-1,k-1))+1,idx2_tri((j-1,l-1))+1,i,j,k,l,zr,zi) + + def makesq(vlist,n1,n2): ''' make hermitian matrices of size (n2 x n2) from from lower triangles @@ -409,260 +422,110 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # # eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) - - if (print_ao_ints_bi or print_mo_ints_bi): - if print_ao_ints_bi: - with open('bielec_ao_complex','w') as outfile: - pass - if print_mo_ints_bi: - with open('bielec_mo_complex','w') as outfile: - pass - for d, kd in enumerate(kpts): - for c, kc in enumerate(kpts): - if c > d: break - idx2_cd = idx2_tri((c,d)) - for b, kb in enumerate(kpts): - if b > d: break - a = kconserv[b,c,d] - if idx2_tri((a,b)) > idx2_cd: continue - if ((c==d) and (a>b)): continue - ka = kpts[a] - - if print_ao_ints_bi: - with open('bielec_ao_complex','a') as outfile: - eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) - eri_4d_ao_kpt *= 1./Nk - for l in range(nao): - ll=l+d*nao - for j in range(nao): - jj=j+c*nao - if jj>ll: break - idx2_jjll = idx2_tri((jj,ll)) - for k in range(nao): - kk=k+b*nao - if kk>ll: break - for i in range(nao): - ii=i+a*nao - if idx2_tri((ii,kk)) > idx2_jjll: break - if ((jj==ll) and (ii>kk)): break - v=eri_4d_ao_kpt[i,k,j,l] - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) - - if print_mo_ints_bi: - with open('bielec_mo_complex','a') as outfile: - eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], - [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) - eri_4d_mo_kpt *= 1./Nk - for l in range(nmo): - ll=l+d*nmo - for j in range(nmo): - jj=j+c*nmo - if jj>ll: break - idx2_jjll = idx2_tri((jj,ll)) - for k in range(nmo): - kk=k+b*nmo - if kk>ll: break - for i in range(nmo): - ii=i+a*nmo - if idx2_tri((ii,kk)) > idx2_jjll: break - if ((jj==ll) and (ii>kk)): break - v=eri_4d_mo_kpt[i,k,j,l] - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + if (print_ao_ints_bi): + print_ao_bi(mf,kconserv,'bielec_ao_complex',bielec_int_threshold) + if (print_mo_ints_bi): + print_mo_bi(mf,kconserv,'bielec_mo_complex',cas_idx,bielec_int_threshold) -def testprintbi(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8): - ''' - kpts = List of kpoints coordinates. Cannot be null, for gamma is other script - kmesh = Mesh of kpoints (optional) - cas_idx = List of active MOs. If not specified all MOs are actives - int_threshold = The integral will be not printed in they are bellow that - ''' - - from pyscf.pbc import ao2mo - from pyscf.pbc import tools - from pyscf.pbc.gto import ecp - from pyscf.data import nist - import h5py - import scipy +def print_mo_bi(mf,kconserv=None,outfilename='W.mo.qp',cas_idx=None,bielec_int_threshold = 1E-8): + cell = mf.cell + kpts = mf.kpts + #nao = mf.cell.nao + #Nk = kpts.shape[0] - bielec_int_threshold = int_threshold - - natom = cell.natm - nelec = cell.nelectron - neleca,nelecb = cell.nelec - atom_xyz = mf.cell.atom_coords() - if not(mf.cell.unit.startswith(('B','b','au','AU'))): - atom_xyz /= nist.BOHR # always convert to au - - strtype=h5py.special_dtype(vlen=str) - atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) - for i in range(natom): - atom_dset[i] = mf.cell.atom_pure_symbol(i) - qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) - qph5.create_dataset('nuclei/nucl_charge',data=mf.cell.atom_charges()) - - - print('n_atom per kpt', natom) - print('num_elec per kpt', nelec) - mo_coeff = mf.mo_coeff # Mo_coeff actif mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) - e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) Nk, nao, nmo = mo_k.shape - print("n Kpts", Nk) - print("n active Mos per kpt", nmo) - print("n AOs per kpt", nao) - naux = mf.with_df.auxcell.nao - print("n df fitting functions", naux) - - #in old version: param << nelec*Nk, nmo*Nk, natom*Nk - + if (kconserv is None): + from pyscf.pbc import tools + kconserv = tools.get_kconserv(cell, kpts) - - # ___ _ - # | ._ _|_ _ _ ._ _. | _ |_) o - # _|_ | | |_ (/_ (_| | (_| | _> |_) | - # _| - # - kconserv = tools.get_kconserv(cell, kpts) - qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) - kcon_test = np.zeros((Nk,Nk,Nk),dtype=int) - for a in range(Nk): - for b in range(Nk): - for c in range(Nk): - kcon_test[a,c,b] = kconserv[a,b,c]+1 - qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) - - - with open('K.qp','w') as outfile: - for a in range(Nk): - for b in range(Nk): - for c in range(Nk): - d = kconserv[a,b,c] - outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) - - - intfile=h5py.File(mf.with_df._cderi,'r') - - j3c = intfile.get('j3c') - naosq = nao*nao - naotri = (nao*(nao+1))//2 - j3ckeys = list(j3c.keys()) - j3ckeys.sort(key=lambda strkey:int(strkey)) - - # in new(?) version of PySCF, there is an extra layer of groups before the datasets - # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] - # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] - j3clist = [j3c.get(i+'/0') for i in j3ckeys] - if j3clist==[None]*len(j3clist): - # if using older version, stop before last level - j3clist = [j3c.get(i) for i in j3ckeys] - - nkinvsq = 1./np.sqrt(Nk) - - # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j - # output dimensions should be reversed (nao, nao, naux, nkptpairs) - j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) - - nkpt_pairs = j3arr.shape[0] - df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) - - if print_ao_ints_df: - with open('D.qp','w') as outfile: - pass - with open('D.qp','a') as outfile: - for k,kpt_pair in enumerate(j3arr): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) - df_ao_tmp[i,j,iaux,k]=v - - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) - - if print_mo_ints_df: - kpair_list=[] - for i in range(Nk): - for j in range(Nk): - if(i>=j): - kpair_list.append((i,j,idx2_tri((i,j)))) - j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) - df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) - with open('D_mo.qp','w') as outfile: - pass - with open('D_mo.qp','a') as outfile: - for k,kpt_pair in enumerate(j3mo): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) - df_mo_tmp[i,j,iaux,k]=v - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) + with open(outfilename,'w') as outfile: + pass + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + #idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if a > d: continue + #if idx2_tri((a,b)) > idx2_cd: continue + #if ((c==d) and (a>b)): continue + ka = kpts[a] + with open(outfilename,'a') as outfile: + eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], + [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) + eri_4d_mo_kpt *= 1./Nk + for l in range(nmo): + ll=l+d*nmo + for j in range(nmo): + jj=j+c*nmo + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nmo): + kk=k+b*nmo + if kk>ll: break + for i in range(nmo): + ii=i+a*nmo + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_mo_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1,v.real,v.imag)+'\n') +def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E-8): -# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) -# for d, kd in enumerate(kpts): -# for c, kc in enumerate(kpts): -# if c > d: break -# idx2_cd = idx2_tri(c,d) -# for b, kb in enumerate(kpts): -# if b > d: break -# a = kconserv[b,c,d] -# if idx2_tri(a,b) > idx2_cd: continue -# if ((c==d) and (a>b)): continue -# ka = kpts[a] -# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) -# v *= 1./Nk -# eri_4d_ao[a,:,b,:,c,:,d] = v -# -# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) + cell = mf.cell + kpts = mf.kpts + nao = mf.cell.nao + Nk = kpts.shape[0] + + if (kconserv is None): + from pyscf.pbc import tools + kconserv = tools.get_kconserv(cell, kpts) + + with open(outfilename,'w') as outfile: + pass + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + #idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if a > d: continue + #if idx2_tri((a,b)) > idx2_cd: continue + #if ((c==d) and (a>b)): continue + ka = kpts[a] + + with open(outfilename,'a') as outfile: + eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) + eri_4d_ao_kpt *= 1./Nk + for l in range(nao): + ll=l+d*nao + for j in range(nao): + jj=j+c*nao + if jj>ll: break + idx2_jjll = idx2_tri((jj,ll)) + for k in range(nao): + kk=k+b*nao + if kk>ll: break + for i in range(nao): + ii=i+a*nao + if idx2_tri((ii,kk)) > idx2_jjll: break + if ((jj==ll) and (ii>kk)): break + v=eri_4d_ao_kpt[i,k,j,l] + if (abs(v) > bielec_int_threshold): + outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1,v.real,v.imag)+'\n') - with open('W.qp','w') as outfile: - pass - for d, kd in enumerate(kpts): - for c, kc in enumerate(kpts): - if c > d: break - idx2_cd = idx2_tri((c,d)) - for b, kb in enumerate(kpts): - if b > d: break - a = kconserv[b,c,d] - #if idx2_tri((a,b)) > idx2_cd: continue - if a>d: continue - #if ((c==d) and (a>b)): continue - ka = kpts[a] - - with open('W.qp','a') as outfile: - eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) - eri_4d_ao_kpt *= 1./Nk - for l in range(nao): - ll=l+d*nao - for j in range(nao): - jj=j+c*nao - if jj>ll: break - idx2_jjll = idx2_tri((jj,ll)) - for k in range(nao): - kk=k+b*nao - if kk>ll: break - for i in range(nao): - ii=i+a*nao - if idx2_tri((ii,kk)) > idx2_jjll: break - if ((jj==ll) and (ii>kk)): break - v=eri_4d_ao_kpt[i,k,j,l] - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) - def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, From 727ab502c55d49067a5b66795ca47f37042fb900 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 18 Feb 2020 18:32:47 -0600 Subject: [PATCH 081/256] working on 3idx mo ints --- src/mo_basis/mos_complex.irp.f | 152 ++--------- src/mo_two_e_ints/EZFIO.cfg | 12 +- src/mo_two_e_ints/df_mo_ints.irp.f | 256 +++++++++++++++--- src/mo_two_e_ints/mo_bi_integrals.irp.f | 4 + src/utils_complex/MolPyscfToQPkpts.py | 182 +++---------- src/utils_complex/NEED | 1 + .../create_ezfio_complex_3idx.py | 28 +- 7 files changed, 313 insertions(+), 322 deletions(-) diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index 2e2f0786..e8c543ec 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -6,69 +6,6 @@ BEGIN_PROVIDER [ integer, mo_num_per_kpt ] mo_num_per_kpt = mo_num/kpt_num END_PROVIDER -!BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] -! implicit none -! BEGIN_DOC -! ! Molecular orbital coefficients on |AO| basis set -! ! -! ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| -! ! -! ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) -! END_DOC -! integer :: i, j -! double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) -! logical :: exists_re,exists_im,exists -! PROVIDE ezfio_filename -! -! -! if (mpi_master) then -! ! Coefs -! call ezfio_has_mo_basis_mo_coef_real(exists_re) -! call ezfio_has_mo_basis_mo_coef_imag(exists_im) -! exists = (exists_re.and.exists_im) -! endif -! IRP_IF MPI_DEBUG -! print *, irp_here, mpi_rank -! call MPI_BARRIER(MPI_COMM_WORLD, ierr) -! IRP_ENDIF -! IRP_IF MPI -! include 'mpif.h' -! integer :: ierr -! call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read mo_coef_real/imag with MPI' -! endif -! IRP_ENDIF -! -! if (exists) then -! if (mpi_master) then -! allocate(buffer_re(ao_num,mo_num),buffer_im(ao_num,mo_num)) -! call ezfio_get_mo_basis_mo_coef_real(buffer_re) -! call ezfio_get_mo_basis_mo_coef_imag(buffer_im) -! write(*,*) 'Read mo_coef_real/imag' -! do i=1,mo_num -! do j=1,ao_num -! mo_coef_complex(j,i) = dcmplx(buffer_re(j,i),buffer_im(j,i)) -! enddo -! enddo -! deallocate(buffer_re,buffer_im) -! endif -! IRP_IF MPI -! call MPI_BCAST( mo_coef_complex, mo_num*ao_num, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read mo_coef_real with MPI' -! endif -! IRP_ENDIF -! else -! ! Orthonormalized AO basis -! do i=1,mo_num -! do j=1,ao_num -! mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i) -! enddo -! enddo -! endif -!END_PROVIDER - BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] implicit none BEGIN_DOC @@ -82,7 +19,6 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] logical :: exists PROVIDE ezfio_filename - if (mpi_master) then ! Coefs call ezfio_has_mo_basis_mo_coef_complex(exists) @@ -121,73 +57,6 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] endif END_PROVIDER -! BEGIN_PROVIDER [ double precision, mo_coef_real, (ao_num,mo_num) ] -!&BEGIN_PROVIDER [ double precision, mo_coef_imag, (ao_num,mo_num) ] -!&BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] -! implicit none -! BEGIN_DOC -! ! Molecular orbital coefficients on |AO| basis set -! ! -! ! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO| -! ! -! ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) -! END_DOC -! integer :: i, j -! double precision, allocatable :: buffer_re(:,:),buffer_im(:,:) -! logical :: exists_re,exists_im,exists -! PROVIDE ezfio_filename -! -! -! if (mpi_master) then -! ! Coefs -! call ezfio_has_mo_basis_mo_coef_real(exists_re) -! call ezfio_has_mo_basis_mo_coef_imag(exists_im) -! exists = (exists_re.and.exists_im) -! endif -! IRP_IF MPI_DEBUG -! print *, irp_here, mpi_rank -! call MPI_BARRIER(MPI_COMM_WORLD, ierr) -! IRP_ENDIF -! IRP_IF MPI -! include 'mpif.h' -! integer :: ierr -! call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read mo_coef_real/imag with MPI' -! endif -! IRP_ENDIF -! -! if (exists) then -! if (mpi_master) then -! call ezfio_get_mo_basis_mo_coef_real(mo_coef_real) -! call ezfio_get_mo_basis_mo_coef_imag(mo_coef_imag) -! write(*,*) 'Read mo_coef_real/imag' -! endif -! IRP_IF MPI -! call MPI_BCAST( mo_coef_real, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read mo_coef_real with MPI' -! endif -! call MPI_BCAST( mo_coef_imag, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -! if (ierr /= MPI_SUCCESS) then -! stop 'Unable to read mo_coef_imag with MPI' -! endif -! IRP_ENDIF -! do i=1,mo_num -! do j=1,ao_num -! mo_coef_complex(j,i) = dcmplx(mo_coef_real(j,i),mo_coef_imag(j,i)) -! enddo -! enddo -! else -! ! Orthonormalized AO basis -! do i=1,mo_num -! do j=1,ao_num -! mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i) -! enddo -! enddo -! endif -!END_PROVIDER - BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ] implicit none @@ -201,6 +70,27 @@ BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & mo_coef_in_ao_ortho_basis_complex, size(mo_coef_in_ao_ortho_basis_complex,1)) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, mo_coef_complex_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! nonzero blocks of |MO| coefficients + ! + END_DOC + integer :: i,j,k, mo_shft, ao_shft + mo_coef_complex_kpts = (0.d0,0.d0) + + do k=1,kpt_num + mo_shft = (k-1)*mo_num_per_kpt + ao_shft = (k-1)*ao_num_per_kpt + do i=1,mo_num_per_kpt + do j=1,ao_num_per_kpt + mo_coef_complex_kpts(j,i,k) = mo_coef_complex(j+ao_shft,i+mo_shft) + enddo + enddo + enddo + END_PROVIDER BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex, (mo_num,ao_num) ] diff --git a/src/mo_two_e_ints/EZFIO.cfg b/src/mo_two_e_ints/EZFIO.cfg index fc1ff2e1..8cb039ea 100644 --- a/src/mo_two_e_ints/EZFIO.cfg +++ b/src/mo_two_e_ints/EZFIO.cfg @@ -17,15 +17,9 @@ doc: Read/Write df |MO| integrals from/to disk [ Write | Read | None ] interface: ezfio,provider,ocaml default: None -[df_mo_integrals_real] +[df_mo_integrals_complex] type: double precision -doc: Real part of the df integrals over MOs -size: (mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) -interface: ezfio - -[df_mo_integrals_imag] -type: double precision -doc: Imaginary part of the df integrals over MOs -size: (mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) +doc: Complex df integrals over MOs +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num) interface: ezfio diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 5d85056b..7a0ab82a 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -1,50 +1,238 @@ - BEGIN_PROVIDER [double precision, df_mo_integrals_real, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [double precision, df_mo_integrals_imag, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] -&BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] +BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)] implicit none BEGIN_DOC - ! df AO integrals + ! df MO integrals END_DOC integer :: i,j,k,l if (read_df_mo_integrals) then - df_mo_integrals_real = 0.d0 - df_mo_integrals_imag = 0.d0 - call ezfio_get_mo_two_e_ints_df_mo_integrals_real(df_mo_integrals_real) - call ezfio_get_mo_two_e_ints_df_mo_integrals_imag(df_mo_integrals_imag) - print *, 'df AO integrals read from disk' - do l=1,kpt_pair_num - do k=1,df_num - do j=1,mo_num_per_kpt - do i=1,mo_num_per_kpt - df_mo_integrals_complex(i,j,k,l) = dcmplx(df_mo_integrals_real(i,j,k,l), & - df_mo_integrals_imag(i,j,k,l)) - enddo - enddo - enddo - enddo + call ezfio_get_mo_two_e_ints_df_mo_integrals_complex(df_mo_integrals_complex) + print *, 'df MO integrals read from disk' else call df_mo_from_df_ao(df_mo_integrals_complex,df_ao_integrals_complex,mo_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num) endif if (write_df_mo_integrals) then - do l=1,kpt_pair_num - do k=1,df_num - do j=1,mo_num_per_kpt - do i=1,mo_num_per_kpt - df_mo_integrals_real(i,j,k,l) = dble(df_mo_integrals_complex(i,j,k,l)) - df_mo_integrals_imag(i,j,k,l) = dimag(df_mo_integrals_complex(i,j,k,l)) - enddo - enddo - enddo - enddo - call ezfio_set_mo_two_e_ints_df_mo_integrals_real(df_mo_integrals_real) - call ezfio_set_mo_two_e_ints_df_mo_integrals_imag(df_mo_integrals_imag) - print *, 'df AO integrals written to disk' + call ezfio_set_mo_two_e_ints_df_mo_integrals_complex(df_mo_integrals_complex) + print *, 'df MO integrals written to disk' endif END_PROVIDER +subroutine mo_map_fill_from_df + use map_module + implicit none + BEGIN_DOC + ! fill mo bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_mo,j_mo,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:) + + complex*16 :: integral + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: mo_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(keY_kind) :: idx_tmp + double precision :: sign + + mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt + + size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000) + print*, 'Providing the mo_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(mo_num_per_kpt,mo_num_per_kpt,df_num)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_mo_integrals_complex(:,:,:,kjkl2) + endif + + !$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, & + !$OMP ints_ik, ints_ikjl, i_mo, j_mo, i_df, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, mo_integrals_map, mo_integrals_map_2) + + allocate( & + ints_ik(mo_num_per_kpt,mo_num_per_kpt,df_num), & + ints_ikjl(mo_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt), & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + !$OMP DO SCHEDULE(guided) + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + ! if ((kl == kj) .and. (ki > kk)) cycle + call idx2_tri_int(ki,kk,kikk2) + ! if (kikk2 > kjkl2) cycle + if (ki < kk) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_mo_integrals_complex(:,:,:,kikk2) + endif + + call zgemm('N','T', mo_num_kpt_2, mo_num_kpt_2, df_num, & + (1.d0,0.d0), ints_ik, mo_num_kpt_2, & + ints_jl, mo_num_kpt_2, & + (0.d0,0.d0), ints_ikjl, mo_num_kpt_2) + + n_integrals_1=0 + n_integrals_2=0 + do il=1,mo_num_per_kpt + l=il+(kl-1)*mo_num_per_kpt + do ij=1,mo_num_per_kpt + j=ij+(kj-1)*mo_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,mo_num_per_kpt + k=ik+(kk-1)*mo_num_per_kpt + if (k>l) exit + do ii=1,mo_num_per_kpt + i=ii+(ki-1)*mo_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = ints_ikjl(ii,ik,ij,il) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < mo_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + + if (n_integrals_1 > 0) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + enddo !kk + !$OMP END DO NOWAIT + deallocate( & + ints_ik, & + ints_ikjl, & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl ) + + call map_sort(mo_integrals_map) + call map_unique(mo_integrals_map) + call map_sort(mo_integrals_map_2) + call map_unique(mo_integrals_map_2) + !call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + !call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) + !call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_map_size, mo_map_size + mo_map_size = get_mo_map_size() + + print*,'MO integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine mo_map_fill_from_df + subroutine df_mo_from_df_ao(df_mo,df_ao,n_mo,n_ao,n_df,n_k_pairs) use map_module implicit none @@ -70,9 +258,9 @@ subroutine df_mo_from_df_ao(df_mo,df_ao,n_mo,n_ao,n_df,n_k_pairs) ) do kl=1, kpt_num - coef_l = mo_coef_kpts(:,:,kl) + coef_l = mo_coef_complex_kpts(:,:,kl) do kj=1, kl - coef_j = mo_coef_kpts(:,:,kj) + coef_j = mo_coef_complex_kpts(:,:,kj) kjkl2 = kj+shiftr(kl*kl-kl,1) do mu=1, df_num ints_jl = df_ao(:,:,mu,kjkl2) diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index bdaa86c9..08fb82ba 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -41,6 +41,10 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) print*, 'MO integrals provided (periodic)' return + else if (read_df_mo_integrals) then + PROVIDE df_mo_integrals_complex + call mo_map_fill_from_df + return else PROVIDE ao_two_e_integrals_in_map endif diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 55e4800d..5ebaa995 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -36,6 +36,9 @@ def idx4(i,j,k,l): def stri4z(i,j,k,l,zr,zi): return (4*'{:5d}'+2*'{:25.16e}').format(i,j,k,l,zr,zi) +def stri2z(i,j,zr,zi): + return (2*'{:5d}'+2*'{:25.16e}').format(i,j,zr,zi) + def strijklikjli4z(i,j,k,l,zr,zi): return ('{:10d}'+ 2*'{:8d}'+4*'{:5d}'+2*'{:25.16e}').format(idx4(i,j,k,l),idx2_tri((i-1,k-1))+1,idx2_tri((j-1,l-1))+1,i,j,k,l,zr,zi) @@ -322,7 +325,7 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for j in range(i,nao): int_ij = intval_kpts_ao[ik,i,j] if abs(int_ij) > thresh: - outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') if print_mo_ints_mono: intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) with open('%s_mo_complex' % name,'w') as outfile: @@ -332,7 +335,7 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for j in range(i,nmo): int_ij = intval_kpts_mo[ik,i,j] if abs(int_ij) > thresh: - outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') # ___ _ @@ -383,7 +386,7 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') if print_mo_ints_df: kpair_list=[] @@ -400,28 +403,9 @@ def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - - -# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) -# for d, kd in enumerate(kpts): -# for c, kc in enumerate(kpts): -# if c > d: break -# idx2_cd = idx2_tri(c,d) -# for b, kb in enumerate(kpts): -# if b > d: break -# a = kconserv[b,c,d] -# if idx2_tri(a,b) > idx2_cd: continue -# if ((c==d) and (a>b)): continue -# ka = kpts[a] -# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) -# v *= 1./Nk -# eri_4d_ao[a,:,b,:,c,:,d] = v -# -# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) - if (print_ao_ints_bi): print_ao_bi(mf,kconserv,'bielec_ao_complex',bielec_int_threshold) if (print_mo_ints_bi): @@ -446,19 +430,17 @@ def print_mo_bi(mf,kconserv=None,outfilename='W.mo.qp',cas_idx=None,bielec_int_t kconserv = tools.get_kconserv(cell, kpts) with open(outfilename,'w') as outfile: - pass - for d, kd in enumerate(kpts): - for c, kc in enumerate(kpts): - if c > d: break - #idx2_cd = idx2_tri((c,d)) - for b, kb in enumerate(kpts): - if b > d: break - a = kconserv[b,c,d] - if a > d: continue - #if idx2_tri((a,b)) > idx2_cd: continue - #if ((c==d) and (a>b)): continue - ka = kpts[a] - with open(outfilename,'a') as outfile: + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + #idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if a > d: continue + #if idx2_tri((a,b)) > idx2_cd: continue + #if ((c==d) and (a>b)): continue + ka = kpts[a] eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) eri_4d_mo_kpt *= 1./Nk @@ -477,7 +459,8 @@ def print_mo_bi(mf,kconserv=None,outfilename='W.mo.qp',cas_idx=None,bielec_int_t if ((jj==ll) and (ii>kk)): break v=eri_4d_mo_kpt[i,k,j,l] if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1,v.real,v.imag)+'\n') + outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1, + v.real,v.imag)+'\n') def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E-8): @@ -492,21 +475,20 @@ def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E kconserv = tools.get_kconserv(cell, kpts) with open(outfilename,'w') as outfile: - pass - for d, kd in enumerate(kpts): - for c, kc in enumerate(kpts): - if c > d: break - #idx2_cd = idx2_tri((c,d)) - for b, kb in enumerate(kpts): - if b > d: break - a = kconserv[b,c,d] - if a > d: continue - #if idx2_tri((a,b)) > idx2_cd: continue - #if ((c==d) and (a>b)): continue - ka = kpts[a] + for d, kd in enumerate(kpts): + for c, kc in enumerate(kpts): + if c > d: break + #idx2_cd = idx2_tri((c,d)) + for b, kb in enumerate(kpts): + if b > d: break + a = kconserv[b,c,d] + if a > d: continue + #if idx2_tri((a,b)) > idx2_cd: continue + #if ((c==d) and (a>b)): continue + ka = kpts[a] - with open(outfilename,'a') as outfile: - eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) + eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd], + compact=False).reshape((nao,)*4) eri_4d_ao_kpt *= 1./Nk for l in range(nao): ll=l+d*nao @@ -523,7 +505,8 @@ def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E if ((jj==ll) and (ii>kk)): break v=eri_4d_ao_kpt[i,k,j,l] if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1,v.real,v.imag)+'\n') + outfile.write(stri4z(ii+1,jj+1,kk+1,ll+1, + v.real,v.imag)+'\n') @@ -640,7 +623,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for j in range(nmo): cij = c_kpts[ik,i,j] if abs(cij) > mo_coef_threshold: - outfile.write('%s %s %s %s\n' % (i+shift1, j+shift2, cij.real, cij.imag)) + outfile.write(stri2z(i+shift1, j+shift2, cij.real, cij.imag)+'\n') # ___ # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ @@ -679,7 +662,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for j in range(i,nao): int_ij = intval_kpts_ao[ik,i,j] if abs(int_ij) > thresh: - outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') if print_mo_ints_mono: intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) with open('%s_mo.qp' % name,'w') as outfile: @@ -689,7 +672,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for j in range(i,nmo): int_ij = intval_kpts_mo[ik,i,j] if abs(int_ij) > thresh: - outfile.write('%s %s %s %s\n' % (i+shift, j+shift, int_ij.real, int_ij.imag)) + outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') # ___ _ @@ -749,7 +732,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') df_ao_tmp[i,j,iaux,k]=v qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) @@ -771,92 +754,15 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, for i,i0 in enumerate(dfbasfunc): for j,v in enumerate(i0): if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (i+1,j+1,iaux+1,k+1,v.real,v.imag)) + outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') df_mo_tmp[i,j,iaux,k]=v qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) - - -# eri_4d_ao = np.zeros((Nk,nao,Nk,nao,Nk,nao,Nk,nao), dtype=np.complex) -# for d, kd in enumerate(kpts): -# for c, kc in enumerate(kpts): -# if c > d: break -# idx2_cd = idx2_tri(c,d) -# for b, kb in enumerate(kpts): -# if b > d: break -# a = kconserv[b,c,d] -# if idx2_tri(a,b) > idx2_cd: continue -# if ((c==d) and (a>b)): continue -# ka = kpts[a] -# v = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) -# v *= 1./Nk -# eri_4d_ao[a,:,b,:,c,:,d] = v -# -# eri_4d_ao = eri_4d_ao.reshape([Nk*nao]*4) - - - if (print_ao_ints_bi or print_mo_ints_bi): - if print_ao_ints_bi: - with open('W.qp','w') as outfile: - pass - if print_mo_ints_bi: - with open('W_mo.qp','w') as outfile: - pass - for d, kd in enumerate(kpts): - for c, kc in enumerate(kpts): - if c > d: break - idx2_cd = idx2_tri((c,d)) - for b, kb in enumerate(kpts): - if b > d: break - a = kconserv[b,c,d] - #if idx2_tri((a,b)) > idx2_cd: continue - if a > d: continue - #if ((c==d) and (a>b)): continue - ka = kpts[a] - - if print_ao_ints_bi: - with open('W.qp','a') as outfile: - eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) - eri_4d_ao_kpt *= 1./Nk - for l in range(nao): - ll=l+d*nao - for j in range(nao): - jj=j+c*nao - if jj>ll: break - idx2_jjll = idx2_tri((jj,ll)) - for k in range(nao): - kk=k+b*nao - if kk>ll: break - for i in range(nao): - ii=i+a*nao - if idx2_tri((ii,kk)) > idx2_jjll: break - if ((jj==ll) and (ii>kk)): break - v=eri_4d_ao_kpt[i,k,j,l] - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) - - if print_mo_ints_bi: - with open('W_mo.qp','a') as outfile: - eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], - [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) - eri_4d_mo_kpt *= 1./Nk - for l in range(nmo): - ll=l+d*nmo - for j in range(nmo): - jj=j+c*nmo - if jj>ll: break - idx2_jjll = idx2_tri((jj,ll)) - for k in range(nmo): - kk=k+b*nmo - if kk>ll: break - for i in range(nmo): - ii=i+a*nmo - if idx2_tri((ii,kk)) > idx2_jjll: break - if ((jj==ll) and (ii>kk)): break - v=eri_4d_mo_kpt[i,k,j,l] - if (abs(v) > bielec_int_threshold): - outfile.write('%s %s %s %s %s %s\n' % (ii+1,jj+1,kk+1,ll+1,v.real,v.imag)) + if (print_ao_ints_bi): + print_ao_bi(mf,kconserv,'W.qp',bielec_int_threshold) + if (print_mo_ints_bi): + print_mo_bi(mf,kconserv,'W.mo.qp',cas_idx,bielec_int_threshold) diff --git a/src/utils_complex/NEED b/src/utils_complex/NEED index 173c6966..7b1c3363 100644 --- a/src/utils_complex/NEED +++ b/src/utils_complex/NEED @@ -1,2 +1,3 @@ ao_two_e_ints ao_one_e_ints +mo_two_e_ints diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 31107376..9780b6e4 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -21,9 +21,6 @@ ezfio.set_nuclei_kpt_num(kpt_num) kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) -# should this be in ao_basis? ao_two_e_ints? -df_num = qph5['ao_two_e_ints'].attrs['df_num'] -ezfio.set_ao_two_e_ints_df_num(df_num) # these are totals (kpt_num * num_per_kpt) # need to change if we want to truncate orbital space within pyscf @@ -139,13 +136,24 @@ ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') -dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) -dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) -#ezfio.set_ao_two_e_ints_df_ao_integrals_real(dfao_re.tolist()) -#ezfio.set_ao_two_e_ints_df_ao_integrals_imag(dfao_im.tolist()) -dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() -ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) -ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') +# should this be in ao_basis? ao_two_e_ints? +if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals_real' in qph5['ao_two_e_ints'].keys(): + dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) + dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) + dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') + +if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) + dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) + dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') #TODO: add check and only do this if ints exist From a81152ad7f6d5e71868e8721599f156e3b4c610b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 12:13:24 -0600 Subject: [PATCH 082/256] fixed ao to mo 3idx transformation --- src/mo_basis/EZFIO.cfg | 1 + src/mo_two_e_ints/df_mo_ints.irp.f | 4 ++-- src/mo_two_e_ints/mo_bi_integrals.irp.f | 2 +- src/utils_complex/create_ezfio_complex_3idx.py | 1 + 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index fd9303aa..ee915b1c 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -40,5 +40,6 @@ interface: ezfio [mo_num_per_kpt] type: integer doc: Number of |MOs| per kpt +default: =(mo_basis.mo_num/nuclei.kpt_num) interface: ezfio diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 7a0ab82a..dbb10782 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -265,13 +265,13 @@ subroutine df_mo_from_df_ao(df_mo,df_ao,n_mo,n_ao,n_df,n_k_pairs) do mu=1, df_num ints_jl = df_ao(:,:,mu,kjkl2) call zgemm('C','N',n_mo,n_ao,n_ao, & - (1.d0,0.d0), coef_j, n_ao, & + (1.d0,0.d0), coef_l, n_ao, & ints_jl, n_ao, & (0.d0,0.d0), ints_tmp, n_mo) call zgemm('N','N',n_mo,n_mo,n_ao, & (1.d0,0.d0), ints_tmp, n_mo, & - coef_l, n_ao, & + coef_j, n_ao, & (0.d0,0.d0), df_mo(:,:,mu,kjkl2), n_mo) enddo enddo diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index 08fb82ba..aeef6ff6 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -41,7 +41,7 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) print*, 'MO integrals provided (periodic)' return - else if (read_df_mo_integrals) then + else if (read_df_mo_integrals.or.read_df_ao_integrals) then PROVIDE df_mo_integrals_complex call mo_map_fill_from_df return diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 9780b6e4..a1a2cca9 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -149,6 +149,7 @@ if 'ao_two_e_ints' in qph5.keys(): if 'mo_two_e_ints' in qph5.keys(): df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() From 83d8ba91a8f4c811f1fc2ae29eb44b704545f604 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 12:14:16 -0600 Subject: [PATCH 083/256] debug printing --- src/utils_complex/dump_df_mo.irp.f | 26 +++++++++++++++++ src/utils_complex/dump_mo_2e_complex.irp.f | 33 ++++++++++++++++++++++ src/utils_complex/dump_mo_coef.irp.f | 22 +++++++++++++++ 3 files changed, 81 insertions(+) create mode 100644 src/utils_complex/dump_df_mo.irp.f create mode 100644 src/utils_complex/dump_mo_2e_complex.irp.f create mode 100644 src/utils_complex/dump_mo_coef.irp.f diff --git a/src/utils_complex/dump_df_mo.irp.f b/src/utils_complex/dump_df_mo.irp.f new file mode 100644 index 00000000..cd97d6bb --- /dev/null +++ b/src/utils_complex/dump_df_mo.irp.f @@ -0,0 +1,26 @@ +program dump_df_mo + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,mu + complex*16 :: integral + + provide df_mo_integrals_complex + do k=1,kpt_pair_num + do mu=1,df_num + do i=1,mo_num_per_kpt + do j=1,mo_num_per_kpt + integral = df_mo_integrals_complex(i,j,mu,k) + if (cdabs(integral).gt.1.d-12) then + print'(4(I4),4(E15.7))',i,j,mu,k,integral,dble(integral),dimag(integral) + endif + enddo + enddo + enddo + enddo + +end diff --git a/src/utils_complex/dump_mo_2e_complex.irp.f b/src/utils_complex/dump_mo_2e_complex.irp.f new file mode 100644 index 00000000..80dba969 --- /dev/null +++ b/src/utils_complex/dump_mo_2e_complex.irp.f @@ -0,0 +1,33 @@ +program print_mo_2e_integrals + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,l + + provide mo_two_e_integrals_in_map + complex*16 :: get_two_e_integral_complex, tmp_cmplx + do i=1,mo_num + do j=1,mo_num + do k=1,mo_num + do l=1,mo_num + tmp_cmplx = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + print'(4(I4),2(E23.15))',i,j,k,l,tmp_cmplx + enddo + enddo + enddo + enddo +! print*,'map1' +! do i=0,mo_integrals_map%map_size +! print*,i,mo_integrals_map%map(i)%value(:) +! print*,i,mo_integrals_map%map(i)%key(:) +! enddo +! print*,'map2' +! do i=0,mo_integrals_map_2%map_size +! print*,i,mo_integrals_map_2%map(i)%value(:) +! print*,i,mo_integrals_map_2%map(i)%key(:) +! enddo +end diff --git a/src/utils_complex/dump_mo_coef.irp.f b/src/utils_complex/dump_mo_coef.irp.f new file mode 100644 index 00000000..c024e07c --- /dev/null +++ b/src/utils_complex/dump_mo_coef.irp.f @@ -0,0 +1,22 @@ +program print_mo_coef + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,l + + provide mo_coef_complex + complex*16 :: tmp_cmplx +! complex*16 :: get_two_e_integral_complex, tmp_cmplx + do i=1,ao_num + do j=1,mo_num + tmp_cmplx = mo_coef_complex(i,j) + if (cdabs(tmp_cmplx).gt.1.d-10) then + print'(2(I4),2(E23.15))',i,j,tmp_cmplx + endif + enddo + enddo +end From 9843df68c4a930196132b5a41cf4e7261edd5eb1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 12:37:37 -0600 Subject: [PATCH 084/256] notes --- src/utils_complex/qp2-pbc-diff.txt | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 0b3378c3..c0980e13 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -4,20 +4,13 @@ mo energies from pyscf include ewald correction; in qp we just fold that into the nuclear repulsion this may need to change for addition/removal of electrons (shift in enuc depends on number of electrons) -mo_coef is not used in the periodic part of the code - use mo_coef_{real,imag,complex} - real and imag only used for I/O - mo_save routines handle this correctly (put real,imag parts of mo_coef_complex into two dble buffers; use ezfio_set to save real,imag parts to disk) -AO 1e ints: - reuse old (real) provider as real part of ints - added new provider (double precision) for imag parts (mostly just for I/O?) - added new provider (complex) for real+i*imag -MO 1e ints: - don't reuse old (real) provider for real part of ints - three linked providers (real,imag,complex) for each array of MO 1e ints - either read from disk or obtain via AO-to-MO transformation +for complex data, add extra dim (size 2) and treat as real in EZFIO.cfg + +no reuse of old provider for real part of complex arrays + +mo_coef_complex_kpts has nonzero blocks of mo_coef_complex AO 2e ints: see doc for map index details @@ -26,6 +19,8 @@ AO 2e ints: MO 2e ints: similar to AO 2e ints maybe good idea to make map_get for two neighboring vals? (re/im parts) + only built from 3idx (not from 4idx transform) + mapping: changed so that all real ints (Jij, Kij, Jii) are in map2 @@ -44,6 +39,9 @@ symmetry restructure arrays? mo coef and mo 1e ints already separate from real part of code (easy to add extra dimension) ao 1e ints could also be handled in same way as mo 1e ints + change to allow different numbers of frozen/virtual mos for different kpts + for now, all kpts must have same number of aos/mos + bitmasks for kpts? ao_one_e_ints ao_overlap_abs for complex? vs abs() @@ -79,6 +77,7 @@ NOTES: if i>k, take conjugate transpose in first two dimensions df_mo(:,:,mu,kjkl) = C(:,:,kj)^\dagger.df_ao(:,:,mu,kjkl).C(:,:,kl) + (note: might need to switch j/l depending on how we decide to store this) 2e int compound indexing number of unique 4-tuples with 8-fold symmetry is a8(n)=n*(n+1)*(n^2+n+2)/8 From ce87a620868e43c1742b6c385705753db86ffd4f Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 12:47:22 -0600 Subject: [PATCH 085/256] starting complex determinants --- src/determinants/create_excitations.irp.f | 27 ++++++++++++++++++++ src/utils_complex/qp2-pbc-diff.txt | 30 +++++++++++++++++++---- 2 files changed, 52 insertions(+), 5 deletions(-) diff --git a/src/determinants/create_excitations.irp.f b/src/determinants/create_excitations.irp.f index cec87901..f3b19afa 100644 --- a/src/determinants/create_excitations.irp.f +++ b/src/determinants/create_excitations.irp.f @@ -80,6 +80,33 @@ subroutine build_singly_excited_wavefunction(i_hole,i_particle,ispin,det_out,coe enddo end +subroutine build_singly_excited_wavefunction_complex(i_hole,i_particle,ispin,det_out,coef_out) + implicit none + BEGIN_DOC + ! Applies the single excitation operator : a^{dager}_(i_particle) a_(i_hole) of + ! spin = ispin to the current wave function (psi_det, psi_coef) + END_DOC + integer, intent(in) :: i_hole,i_particle,ispin + integer(bit_kind), intent(out) :: det_out(N_int,2,N_det) + complex*16, intent(out) :: coef_out(N_det,N_states) + + integer :: k + integer :: i_ok + double precision :: phase + do k=1,N_det + coef_out(k,:) = psi_coef(k,:) + det_out(:,:,k) = psi_det(:,:,k) + call do_single_excitation(det_out(1,1,k),i_hole,i_particle,ispin,i_ok) + if (i_ok == 1) then + call get_phase(psi_det(1,1,k), det_out(1,1,k),phase,N_int) + coef_out(k,:) = phase * coef_out(k,:) + else + coef_out(k,:) = (0.d0,0.d0) + det_out(:,:,k) = psi_det(:,:,k) + endif + enddo +end + logical function is_spin_flip_possible(key_in,i_flip,ispin) implicit none BEGIN_DOC diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index c0980e13..4e2cd568 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,10 +1,22 @@ +------------------------------------------------------------------------------------- +current: + +determinants: + TODO + create_excitations + do_single_excitation + use symmetry rules to simplify? + should this be general, or should we only allow singles that conserve momentum? + density_matrix + ... + + DONE + create_excitations + build_singly_excited_wavefunction{_complex} + -2e integrals printed from pyscf are in physicists' notation -mo energies from pyscf include ewald correction; in qp we just fold that into the nuclear repulsion -this may need to change for addition/removal of electrons (shift in enuc depends on number of electrons) - - +------------------------------------------------------------------------------------- for complex data, add extra dim (size 2) and treat as real in EZFIO.cfg @@ -34,6 +46,8 @@ translational symmetry: I + J = K + L kconserv(I,J,K)=L +------------------------------------------------------------------------------ + TODO: symmetry restructure arrays? @@ -71,6 +85,12 @@ later: NOTES: + 2e integrals printed from pyscf are in physicists' notation + + mo energies from pyscf include ewald correction; in qp we just fold that into the nuclear repulsion + this may need to change for addition/removal of electrons + (shift in enuc depends on number of electrons) + 3-index integrals = \sum_\mu (ik|\mu)(jl|\mu) store (ik|\mu) for I<=K From 31e04c2ab6111bd13c0c6684920210cd128f01ee Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 14:30:39 -0600 Subject: [PATCH 086/256] complex determinants --- src/determinants/EZFIO.cfg | 12 + src/determinants/determinants.irp.f | 38 +- src/determinants/determinants_complex.irp.f | 367 ++++++++++++++++++++ src/utils/sort.irp.f | 1 + src/utils/util.irp.f | 65 ++++ src/utils_complex/qp2-pbc-diff.txt | 7 +- 6 files changed, 488 insertions(+), 2 deletions(-) create mode 100644 src/determinants/determinants_complex.irp.f diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg index 40897159..0d75e987 100644 --- a/src/determinants/EZFIO.cfg +++ b/src/determinants/EZFIO.cfg @@ -84,6 +84,12 @@ doc: Coefficients of the wave function type: double precision size: (determinants.n_det,determinants.n_states) +[psi_coef_complex] +interface: ezfio +doc: Coefficients of the wave function +type: double precision +size: (2,determinants.n_det,determinants.n_states) + [psi_det] interface: ezfio doc: Determinants of the variational space @@ -96,6 +102,12 @@ doc: Coefficients of the wave function type: double precision size: (determinants.n_det_qp_edit,determinants.n_states) +[psi_coef_complex_qp_edit] +interface: ezfio +doc: Coefficients of the wave function +type: double precision +size: (2,determinants.n_det_qp_edit,determinants.n_states) + [psi_det_qp_edit] interface: ezfio doc: Determinants of the variational space diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index 71ee3d89..deb00e39 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -113,7 +113,12 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ] logical :: exists character*(64) :: label - PROVIDE read_wf N_det mo_label ezfio_filename HF_bitmask mo_coef + PROVIDE read_wf N_det mo_label ezfio_filename HF_bitmask + if (is_complex) then + PROVIDE mo_coef_complex + else + PROVIDE mo_coef + endif psi_det = 0_bit_kind if (mpi_master) then if (read_wf) then @@ -244,12 +249,21 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib, (psi_det_size) ] double precision :: f psi_average_norm_contrib(:) = 0.d0 + if (is_complex) then + do k=1,N_states + do i=1,N_det + psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + & + cdabs(psi_coef_complex(i,k)*psi_coef_complex(i,k))*state_average_weight(k) + enddo + enddo + else do k=1,N_states do i=1,N_det psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + & psi_coef(i,k)*psi_coef(i,k)*state_average_weight(k) enddo enddo + endif f = 1.d0/sum(psi_average_norm_contrib(1:N_det)) do i=1,N_det psi_average_norm_contrib(i) = psi_average_norm_contrib(i)*f @@ -442,10 +456,17 @@ end subroutine save_ref_determinant implicit none use bitmasks + if (is_complex) then + complex*16 :: buffer_c(1,N_states) + buffer_c = (0.d0,0.d0) + buffer_c(1,1) = (1.d0,0.d0) + call save_wavefunction_general_complex(1,N_states,ref_bitmask,1,buffer_c) + else double precision :: buffer(1,N_states) buffer = 0.d0 buffer(1,1) = 1.d0 call save_wavefunction_general(1,N_states,ref_bitmask,1,buffer) + endif end @@ -467,7 +488,12 @@ subroutine save_wavefunction_truncated(thr) endif enddo if (mpi_master) then + if (is_complex) then + call save_wavefunction_general_complex(N_det_save,min(N_states,N_det_save),& + psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + else call save_wavefunction_general(N_det_save,min(N_states,N_det_save),psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + endif endif end @@ -485,7 +511,12 @@ subroutine save_wavefunction return endif if (mpi_master) then + if (is_complex) then + call save_wavefunction_general_complex(N_det,N_states,& + psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + else call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + endif endif end @@ -497,7 +528,12 @@ subroutine save_wavefunction_unsorted ! Save the wave function into the |EZFIO| file END_DOC if (mpi_master) then + if (is_complex) then + call save_wavefunction_general_complex(N_det,min(N_states,N_det),& + psi_det,size(psi_coef_complex,1),psi_coef_complex) + else call save_wavefunction_general(N_det,min(N_states,N_det),psi_det,size(psi_coef,1),psi_coef) + endif endif end diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_complex.irp.f new file mode 100644 index 00000000..692bd253 --- /dev/null +++ b/src/determinants/determinants_complex.irp.f @@ -0,0 +1,367 @@ +use bitmasks + + + + +BEGIN_PROVIDER [ complex*16, psi_coef_complex, (psi_det_size,N_states) ] + 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 + character*(64) :: label + + PROVIDE read_wf N_det mo_label ezfio_filename + psi_coef = (0.d0,0.d0) + do i=1,min(N_states,psi_det_size) + psi_coef(i,i) = (1.d0,0.d0) + enddo + + if (mpi_master) then + if (read_wf) then + call ezfio_has_determinants_psi_coef_complex(exists) + if (exists) then + call ezfio_has_determinants_mo_label(exists) + if (exists) then + call ezfio_get_determinants_mo_label(label) + exists = (label == mo_label) + endif + endif + + if (exists) then + + complex*16, allocatable :: psi_coef_read(:,:) + allocate (psi_coef_read(N_det,N_states)) + print *, 'Read psi_coef_complex', N_det, N_states + call ezfio_get_determinants_psi_coef_complex(psi_coef_read) + do k=1,N_states + do i=1,N_det + psi_coef_complex(i,k) = psi_coef_read(i,k) + enddo + enddo + deallocate(psi_coef_read) + + endif + endif + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( psi_coef_complex, size(psi_coef_complex), MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read psi_coef_complex with MPI' + endif + IRP_ENDIF + + + +END_PROVIDER + +!==============================================================================! +! ! +! Sorting providers ! +! ! +!==============================================================================! + +!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?) + BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] +&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ] +&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ] + implicit none + BEGIN_DOC + ! Wave function sorted by determinants contribution to the norm (state-averaged) + ! + ! psi_det_sorted_order(i) -> k : index in psi_det + END_DOC + integer :: i,j,k + integer, allocatable :: iorder(:) + allocate ( iorder(N_det) ) + do i=1,N_det + psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i) + iorder(i) = i + enddo + call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det) + do i=1,N_det + do j=1,N_int + psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i)) + psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i)) + enddo + do k=1,N_states + psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k) + enddo + psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i) + enddo + do i=1,N_det + psi_det_sorted_order_complex(iorder(i)) = i + enddo + + psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind + psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) + psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0 + psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0 + + deallocate(iorder) + +END_PROVIDER + + BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. + ! They are sorted by determinants interpreted as integers. Useful + ! to accelerate the search of a random determinant in the wave + ! function. + END_DOC + + call sort_dets_by_det_search_key_complex(N_det, psi_det, psi_coef_complex, & + size(psi_coef_complex,1), psi_det_sorted_bit_complex, & + psi_coef_sorted_bit_complex, N_states) + +END_PROVIDER + +subroutine sort_dets_by_det_search_key_complex(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st) + use bitmasks + implicit none + integer, intent(in) :: Ndet, N_st, sze + integer(bit_kind), intent(in) :: det_in (N_int,2,sze) + complex*16 , intent(in) :: coef_in(sze,N_st) + integer(bit_kind), intent(out) :: det_out (N_int,2,sze) + complex*16 , intent(out) :: coef_out(sze,N_st) + BEGIN_DOC + ! Determinants are sorted according to their :c:func:`det_search_key`. + ! Useful to accelerate the search of a random determinant in the wave + ! function. + ! + ! /!\ The first dimension of coef_out and coef_in need to be psi_det_size + ! + END_DOC + integer :: i,j,k + integer, allocatable :: iorder(:) + integer*8, allocatable :: bit_tmp(:) + integer*8, external :: det_search_key + + allocate ( iorder(Ndet), bit_tmp(Ndet) ) + + do i=1,Ndet + iorder(i) = i + !$DIR FORCEINLINE + bit_tmp(i) = det_search_key(det_in(1,1,i),N_int) + enddo + call i8sort(bit_tmp,iorder,Ndet) + !DIR$ IVDEP + do i=1,Ndet + do j=1,N_int + det_out(j,1,i) = det_in(j,1,iorder(i)) + det_out(j,2,i) = det_in(j,2,iorder(i)) + enddo + do k=1,N_st + coef_out(i,k) = coef_in(iorder(i),k) + enddo + enddo + + deallocate(iorder, bit_tmp) + +end + + +! TODO:complex? only keep abs max/min? real max/min? +! BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ] +!&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ] +!&BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ] +!&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ] +! implicit none +! BEGIN_DOC +! ! Max and min values of the coefficients +! END_DOC +! integer :: i +! do i=1,N_states +! psi_coef_min(i) = minval(psi_coef(:,i)) +! psi_coef_max(i) = maxval(psi_coef(:,i)) +! abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) ) +! abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) ) +! call write_double(6,psi_coef_max(i), 'Max coef') +! call write_double(6,psi_coef_min(i), 'Min coef') +! call write_double(6,abs_psi_coef_max(i), 'Max abs coef') +! call write_double(6,abs_psi_coef_min(i), 'Min abs coef') +! enddo +! +!END_PROVIDER + + +!==============================================================================! +! ! +! Read/write routines ! +! ! +!==============================================================================! + + + +subroutine save_wavefunction_general_complex(ndet,nstates,psidet,dim_psicoef,psicoef) + implicit none + BEGIN_DOC + ! Save the wave function into the |EZFIO| file + END_DOC + use bitmasks + include 'constants.include.F' + integer, intent(in) :: ndet,nstates,dim_psicoef + integer(bit_kind), intent(in) :: psidet(N_int,2,ndet) + complex*16, intent(in) :: psicoef(dim_psicoef,nstates) + integer*8, allocatable :: psi_det_save(:,:,:) + complex*16, allocatable :: psi_coef_save(:,:) + + double precision :: accu_norm + integer :: i,j,k, ndet_qp_edit + + if (mpi_master) then + ndet_qp_edit = min(ndet,N_det_qp_edit) + + call ezfio_set_determinants_N_int(N_int) + call ezfio_set_determinants_bit_kind(bit_kind) + call ezfio_set_determinants_N_det(ndet) + call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit) + call ezfio_set_determinants_n_states(nstates) + call ezfio_set_determinants_mo_label(mo_label) + + allocate (psi_det_save(N_int,2,ndet)) + do i=1,ndet + do j=1,2 + do k=1,N_int + psi_det_save(k,j,i) = transfer(psidet(k,j,i),1_8) + enddo + enddo + enddo + call ezfio_set_determinants_psi_det(psi_det_save) + call ezfio_set_determinants_psi_det_qp_edit(psi_det_save) + deallocate (psi_det_save) + + allocate (psi_coef_save(ndet,nstates)) + do k=1,nstates + do i=1,ndet + psi_coef_save(i,k) = psicoef(i,k) + enddo + call normalize_complex(psi_coef_save(1,k),ndet) + enddo + + call ezfio_set_determinants_psi_coef_complex(psi_coef_save) + deallocate (psi_coef_save) + + allocate (psi_coef_save(ndet_qp_edit,nstates)) + do k=1,nstates + do i=1,ndet_qp_edit + psi_coef_save(i,k) = psicoef(i,k) + enddo + call normalize_complex(psi_coef_save(1,k),ndet_qp_edit) + enddo + + call ezfio_set_determinants_psi_coef_complex_qp_edit(psi_coef_save) + deallocate (psi_coef_save) + + call write_int(6,ndet,'Saved determinants') + endif +end + + + +subroutine save_wavefunction_specified_complex(ndet,nstates,psidet,psicoef,ndetsave,index_det_save) + implicit none + BEGIN_DOC + ! Save the wave function into the |EZFIO| file + END_DOC + use bitmasks + integer, intent(in) :: ndet,nstates + integer(bit_kind), intent(in) :: psidet(N_int,2,ndet) + complex*16, intent(in) :: psicoef(ndet,nstates) + integer, intent(in) :: index_det_save(ndet) + integer, intent(in) :: ndetsave + integer*8, allocatable :: psi_det_save(:,:,:) + complex*16, allocatable :: psi_coef_save(:,:) + integer*8 :: det_8(100) + integer(bit_kind) :: det_bk((100*8)/bit_kind) + integer :: N_int2 + equivalence (det_8, det_bk) + + integer :: i,j,k, ndet_qp_edit + + if (mpi_master) then + ndet_qp_edit = min(ndetsave,N_det_qp_edit) + call ezfio_set_determinants_N_int(N_int) + call ezfio_set_determinants_bit_kind(bit_kind) + call ezfio_set_determinants_N_det(ndetsave) + call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit) + call ezfio_set_determinants_n_states(nstates) + call ezfio_set_determinants_mo_label(mo_label) + + N_int2 = (N_int*bit_kind)/8 + allocate (psi_det_save(N_int2,2,ndetsave)) + do i=1,ndetsave + do k=1,N_int + det_bk(k) = psidet(k,1,index_det_save(i)) + enddo + do k=1,N_int2 + psi_det_save(k,1,i) = det_8(k) + enddo + do k=1,N_int + det_bk(k) = psidet(k,2,index_det_save(i)) + enddo + do k=1,N_int2 + psi_det_save(k,2,i) = det_8(k) + enddo + enddo + call ezfio_set_determinants_psi_det(psi_det_save) + call ezfio_set_determinants_psi_det_qp_edit(psi_det_save) + deallocate (psi_det_save) + + allocate (psi_coef_save(ndetsave,nstates)) + double precision :: accu_norm(nstates) + accu_norm = 0.d0 + do k=1,nstates + do i=1,ndetsave + accu_norm(k) = accu_norm(k) + cdabs(psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)) + psi_coef_save(i,k) = psicoef(index_det_save(i),k) + enddo + enddo + do k = 1, nstates + accu_norm(k) = 1.d0/dsqrt(accu_norm(k)) + enddo + do k=1,nstates + do i=1,ndetsave + psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k) + enddo + enddo + + call ezfio_set_determinants_psi_coef_complex(psi_coef_save) + deallocate (psi_coef_save) + + allocate (psi_coef_save(ndet_qp_edit,nstates)) + accu_norm = 0.d0 + do k=1,nstates + do i=1,ndet_qp_edit + accu_norm(k) = accu_norm(k) + cdabs(psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)) + psi_coef_save(i,k) = psicoef(index_det_save(i),k) + enddo + enddo + do k = 1, nstates + accu_norm(k) = 1.d0/dsqrt(accu_norm(k)) + enddo + do k=1,nstates + do i=1,ndet_qp_edit + psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k) + enddo + enddo + !TODO: should this be psi_coef_complex_qp_edit? + call ezfio_set_determinants_psi_coef_complex(psi_coef_save) + deallocate (psi_coef_save) + + call write_int(6,ndet,'Saved determinants') + endif +end + diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index 2a655eed..ce609411 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -346,6 +346,7 @@ SUBST [ X, type ] i ; integer ;; i8; integer*8 ;; i2; integer*2 ;; + cd; complex*16 ;; END_TEMPLATE diff --git a/src/utils/util.irp.f b/src/utils/util.irp.f index 1b01a1ec..95abb9ab 100644 --- a/src/utils/util.irp.f +++ b/src/utils/util.irp.f @@ -317,6 +317,35 @@ double precision function u_dot_v(u,v,sze) end +complex*16 function u_dot_v_complex(u,v,sze) + implicit none + BEGIN_DOC + ! Compute u^H . v + END_DOC + integer, intent(in) :: sze + complex*16, intent(in) :: u(sze),v(sze) + complex*16, external :: zdotc + + !DIR$ FORCEINLINE + u_dot_v_complex = zdotc(sze,u,1,v,1) + +end + +complex*16 function u_dot_v_complex_noconj(u,v,sze) + implicit none + BEGIN_DOC + ! Compute u^T . v (don't take complex conjugate of elements of u) + ! use this if u is already stored as ) + END_DOC + integer, intent(in) :: sze + complex*16, intent(in) :: u(sze),v(sze) + complex*16, external :: zdotu + + !DIR$ FORCEINLINE + u_dot_v_complex_noconj = zdotu(sze,u,1,v,1) + +end + double precision function u_dot_u(u,sze) implicit none BEGIN_DOC @@ -331,6 +360,20 @@ double precision function u_dot_u(u,sze) end +double precision function u_dot_u_complex(u,sze) + implicit none + BEGIN_DOC + ! Compute + END_DOC + integer, intent(in) :: sze + complex*16, intent(in) :: u(sze) + complex*16, external :: zdotc + + !DIR$ FORCEINLINE + u_dot_u_complex = real(zdotc(sze,u,1,u,1)) + +end + subroutine normalize(u,sze) implicit none BEGIN_DOC @@ -353,6 +396,28 @@ subroutine normalize(u,sze) endif end +subroutine normalize_complex(u,sze) + implicit none + BEGIN_DOC + ! Normalizes vector u + END_DOC + integer, intent(in) :: sze + complex*16, intent(inout):: u(sze) + double precision :: d + double precision, external :: dznrm2 + integer :: i + + !DIR$ FORCEINLINE + d = dznrm2(sze,u,1) + if (d /= 0.d0) then + d = 1.d0/d + endif + if (d /= 1.d0) then + !DIR$ FORCEINLINE + call zdscal(sze,d,u,1) + endif +end + double precision function approx_dble(a,n) implicit none integer, intent(in) :: n diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 4e2cd568..ad83db6d 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -9,7 +9,12 @@ determinants: use symmetry rules to simplify? should this be general, or should we only allow singles that conserve momentum? density_matrix - ... + determinants + ezfio_set_determinants_psi_coef_complex_qp_edit? (need ocaml?) + psi_coef_{max,min}? + save_wavefunction_specified{,_complex} qp_edit save? + + diag_h_mat_elem for complex DONE create_excitations From c0ee3714e6051ca259c433e1825bf6c1dfd2fc92 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 14:55:00 -0600 Subject: [PATCH 087/256] complex determinants --- src/determinants/energy.irp.f | 8 ++++ src/determinants/fock_diag.irp.f | 61 ++++++++++++++++++++++++++++++ src/determinants/occ_pattern.irp.f | 18 +++++++++ 3 files changed, 87 insertions(+) diff --git a/src/determinants/energy.irp.f b/src/determinants/energy.irp.f index 63be7971..79e110eb 100644 --- a/src/determinants/energy.irp.f +++ b/src/determinants/energy.irp.f @@ -21,11 +21,19 @@ BEGIN_PROVIDER [ double precision, barycentric_electronic_energy, (N_states) ] barycentric_electronic_energy(:) = 0.d0 + if (is_complex) then + do istate=1,N_states + do i=1,N_det + barycentric_electronic_energy(istate) += cdabs(psi_coef_complex(i,istate)*psi_coef_complex(i,istate))*diagonal_H_matrix_on_psi_det(i) + enddo + enddo + else do istate=1,N_states do i=1,N_det barycentric_electronic_energy(istate) += psi_coef(i,istate)*psi_coef(i,istate)*diagonal_H_matrix_on_psi_det(i) enddo enddo + endif END_PROVIDER diff --git a/src/determinants/fock_diag.irp.f b/src/determinants/fock_diag.irp.f index a8ce33b8..6f2ffb9b 100644 --- a/src/determinants/fock_diag.irp.f +++ b/src/determinants/fock_diag.irp.f @@ -29,7 +29,67 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) call debug_det(det_ref,N_int) stop -1 endif + + if (is_complex) then + ! Occupied MOs + do ii=1,elec_alpha_num + i = occ(ii,1) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) + E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) + do jj=1,elec_alpha_num + j = occ(jj,1) + if (i==j) cycle + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) + E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j) + enddo + do jj=1,elec_beta_num + j = occ(jj,2) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j) + E0 = E0 + mo_two_e_integrals_jj(i,j) + enddo + enddo + do ii=1,elec_beta_num + i = occ(ii,2) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) + E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) + do jj=1,elec_beta_num + j = occ(jj,2) + if (i==j) cycle + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) + E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j) + enddo + do jj=1,elec_alpha_num + j = occ(jj,1) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) + enddo + enddo + ! Virtual MOs + do i=1,mo_num + if (fock_diag_tmp(1,i) /= 0.d0) cycle + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) + do jj=1,elec_alpha_num + j = occ(jj,1) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) + enddo + do jj=1,elec_beta_num + j = occ(jj,2) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j) + enddo + enddo + do i=1,mo_num + if (fock_diag_tmp(2,i) /= 0.d0) cycle + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) + do jj=1,elec_beta_num + j = occ(jj,2) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) + enddo + do jj=1,elec_alpha_num + j = occ(jj,1) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) + enddo + enddo + else ! Occupied MOs do ii=1,elec_alpha_num i = occ(ii,1) @@ -88,6 +148,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) enddo enddo + endif fock_diag_tmp(1,mo_num+1) = E0 fock_diag_tmp(2,mo_num+1) = E0 diff --git a/src/determinants/occ_pattern.irp.f b/src/determinants/occ_pattern.irp.f index 6e6f9c9f..781c7d75 100644 --- a/src/determinants/occ_pattern.irp.f +++ b/src/determinants/occ_pattern.irp.f @@ -401,12 +401,21 @@ BEGIN_PROVIDER [ double precision, weight_occ_pattern, (N_occ_pattern,N_states) END_DOC integer :: i,j,k weight_occ_pattern = 0.d0 + if (is_complex) then + do i=1,N_det + j = det_to_occ_pattern(i) + do k=1,N_states + weight_occ_pattern(j,k) += cdabs(psi_coef_complex(i,k) * psi_coef_complex(i,k)) + enddo + enddo + else do i=1,N_det j = det_to_occ_pattern(i) do k=1,N_states weight_occ_pattern(j,k) += psi_coef(i,k) * psi_coef(i,k) enddo enddo + endif END_PROVIDER BEGIN_PROVIDER [ double precision, weight_occ_pattern_average, (N_occ_pattern) ] @@ -416,12 +425,21 @@ BEGIN_PROVIDER [ double precision, weight_occ_pattern_average, (N_occ_pattern) ] END_DOC integer :: i,j,k weight_occ_pattern_average(:) = 0.d0 + if (is_complex) then + do i=1,N_det + j = det_to_occ_pattern(i) + do k=1,N_states + weight_occ_pattern_average(j) += cdabs(psi_coef_complex(i,k) * psi_coef_complex(i,k)) * state_average_weight(k) + enddo + enddo + else do i=1,N_det j = det_to_occ_pattern(i) do k=1,N_states weight_occ_pattern_average(j) += psi_coef(i,k) * psi_coef(i,k) * state_average_weight(k) enddo enddo + endif END_PROVIDER BEGIN_PROVIDER [ double precision, psi_occ_pattern_sorted, (N_int,2,N_occ_pattern) ] From 5c66e4b99f5d6ba7b0e46fdc506949d24e305c5f Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 19 Feb 2020 17:59:27 -0600 Subject: [PATCH 088/256] complex determinants --- src/determinants/occ_pattern.irp.f | 4 + src/determinants/prune_wf.irp.f | 4 + src/determinants/psi_cas.irp.f | 16 ++- src/determinants/psi_cas_complex.irp.f | 145 +++++++++++++++++++++++++ src/utils_complex/qp2-pbc-diff.txt | 4 +- 5 files changed, 171 insertions(+), 2 deletions(-) create mode 100644 src/determinants/psi_cas_complex.irp.f diff --git a/src/determinants/occ_pattern.irp.f b/src/determinants/occ_pattern.irp.f index 781c7d75..9e0ccd33 100644 --- a/src/determinants/occ_pattern.irp.f +++ b/src/determinants/occ_pattern.irp.f @@ -529,7 +529,11 @@ subroutine make_s2_eigenfunction if (update) then call copy_H_apply_buffer_to_wf + if (is_complex) then + TOUCH N_det psi_coef_complex psi_det psi_occ_pattern N_occ_pattern + else TOUCH N_det psi_coef psi_det psi_occ_pattern N_occ_pattern + endif endif call write_time(6) diff --git a/src/determinants/prune_wf.irp.f b/src/determinants/prune_wf.irp.f index c3cd8d12..136d4ec1 100644 --- a/src/determinants/prune_wf.irp.f +++ b/src/determinants/prune_wf.irp.f @@ -25,7 +25,11 @@ BEGIN_PROVIDER [ logical, pruned, (N_det) ] else ndet_new = max(1,int( dble(N_det) * (1.d0 - pruning) + 0.5d0 )) + if (is_complex) then + thr = psi_average_norm_contrib_sorted_complex(ndet_new) + else thr = psi_average_norm_contrib_sorted(ndet_new) + endif do i=1, N_det pruned(i) = psi_average_norm_contrib(i) < thr enddo diff --git a/src/determinants/psi_cas.irp.f b/src/determinants/psi_cas.irp.f index 19a1c260..d262622c 100644 --- a/src/determinants/psi_cas.irp.f +++ b/src/determinants/psi_cas.irp.f @@ -150,7 +150,20 @@ END_PROVIDER double precision :: hij,norm,u_dot_v psi_cas_energy = 0.d0 - + if (is_complex) then + complex*16 :: hij_c + do k = 1, N_states + norm = 0.d0 + do i = 1, N_det_cas_complex + norm += cdabs(psi_cas_coef_complex(i,k) * psi_cas_coef_complex(i,k)) + do j = 1, N_det_cas_complex + !TODO: accum imag parts to ensure that sum is zero? + psi_cas_energy(k) += dble(dconjg(psi_cas_coef_complex(i,k)) * psi_cas_coef_complex(j,k) * H_matrix_cas_complex(i,j)) + enddo + enddo + psi_cas_energy(k) = psi_cas_energy(k) /norm + enddo + else do k = 1, N_states norm = 0.d0 do i = 1, N_det_cas @@ -161,6 +174,7 @@ END_PROVIDER enddo psi_cas_energy(k) = psi_cas_energy(k) /norm enddo + endif END_PROVIDER diff --git a/src/determinants/psi_cas_complex.irp.f b/src/determinants/psi_cas_complex.irp.f new file mode 100644 index 00000000..9e8ded87 --- /dev/null +++ b/src/determinants/psi_cas_complex.irp.f @@ -0,0 +1,145 @@ +use bitmasks + + BEGIN_PROVIDER [ integer(bit_kind), psi_cas_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_cas_coef_complex, (psi_det_size,n_states) ] +&BEGIN_PROVIDER [ integer, idx_cas_complex, (psi_det_size) ] +&BEGIN_PROVIDER [ integer, N_det_cas_complex ] + implicit none + BEGIN_DOC + ! |CAS| wave function, defined from the application of the |CAS| bitmask on the + ! determinants. idx_cas gives the indice of the |CAS| determinant in psi_det. + END_DOC + integer :: i, k, l + logical :: good + n_det_cas_complex = 0 + do i=1,N_det + do l = 1, N_states + psi_cas_coef_complex(i,l) = (0.d0,0.d0) + enddo + good = .True. + do k=1,N_int + good = good .and. ( & + iand(not(act_bitmask(k,1)), psi_det(k,1,i)) == & + iand(not(act_bitmask(k,1)), hf_bitmask(k,1)) ) .and. ( & + iand(not(act_bitmask(k,2)), psi_det(k,2,i)) == & + iand(not(act_bitmask(k,2)), hf_bitmask(k,2)) ) + enddo + if (good) then + exit + endif + if (good) then + n_det_cas_complex = n_det_cas_complex+1 + do k=1,N_int + psi_cas_complex(k,1,n_det_cas_complex) = psi_det(k,1,i) + psi_cas_complex(k,2,n_det_cas_complex) = psi_det(k,2,i) + enddo + idx_cas(n_det_cas_complex) = i + do k=1,N_states + psi_cas_coef_complex(n_det_cas_complex,k) = psi_coef_complex(i,k) + enddo + endif + enddo + call write_int(6,n_det_cas_complex, 'Number of determinants in the CAS') + +END_PROVIDER + + + BEGIN_PROVIDER [ integer(bit_kind), psi_cas_sorted_bit_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_cas_coef_sorted_bit_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! |CAS| determinants sorted to accelerate the search of a random determinant in the wave + ! function. + END_DOC + call sort_dets_by_det_search_key_complex(n_det_cas_complex, psi_cas_complex, psi_cas_coef_complex, size(psi_cas_coef_complex,1), & + psi_cas_sorted_bit_complex, psi_cas_coef_sorted_bit_complex, N_states) + +END_PROVIDER + + + + BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef,_complex (psi_det_size,n_states) ] +&BEGIN_PROVIDER [ integer, idx_non_cas_complex, (psi_det_size) ] +&BEGIN_PROVIDER [ integer, N_det_non_cas_complex ] + implicit none + BEGIN_DOC + ! Set of determinants which are not part of the |CAS|, defined from the application + ! of the |CAS| bitmask on the determinants. + ! idx_non_cas gives the indice of the determinant in psi_det. + END_DOC + integer :: i_non_cas,j,k + integer :: degree + logical :: in_cas + i_non_cas =0 + do k=1,N_det + in_cas = .False. + do j=1,N_det_cas_complex + call get_excitation_degree(psi_cas_complex(1,1,j), psi_det(1,1,k), degree, N_int) + if (degree == 0) then + in_cas = .True. + exit + endif + enddo + if (.not.in_cas) then + double precision :: hij + i_non_cas += 1 + do j=1,N_int + psi_non_cas_complex(j,1,i_non_cas) = psi_det(j,1,k) + psi_non_cas_complex(j,2,i_non_cas) = psi_det(j,2,k) + enddo + do j=1,N_states + psi_non_cas_coef_complex(i_non_cas,j) = psi_coef_complex(k,j) + enddo + idx_non_cas_complex(i_non_cas) = k + endif + enddo + N_det_non_cas_complex = i_non_cas +END_PROVIDER + + BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_sorted_bit_complex, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef_sorted_bit_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! |CAS| determinants sorted to accelerate the search of a random determinant in the wave + ! function. + END_DOC + !TODO: should this be n_det_non_cas_complex? + call sort_dets_by_det_search_key_complex(N_det_cas_complex, psi_non_cas_complex, psi_non_cas_coef_complex, size(psi_non_cas_coef_complex,1), & + psi_non_cas_sorted_bit_complex, psi_non_cas_coef_sorted_bit_complex, N_states) + +END_PROVIDER + + +BEGIN_PROVIDER [complex*16, H_matrix_cas_complex, (N_det_cas_complex,N_det_cas_complex)] + implicit none + integer :: i,j + complex*16 :: hij + do i = 1, N_det_cas_complex + do j = 1, N_det_cas_complex + call i_h_j_complex(psi_cas_complex(1,1,i),psi_cas_complex(1,1,j),N_int,hij) + H_matrix_cas_complex(i,j) = hij + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [complex*16, psi_coef_cas_diagonalized_complex, (N_det_cas_complex,N_states)] +&BEGIN_PROVIDER [double precision, psi_cas_energy_diagonalized_complex, (N_states)] + implicit none + integer :: i,j + double precision, allocatable :: eigenvalues(:) + complex*16, allocatable :: eigenvectors(:,:) + allocate (eigenvectors(size(H_matrix_cas,1),N_det_cas)) + allocate (eigenvalues(N_det_cas)) + call lapack_diag_complex(eigenvalues,eigenvectors, & + H_matrix_cas_complex,size(H_matrix_cas_complex,1),N_det_cas_complex) + do i = 1, N_states + psi_cas_energy_diagonalized_complex(i) = eigenvalues(i) + do j = 1, N_det_cas_complex + psi_coef_cas_diagonalized_complex(j,i) = eigenvectors(j,i) + enddo + enddo + + + END_PROVIDER + diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index ad83db6d..06d74811 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -13,12 +13,14 @@ determinants: ezfio_set_determinants_psi_coef_complex_qp_edit? (need ocaml?) psi_coef_{max,min}? save_wavefunction_specified{,_complex} qp_edit save? - + psi_energy_mono_elec diag_h_mat_elem for complex + ... DONE create_excitations build_singly_excited_wavefunction{_complex} + ... ------------------------------------------------------------------------------------- From 1c838a30d6fcd36d3778f9f3ec7871b29e245965 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 20 Feb 2020 14:56:47 -0600 Subject: [PATCH 089/256] working on complex determinants --- src/determinants/psi_energy_mono_elec.irp.f | 21 +- src/determinants/s2.irp.f | 4 + src/determinants/s2_complex.irp.f | 290 ++++++++++++++++++++ src/determinants/utils.irp.f | 22 ++ src/utils_complex/qp2-pbc-diff.txt | 68 +++-- 5 files changed, 386 insertions(+), 19 deletions(-) create mode 100644 src/determinants/s2_complex.irp.f diff --git a/src/determinants/psi_energy_mono_elec.irp.f b/src/determinants/psi_energy_mono_elec.irp.f index 74e69160..1f6d69d5 100644 --- a/src/determinants/psi_energy_mono_elec.irp.f +++ b/src/determinants/psi_energy_mono_elec.irp.f @@ -9,7 +9,26 @@ ! computed using the :c:data:`one_e_dm_mo_alpha` + ! :c:data:`one_e_dm_mo_beta` and :c:data:`mo_one_e_integrals` END_DOC + double precision :: accu psi_energy_h_core = 0.d0 + if (is_complex) then + do i = 1, N_states + do j = 1, mo_num + do k = 1, mo_num + psi_energy_h_core(i) += dble(mo_one_e_integrals_complex(k,j) * & + (one_e_dm_mo_alpha_complex(j,k,i) + one_e_dm_mo_beta_complex(j,k,i))) + enddo + enddo + enddo + do i = 1, N_states + accu = 0.d0 + do j = 1, mo_num + accu += dble(one_e_dm_mo_alpha_complex(j,j,i) + one_e_dm_mo_beta_complex(j,j,i)) + enddo + accu = (elec_alpha_num + elec_beta_num ) / accu + psi_energy_h_core(i) = psi_energy_h_core(i) * accu + enddo + else do i = 1, N_states do j = 1, mo_num do k = 1, mo_num @@ -17,7 +36,6 @@ enddo enddo enddo - double precision :: accu do i = 1, N_states accu = 0.d0 do j = 1, mo_num @@ -26,4 +44,5 @@ accu = (elec_alpha_num + elec_beta_num ) / accu psi_energy_h_core(i) = psi_energy_h_core(i) * accu enddo + endif END_PROVIDER diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f index 391d0073..6f9560ca 100644 --- a/src/determinants/s2.irp.f +++ b/src/determinants/s2.irp.f @@ -98,7 +98,11 @@ BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] ! array of the averaged values of the S^2 operator on the various states END_DOC integer :: i + if (is_complex) then + call u_0_S2_u_0_complex(s2_values,psi_coef_complex,n_det,psi_det,N_int,N_states,psi_det_size) + else call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size) + endif END_PROVIDER diff --git a/src/determinants/s2_complex.irp.f b/src/determinants/s2_complex.irp.f new file mode 100644 index 00000000..bb368f55 --- /dev/null +++ b/src/determinants/s2_complex.irp.f @@ -0,0 +1,290 @@ +subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) + print*,irp_here,' not implemented for complex' + stop -1 +! use bitmasks +! implicit none +! BEGIN_DOC +! ! Computes e_0 = / +! ! +! ! n : number of determinants +! ! +! END_DOC +! integer, intent(in) :: n,Nint, N_st, sze_8 +! double precision, intent(out) :: e_0(N_st) +! double precision, intent(in) :: u_0(sze_8,N_st) +! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) +! +! double precision, allocatable :: v_0(:,:) +! double precision :: u_dot_u,u_dot_v +! integer :: i,j +! allocate (v_0(sze_8,N_st)) +! +! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) +! do i=1,N_st +! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) + S_z2_Sz +! enddo +end + + + +subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint) + print*,irp_here,' not implemented for complex' + stop -1 +! use bitmasks +! implicit none +! BEGIN_DOC +! ! Computes v_0 = S^2|u_0> +! ! +! ! n : number of determinants +! ! +! END_DOC +! integer, intent(in) :: n,Nint +! double precision, intent(out) :: v_0(n) +! double precision, intent(in) :: u_0(n) +! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) +! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,1,n) +end + +subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) + print*,irp_here,' not implemented for complex' + stop -1 +! use bitmasks +! implicit none +! BEGIN_DOC +! ! Computes v_0 = S^2|u_0> +! ! +! ! n : number of determinants +! ! +! END_DOC +! integer, intent(in) :: N_st,n,Nint, sze_8 +! double precision, intent(out) :: v_0(sze_8,N_st) +! double precision, intent(in) :: u_0(sze_8,N_st) +! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) +! double precision :: s2_tmp +! double precision, allocatable :: vt(:,:) +! integer :: i,j,k,l, jj,ii +! integer :: i0, j0 +! +! integer, allocatable :: shortcut(:,:), sort_idx(:,:) +! integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) +! integer(bit_kind) :: sorted_i(Nint) +! +! integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate +! +! +! ASSERT (Nint > 0) +! ASSERT (Nint == N_int) +! ASSERT (n>0) +! PROVIDE ref_bitmask_energy +! +! allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) +! v_0 = 0.d0 +! +! call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) +! call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) +! +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& +! !$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8) +! allocate(vt(sze_8,N_st)) +! vt = 0.d0 +! +! do sh=1,shortcut(0,1) +! !$OMP DO SCHEDULE(static,1) +! do sh2=sh,shortcut(0,1) +! exa = 0 +! do ni=1,Nint +! exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) +! end do +! if(exa > 2) then +! cycle +! end if +! +! do i=shortcut(sh,1),shortcut(sh+1,1)-1 +! org_i = sort_idx(i,1) +! if(sh==sh2) then +! endi = i-1 +! else +! endi = shortcut(sh2+1,1)-1 +! end if +! do ni=1,Nint +! sorted_i(ni) = sorted(ni,i,1) +! enddo +! +! do j=shortcut(sh2,1),endi +! org_j = sort_idx(j,1) +! ext = exa +! do ni=1,Nint +! ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) +! end do +! if(ext <= 4) then +! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) +! do istate=1,N_st +! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) +! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) +! enddo +! endif +! enddo +! enddo +! enddo +! !$OMP END DO NOWAIT +! enddo +! +! do sh=1,shortcut(0,2) +! !$OMP DO +! do i=shortcut(sh,2),shortcut(sh+1,2)-1 +! org_i = sort_idx(i,2) +! do j=shortcut(sh,2),i-1 +! org_j = sort_idx(j,2) +! ext = 0 +! do ni=1,Nint +! ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) +! end do +! if(ext == 4) then +! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) +! do istate=1,N_st +! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) +! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) +! enddo +! end if +! end do +! end do +! !$OMP END DO NOWAIT +! enddo +! !$OMP BARRIER +! +! do istate=1,N_st +! do i=n,1,-1 +! !$OMP ATOMIC +! v_0(i,istate) = v_0(i,istate) + vt(i,istate) +! enddo +! enddo +! +! deallocate(vt) +! !$OMP END PARALLEL +! +! do i=1,n +! call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp) +! do istate=1,N_st +! v_0(i,istate) += s2_tmp * u_0(i,istate) +! enddo +! enddo +! +! deallocate (shortcut, sort_idx, sorted, version) +end + + + + + + + +subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_keys,s2,nstates) + print*,irp_here,' not implemented for complex' + stop -1 +! implicit none +! use bitmasks +! integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates +! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys) +! double precision, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates) +! double precision, intent(out) :: s2(nstates,nstates) +! double precision :: s2_tmp,accu +! integer :: i,j,l,jj,ll,kk +! integer, allocatable :: idx(:) +! BEGIN_DOC +! ! returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states +! ! psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j) +! END_DOC +! s2 = 0.d0 +! do ll = 1, nstates +! do jj = 1, nstates +! accu = 0.d0 +! !$OMP PARALLEL DEFAULT(NONE) & +! !$OMP PRIVATE (i,j,kk,idx,s2_tmp) & +! !$OMP SHARED (ll,jj,psi_keys_tmp,psi_coefs_tmp,N_int,n,nstates)& +! !$OMP REDUCTION(+:accu) +! allocate(idx(0:n)) +! !$OMP DO SCHEDULE(dynamic) +! do i = n,1,-1 ! Better OMP scheduling +! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),N_int,s2_tmp) +! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(i,jj) +! call filter_connected(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx) +! do kk=1,idx(0) +! j = idx(kk) +! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),N_int,s2_tmp) +! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll) +! enddo +! enddo +! !$OMP END DO +! deallocate(idx) +! !$OMP END PARALLEL +! s2(ll,jj) += accu +! enddo +! enddo +! do i = 1, nstates +! do j =i+1,nstates +! accu = 0.5d0 * (s2(i,j) + s2(j,i)) +! s2(i,j) = accu +! s2(j,i) = accu +! enddo +! enddo +end + + +subroutine i_S2_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_S2_psi_array) + print*,irp_here,' not implemented for complex' + stop -1 +! use bitmasks +! implicit none +! integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist +! integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) +! integer(bit_kind), intent(in) :: key(Nint,2) +! double precision, intent(in) :: coef(Ndet_max,Nstate) +! double precision, intent(out) :: i_S2_psi_array(Nstate) +! +! integer :: i, ii,j, i_in_key, i_in_coef +! double precision :: phase +! integer :: exc(0:2,2,2) +! double precision :: s2ij +! integer :: idx(0:Ndet) +! BEGIN_DOC +!! Computes $\langle i|S^2|\Psi \rangle = \sum_J c_J \langle i|S^2|J \rangle$. +!! +!! Uses filter_connected_i_H_psi0 to get all the $|J\rangle$ to which $|i\rangle$ +!! is connected. The $|J\rangle$ are searched in short pre-computed lists. +! END_DOC +! +! ASSERT (Nint > 0) +! ASSERT (N_int == Nint) +! ASSERT (Nstate > 0) +! ASSERT (Ndet > 0) +! ASSERT (Ndet_max >= Ndet) +! i_S2_psi_array = 0.d0 +! +! call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx) +! if (Nstate == 1) then +! +! do ii=1,idx(0) +! i_in_key = idx(ii) +! i_in_coef = idx_key(idx(ii)) +! !DIR$ FORCEINLINE +! call get_s2(keys(1,1,i_in_key),key,Nint,s2ij) +! ! TODO : Cache misses +! i_S2_psi_array(1) = i_S2_psi_array(1) + coef(i_in_coef,1)*s2ij +! enddo +! +! else +! +! do ii=1,idx(0) +! i_in_key = idx(ii) +! i_in_coef = idx_key(idx(ii)) +! !DIR$ FORCEINLINE +! call get_s2(keys(1,1,i_in_key),key,Nint,s2ij) +! do j = 1, Nstate +! i_S2_psi_array(j) = i_S2_psi_array(j) + coef(i_in_coef,j)*s2ij +! enddo +! enddo +! +! endif +! +end diff --git a/src/determinants/utils.irp.f b/src/determinants/utils.irp.f index 3aec16f9..97258216 100644 --- a/src/determinants/utils.irp.f +++ b/src/determinants/utils.irp.f @@ -20,6 +20,28 @@ BEGIN_PROVIDER [ double precision, H_matrix_all_dets,(N_det,N_det) ] !$OMP END PARALLEL DO END_PROVIDER +BEGIN_PROVIDER [ complex*16, h_matrix_all_dets_complex,(N_det,N_det) ] + use bitmasks + implicit none + BEGIN_DOC + ! |H| matrix on the basis of the Slater determinants defined by psi_det + END_DOC + integer :: i,j,k + complex*16 :: hij + integer :: degree(N_det),idx(0:N_det) + call i_h_j_complex(psi_det(1,1,1),psi_det(1,1,1),N_int,hij) + !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,hij,degree,idx,k) & + !$OMP SHARED (N_det, psi_det, N_int,h_matrix_all_dets_complex) + do i =1,N_det + do j = i, N_det + call i_h_j_complex(psi_det(1,1,i),psi_det(1,1,j),N_int,hij) + H_matrix_all_dets_complex(i,j) = hij + H_matrix_all_dets_complex(j,i) = dconjg(hij) + enddo + enddo + !$OMP END PARALLEL DO +END_PROVIDER + BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ] use bitmasks diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 06d74811..884c4341 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -2,25 +2,57 @@ ------------------------------------------------------------------------------------- current: -determinants: - TODO - create_excitations - do_single_excitation - use symmetry rules to simplify? - should this be general, or should we only allow singles that conserve momentum? - density_matrix - determinants - ezfio_set_determinants_psi_coef_complex_qp_edit? (need ocaml?) - psi_coef_{max,min}? - save_wavefunction_specified{,_complex} qp_edit save? - psi_energy_mono_elec - diag_h_mat_elem for complex - ... +general: + i_h_j_complex + diag_h_mat_elem if is_complex - DONE - create_excitations - build_singly_excited_wavefunction{_complex} - ... + +determinants: + (done) connected_to_ref.irp.f + (done) create_excitations.irp.f + (****) density_matrix.irp.f + (done) determinants_bitmasks.irp.f + (****) determinants{_complex}.irp.f + mostly done + could separate/combine some providers instead of copying + for psi_{det,coef}_sorted: + use same linked provider for psi_average_norm_contrib_sorted + psi_det_sorted_order + psi_det_sorted + different providers for psi_coef{,_complex}_sorted + need to figure out {,abs_}psi_coef_{min,max} + need to modify ocaml for psi_coef_complex_qp_edit? + save_wavefunction_specified? qp_edit save? (wrong for real?) + (done) energy.irp.f + needs diag_h_mat_elem function to be modified for complex + (????) example.irp.f + (****) EZFIO.cfg + (done) filter_connected.irp.f + (done) fock_diag.irp.f + (****) h_apply.irp.f + (****) h_apply_nozmq.template.f + (****) h_apply.template.f + (****) h_apply_zmq.template.f + (****) occ_pattern.irp.f + mostly done? + might need to change calls to fill_h_apply_buffer_no_selection? + check again after modifying h_apply for complex + (done) prune_wf.irp.f + (done) psi_cas{,_complex}.irp.f + might be able to combine some providers?? + (done) psi_energy_mono_elec.irp.f + (****) ref_bitmask.irp.f + (****) s2{,_complex}.irp.f + (****) single_excitations.irp.f + (****) single_excitation_two_e.irp.f + (****) slater_rules.irp.f + (****) slater_rules_wee_mono.irp.f + (done) sort_dets_ab.irp.f + spindeterminants.ezfio_config + (****) spindeterminants.irp.f + (****) two_e_density_matrix.irp.pouet + (done) utils.irp.f + (****) zmq.irp.f ------------------------------------------------------------------------------------- From bcf824cc18fb47a1b83f8c9d8328b51d4a9dac0c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 20 Feb 2020 15:22:03 -0600 Subject: [PATCH 090/256] providers for diag one elec mo ints --- src/determinants/fock_diag.irp.f | 73 ++------------------ src/determinants/ref_bitmask.irp.f | 12 ++-- src/determinants/slater_rules.irp.f | 4 +- src/determinants/slater_rules_wee_mono.irp.f | 2 +- src/mo_one_e_ints/kin_mo_ints.irp.f | 19 +++++ src/mo_one_e_ints/mo_one_e_ints.irp.f | 20 ++++++ src/mo_one_e_ints/pot_mo_ints.irp.f | 19 +++++ src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f | 19 +++++ src/mo_two_e_ints/core_quantities.irp.f | 13 +--- 9 files changed, 93 insertions(+), 88 deletions(-) diff --git a/src/determinants/fock_diag.irp.f b/src/determinants/fock_diag.irp.f index 6f2ffb9b..5c8f3603 100644 --- a/src/determinants/fock_diag.irp.f +++ b/src/determinants/fock_diag.irp.f @@ -30,71 +30,11 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) stop -1 endif - if (is_complex) then - ! Occupied MOs - do ii=1,elec_alpha_num - i = occ(ii,1) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) - E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) - do jj=1,elec_alpha_num - j = occ(jj,1) - if (i==j) cycle - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) - E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j) - enddo - do jj=1,elec_beta_num - j = occ(jj,2) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j) - E0 = E0 + mo_two_e_integrals_jj(i,j) - enddo - enddo - do ii=1,elec_beta_num - i = occ(ii,2) - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) - E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) - do jj=1,elec_beta_num - j = occ(jj,2) - if (i==j) cycle - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) - E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j) - enddo - do jj=1,elec_alpha_num - j = occ(jj,1) - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) - enddo - enddo - - ! Virtual MOs - do i=1,mo_num - if (fock_diag_tmp(1,i) /= 0.d0) cycle - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) - do jj=1,elec_alpha_num - j = occ(jj,1) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) - enddo - do jj=1,elec_beta_num - j = occ(jj,2) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j) - enddo - enddo - do i=1,mo_num - if (fock_diag_tmp(2,i) /= 0.d0) cycle - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) - do jj=1,elec_beta_num - j = occ(jj,2) - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) - enddo - do jj=1,elec_alpha_num - j = occ(jj,1) - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) - enddo - enddo - else ! Occupied MOs do ii=1,elec_alpha_num i = occ(ii,1) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i) - E0 = E0 + mo_one_e_integrals(i,i) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i) + E0 = E0 + mo_one_e_integrals_diag(i) do jj=1,elec_alpha_num j = occ(jj,1) if (i==j) cycle @@ -109,8 +49,8 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) enddo do ii=1,elec_beta_num i = occ(ii,2) - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i) - E0 = E0 + mo_one_e_integrals(i,i) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i) + E0 = E0 + mo_one_e_integrals_diag(i) do jj=1,elec_beta_num j = occ(jj,2) if (i==j) cycle @@ -126,7 +66,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) ! Virtual MOs do i=1,mo_num if (fock_diag_tmp(1,i) /= 0.d0) cycle - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i) do jj=1,elec_alpha_num j = occ(jj,1) fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) @@ -138,7 +78,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) enddo do i=1,mo_num if (fock_diag_tmp(2,i) /= 0.d0) cycle - fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i) do jj=1,elec_beta_num j = occ(jj,2) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) @@ -148,7 +88,6 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) enddo enddo - endif fock_diag_tmp(1,mo_num+1) = E0 fock_diag_tmp(2,mo_num+1) = E0 diff --git a/src/determinants/ref_bitmask.irp.f b/src/determinants/ref_bitmask.irp.f index 4e029ceb..675ef5b6 100644 --- a/src/determinants/ref_bitmask.irp.f +++ b/src/determinants/ref_bitmask.irp.f @@ -27,15 +27,15 @@ ref_bitmask_two_e_energy = 0.d0 do i = 1, elec_beta_num - ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) + mo_one_e_integrals(occ(i,2),occ(i,2)) - ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) + mo_kinetic_integrals(occ(i,2),occ(i,2)) - ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) + mo_integrals_n_e(occ(i,2),occ(i,2)) + ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1)) + mo_one_e_integrals_diag(occ(i,2)) + ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1)) + mo_kinetic_integrals_diag(occ(i,2)) + ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1)) + mo_integrals_n_e_diag(occ(i,2)) enddo do i = elec_beta_num+1,elec_alpha_num - ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) - ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) - ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) + ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1)) + ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1)) + ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1)) enddo do j= 1, elec_alpha_num diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 6b164816..52dfc143 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -1745,7 +1745,7 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb) call bitstring_to_list_ab(key, occ, tmp, Nint) na = na-1 - hjj = hjj - mo_one_e_integrals(iorb,iorb) + hjj = hjj - mo_one_e_integrals_diag(iorb) ! Same spin do i=1,na @@ -1803,7 +1803,7 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb) key(k,ispin) = ibset(key(k,ispin),l) other_spin = iand(ispin,1)+1 - hjj = hjj + mo_one_e_integrals(iorb,iorb) + hjj = hjj + mo_one_e_integrals_diag(iorb) ! Same spin do i=1,na diff --git a/src/determinants/slater_rules_wee_mono.irp.f b/src/determinants/slater_rules_wee_mono.irp.f index 4c1c9330..3a8c9075 100644 --- a/src/determinants/slater_rules_wee_mono.irp.f +++ b/src/determinants/slater_rules_wee_mono.irp.f @@ -225,7 +225,7 @@ double precision function diag_H_mat_elem_one_e(det_in,Nint) call bitstring_to_list_ab(det_in, occ_particle, tmp, Nint) do ispin = 1,2 do i = 1, tmp(ispin) - diag_H_mat_elem_one_e += mo_one_e_integrals(occ_particle(i,ispin),occ_particle(i,ispin)) + diag_H_mat_elem_one_e += mo_one_e_integrals_diag(occ_particle(i,ispin)) enddo enddo diff --git a/src/mo_one_e_ints/kin_mo_ints.irp.f b/src/mo_one_e_ints/kin_mo_ints.irp.f index 216628bb..b12b39bc 100644 --- a/src/mo_one_e_ints/kin_mo_ints.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints.irp.f @@ -22,3 +22,22 @@ BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] END_PROVIDER +BEGIN_PROVIDER [ double precision, mo_kinetic_integrals_diag,(mo_num)] + implicit none + integer :: i + BEGIN_DOC + ! diagonal elements of mo_kinetic_integrals or mo_kinetic_integrals_complex + END_DOC + + if (is_complex) then + PROVIDE mo_kinetic_integrals_complex + do i=1,mo_num + mo_kinetic_integrals_diag(i) = dble(mo_kinetic_integrals_complex(i,i)) + enddo + else + PROVIDE mo_kinetic_integrals + do i=1,mo_num + mo_kinetic_integrals_diag(i) = mo_kinetic_integrals(i,i) + enddo + endif +END_PROVIDER diff --git a/src/mo_one_e_ints/mo_one_e_ints.irp.f b/src/mo_one_e_ints/mo_one_e_ints.irp.f index ac4b4e3b..5e9f4997 100644 --- a/src/mo_one_e_ints/mo_one_e_ints.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints.irp.f @@ -24,3 +24,23 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)] ENDIF END_PROVIDER + +BEGIN_PROVIDER [ double precision, mo_one_e_integrals_diag,(mo_num)] + implicit none + integer :: i + BEGIN_DOC + ! diagonal elements of mo_one_e_integrals or mo_one_e_integrals_complex + END_DOC + + if (is_complex) then + PROVIDE mo_one_e_integrals_complex + do i=1,mo_num + mo_one_e_integrals_diag(i) = dble(mo_one_e_integrals_complex(i,i)) + enddo + else + PROVIDE mo_one_e_integrals + do i=1,mo_num + mo_one_e_integrals_diag(i) = mo_one_e_integrals(i,i) + enddo + endif +END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_ints.irp.f b/src/mo_one_e_ints/pot_mo_ints.irp.f index 90f7b06c..6682449a 100644 --- a/src/mo_one_e_ints/pot_mo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints.irp.f @@ -44,3 +44,22 @@ BEGIN_PROVIDER [double precision, mo_integrals_n_e_per_atom, (mo_num,mo_num,nucl END_PROVIDER +BEGIN_PROVIDER [ double precision, mo_integrals_n_e_diag,(mo_num)] + implicit none + integer :: i + BEGIN_DOC + ! diagonal elements of mo_integrals_n_e or mo_integrals_n_e_complex + END_DOC + + if (is_complex) then + PROVIDE mo_integrals_n_e_complex + do i=1,mo_num + mo_integrals_n_e_diag(i) = dble(mo_integrals_n_e_complex(i,i)) + enddo + else + PROVIDE mo_integrals_n_e + do i=1,mo_num + mo_integrals_n_e_diag(i) = mo_integrals_n_e(i,i) + enddo + endif +END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f index 179b33ed..f135629a 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f @@ -25,4 +25,23 @@ BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] END_PROVIDER +BEGIN_PROVIDER [ double precision, mo_pseudo_integrals_diag,(mo_num)] + implicit none + integer :: i + BEGIN_DOC + ! diagonal elements of mo_pseudo_integrals or mo_pseudo_integrals_complex + END_DOC + + if (is_complex) then + PROVIDE mo_pseudo_integrals_complex + do i=1,mo_num + mo_pseudo_integrals_diag(i) = dble(mo_pseudo_integrals_complex(i,i)) + enddo + else + PROVIDE mo_pseudo_integrals + do i=1,mo_num + mo_pseudo_integrals_diag(i) = mo_pseudo_integrals(i,i) + enddo + endif +END_PROVIDER diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f index 8afbcd83..773561f0 100644 --- a/src/mo_two_e_ints/core_quantities.irp.f +++ b/src/mo_two_e_ints/core_quantities.irp.f @@ -5,25 +5,14 @@ BEGIN_PROVIDER [double precision, core_energy] END_DOC integer :: i,j,k,l core_energy = 0.d0 - if (is_complex) then - do i = 1, n_core_orb - j = list_core(i) - core_energy += 2.d0 * dble(mo_one_e_integrals_complex(j,j)) + mo_two_e_integrals_jj(j,j) - do k = i+1, n_core_orb - l = list_core(k) - core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) - enddo - enddo - else do i = 1, n_core_orb j = list_core(i) - core_energy += 2.d0 * mo_one_e_integrals(j,j) + mo_two_e_integrals_jj(j,j) + core_energy += 2.d0 * mo_one_e_integrals_diag(j) + mo_two_e_integrals_jj(j,j) do k = i+1, n_core_orb l = list_core(k) core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) enddo enddo - endif core_energy += nuclear_repulsion END_PROVIDER From 702ba79af8f47933b5ac55d62cdb25c752bc883d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 20 Feb 2020 15:38:02 -0600 Subject: [PATCH 091/256] cleanup complex mo one e ints --- src/mo_one_e_ints/EZFIO.cfg | 50 +++++-------------- src/mo_one_e_ints/kin_mo_ints_complex.irp.f | 26 ++-------- src/mo_one_e_ints/mo_one_e_ints_complex.irp.f | 22 ++------ src/mo_one_e_ints/orthonormalize.irp.f | 1 - src/mo_one_e_ints/pot_mo_ints_complex.irp.f | 26 ++-------- .../pot_mo_pseudo_ints_complex.irp.f | 34 ++----------- 6 files changed, 27 insertions(+), 132 deletions(-) diff --git a/src/mo_one_e_ints/EZFIO.cfg b/src/mo_one_e_ints/EZFIO.cfg index fbbd378a..d70e4d19 100644 --- a/src/mo_one_e_ints/EZFIO.cfg +++ b/src/mo_one_e_ints/EZFIO.cfg @@ -4,16 +4,10 @@ doc: Nucleus-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio -[mo_integrals_e_n_real] +[mo_integrals_e_n_complex] type: double precision -doc: Real part of the nucleus-electron integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) -interface: ezfio - -[mo_integrals_e_n_imag] -type: double precision -doc: Imaginary part of the nucleus-electron integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) +doc: Complex nucleus-electron integrals in |MO| basis set +size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio [io_mo_integrals_e_n] @@ -29,16 +23,10 @@ doc: Kinetic energy integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio -[mo_integrals_kinetic_real] +[mo_integrals_kinetic_complex] type: double precision -doc: Real part of the kinetic energy integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) -interface: ezfio - -[mo_integrals_kinetic_imag] -type: double precision -doc: Imaginary part of the kinetic energy integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) +doc: Complex kinetic energy integrals in |MO| basis set +size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio [io_mo_integrals_kinetic] @@ -48,23 +36,16 @@ interface: ezfio,provider,ocaml default: None - [mo_integrals_pseudo] type: double precision doc: Pseudopotential integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio -[mo_integrals_pseudo_real] +[mo_integrals_pseudo_complex] type: double precision -doc: Real part of the pseudopotential integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) -interface: ezfio - -[mo_integrals_pseudo_imag] -type: double precision -doc: Imaginary part of the pseudopotential integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) +doc: Complex pseudopotential integrals in |MO| basis set +size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio [io_mo_integrals_pseudo] @@ -73,22 +54,17 @@ doc: Read/Write |MO| pseudopotential integrals from/to disk [ Write | Read | Non interface: ezfio,provider,ocaml default: None + [mo_one_e_integrals] type: double precision doc: One-electron integrals in |MO| basis set size: (mo_basis.mo_num,mo_basis.mo_num) interface: ezfio -[mo_one_e_integrals_real] +[mo_one_e_integrals_complex] type: double precision -doc: Real part of the one-electron integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) -interface: ezfio - -[mo_one_e_integrals_imag] -type: double precision -doc: Imaginary part of the one-electron integrals in |MO| basis set -size: (mo_basis.mo_num,mo_basis.mo_num) +doc: Complex one-electron integrals in |MO| basis set +size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio [io_mo_one_e_integrals] diff --git a/src/mo_one_e_ints/kin_mo_ints_complex.irp.f b/src/mo_one_e_ints/kin_mo_ints_complex.irp.f index 10cecc85..f8c790b8 100644 --- a/src/mo_one_e_ints/kin_mo_ints_complex.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints_complex.irp.f @@ -1,6 +1,4 @@ - BEGIN_PROVIDER [double precision, mo_kinetic_integrals_real, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_kinetic_integrals_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Kinetic energy integrals in the MO basis @@ -8,17 +6,8 @@ integer :: i,j if (read_mo_integrals_kinetic) then - mo_kinetic_integrals_real = 0.d0 - mo_kinetic_integrals_imag = 0.d0 - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_real(mo_kinetic_integrals_real) - call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_complex(mo_kinetic_integrals_complex) print *, 'MO kinetic integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_kinetic_integrals_complex(j,i) = dcmplx(mo_kinetic_integrals_real(j,i), & - mo_kinetic_integrals_imag(j,i)) - enddo - enddo else call ao_to_mo_complex( & ao_kinetic_integrals_complex, & @@ -28,16 +17,7 @@ ) endif if (write_mo_integrals_kinetic) then - !mo_kinetic_integrals_real = 0.d0 - !mo_kinetic_integrals_imag = 0.d0 - do i=1,mo_num - do j=1,mo_num - mo_kinetic_integrals_real(j,i)=dble(mo_kinetic_integrals_complex(j,i)) - mo_kinetic_integrals_imag(j,i)=dimag(mo_kinetic_integrals_complex(j,i)) - enddo - enddo - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_real(mo_kinetic_integrals_real) - call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_imag(mo_kinetic_integrals_imag) + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_complex(mo_kinetic_integrals_complex) print *, 'MO kinetic integrals written to disk' endif diff --git a/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f b/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f index a5463c12..de1fbb36 100644 --- a/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f @@ -1,6 +1,4 @@ - BEGIN_PROVIDER [ double precision, mo_one_e_integrals_real,(mo_num,mo_num)] -&BEGIN_PROVIDER [ double precision, mo_one_e_integrals_imag,(mo_num,mo_num)] -&BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] +BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] implicit none integer :: i,j,n,l BEGIN_DOC @@ -10,28 +8,18 @@ print*,'Providing the one-electron integrals' IF (read_mo_one_e_integrals) THEN - call ezfio_get_mo_one_e_ints_mo_one_e_integrals_real(mo_one_e_integrals_real) - call ezfio_get_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + call ezfio_get_mo_one_e_ints_mo_one_e_integrals_complex(mo_one_e_integrals_complex) ELSE - mo_one_e_integrals_real = mo_integrals_n_e_real + mo_kinetic_integrals_real - mo_one_e_integrals_imag = mo_integrals_n_e_imag + mo_kinetic_integrals_imag + mo_one_e_integrals_complex = mo_integrals_n_e_complex + mo_kinetic_integrals_complex IF (DO_PSEUDO) THEN - mo_one_e_integrals_real += mo_pseudo_integrals_real - mo_one_e_integrals_imag += mo_pseudo_integrals_imag + mo_one_e_integrals_complex += mo_pseudo_integrals_complex ENDIF ENDIF - do i=1,mo_num - do j=1,mo_num - mo_one_e_integrals_complex(j,i)=dcmplx(mo_one_e_integrals_real(j,i), & - mo_one_e_integrals_imag(j,i)) - enddo - enddo IF (write_mo_one_e_integrals) THEN - call ezfio_set_mo_one_e_ints_mo_one_e_integrals_real(mo_one_e_integrals_real) - call ezfio_set_mo_one_e_ints_mo_one_e_integrals_imag(mo_one_e_integrals_imag) + call ezfio_set_mo_one_e_ints_mo_one_e_integrals_complex(mo_one_e_integrals_complex) print *, 'MO one-e integrals written to disk' ENDIF diff --git a/src/mo_one_e_ints/orthonormalize.irp.f b/src/mo_one_e_ints/orthonormalize.irp.f index d9675bc8..11a09b4e 100644 --- a/src/mo_one_e_ints/orthonormalize.irp.f +++ b/src/mo_one_e_ints/orthonormalize.irp.f @@ -7,7 +7,6 @@ subroutine orthonormalize_mos call ortho_lowdin_complex(mo_overlap_complex,p,mo_num,mo_coef_complex,m,ao_num) mo_label = 'Orthonormalized' SOFT_TOUCH mo_coef_complex mo_label - !TODO: should we do anything with the separate real/imag parts of mo_coef_complex? else m = size(mo_coef,1) p = size(mo_overlap,1) diff --git a/src/mo_one_e_ints/pot_mo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_ints_complex.irp.f index 3110f305..b1972b11 100644 --- a/src/mo_one_e_ints/pot_mo_ints_complex.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints_complex.irp.f @@ -1,6 +1,4 @@ - BEGIN_PROVIDER [double precision, mo_integrals_n_e_real, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_integrals_n_e_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Kinetic energy integrals in the MO basis @@ -8,17 +6,8 @@ integer :: i,j if (read_mo_integrals_e_n) then - mo_integrals_n_e_real = 0.d0 - mo_integrals_n_e_imag = 0.d0 - call ezfio_get_mo_one_e_ints_mo_integrals_e_n_real(mo_integrals_n_e_real) - call ezfio_get_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + call ezfio_get_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex) print *, 'MO N-e integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_integrals_n_e_complex(j,i) = dcmplx(mo_integrals_n_e_real(j,i), & - mo_integrals_n_e_imag(j,i)) - enddo - enddo else call ao_to_mo_complex( & ao_integrals_n_e_complex, & @@ -28,16 +17,7 @@ ) endif if (write_mo_integrals_e_n) then - !mo_integrals_n_e_real = 0.d0 - !mo_integrals_n_e_imag = 0.d0 - do i=1,mo_num - do j=1,mo_num - mo_integrals_n_e_real(j,i)=dble(mo_integrals_n_e_complex(j,i)) - mo_integrals_n_e_imag(j,i)=dimag(mo_integrals_n_e_complex(j,i)) - enddo - enddo - call ezfio_set_mo_one_e_ints_mo_integrals_e_n_real(mo_integrals_n_e_real) - call ezfio_set_mo_one_e_ints_mo_integrals_e_n_imag(mo_integrals_n_e_imag) + call ezfio_set_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex) print *, 'MO N-e integrals written to disk' endif diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f index 9ad6a831..18a4e920 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f @@ -1,6 +1,4 @@ - BEGIN_PROVIDER [double precision, mo_pseudo_integrals_real, (mo_num,mo_num)] -&BEGIN_PROVIDER [double precision, mo_pseudo_integrals_imag, (mo_num,mo_num)] -&BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] implicit none BEGIN_DOC ! Pseudopotential integrals in |MO| basis @@ -8,17 +6,8 @@ integer :: i,j if (read_mo_integrals_pseudo) then - mo_pseudo_integrals_real = 0.d0 - mo_pseudo_integrals_imag = 0.d0 - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_real(mo_pseudo_integrals_real) - call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_complex(mo_pseudo_integrals_complex) print *, 'MO pseudopotential integrals read from disk' - do i=1,mo_num - do j=1,mo_num - mo_pseudo_integrals_complex(j,i) = dcmplx(mo_pseudo_integrals_real(j,i), & - mo_pseudo_integrals_imag(j,i)) - enddo - enddo else if (do_pseudo) then call ao_to_mo_complex( & ao_pseudo_integrals_complex, & @@ -26,28 +15,11 @@ mo_pseudo_integrals_complex, & size(mo_pseudo_integrals_complex,1) & ) - do i=1,mo_num - do j=1,mo_num - mo_pseudo_integrals_real(j,i)=dble(mo_pseudo_integrals_complex(j,i)) - mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) - enddo - enddo else - mo_pseudo_integrals_real = 0.d0 - mo_pseudo_integrals_imag = 0.d0 mo_pseudo_integrals_complex = (0.d0,0.d0) endif if (write_mo_integrals_pseudo) then - !mo_pseudo_integrals_real = 0.d0 - !mo_pseudo_integrals_imag = 0.d0 - do i=1,mo_num - do j=1,mo_num - mo_pseudo_integrals_real(j,i)=dble(mo_pseudo_integrals_complex(j,i)) - mo_pseudo_integrals_imag(j,i)=dimag(mo_pseudo_integrals_complex(j,i)) - enddo - enddo - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_real(mo_pseudo_integrals_real) - call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_imag(mo_pseudo_integrals_imag) + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_complex(mo_pseudo_integrals_complex) print *, 'MO pseudopotential integrals written to disk' endif From 6d12abf08886fd865865f27865e9a2b67a6081df Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 21 Feb 2020 15:54:48 -0600 Subject: [PATCH 092/256] working on complex determinants --- src/determinants/density_matrix.irp.f | 36 +- src/determinants/density_matrix_complex.irp.f | 311 +++++++++ src/determinants/s2_complex.irp.f | 5 + src/determinants/single_excitations.irp.f | 145 +++++ src/determinants/slater_rules.irp.f | 596 +++++++++++++++++- .../spindeterminants.ezfio_config | 1 + src/determinants/spindeterminants.irp.f | 196 +++++- src/utils/sort.irp.f | 1 + src/utils_complex/qp2-pbc-diff.txt | 23 +- 9 files changed, 1274 insertions(+), 40 deletions(-) create mode 100644 src/determinants/density_matrix_complex.irp.f diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index e69a1803..4cc20cc1 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -248,6 +248,11 @@ BEGIN_PROVIDER [ double precision, one_e_spin_density_mo, (mo_num,mo_num) ] END_PROVIDER subroutine set_natural_mos + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif implicit none BEGIN_DOC ! Set natural orbitals, obtained by diagonalization of the one-body density matrix @@ -274,6 +279,11 @@ subroutine set_natural_mos end subroutine save_natural_mos + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif implicit none BEGIN_DOC ! Save natural orbitals, obtained by diagonalization of the one-body density matrix in @@ -292,11 +302,19 @@ BEGIN_PROVIDER [ double precision, c0_weight, (N_states) ] if (N_states > 1) then integer :: i double precision :: c + if (is_complex) then + do i=1,N_states + c0_weight(i) = 1.d-31 + c = maxval(cdabs(psi_coef_complex(:,i) * psi_coef_complex(:,i))) + c0_weight(i) = 1.d0/(c+1.d-20) + enddo + else do i=1,N_states c0_weight(i) = 1.d-31 c = maxval(psi_coef(:,i) * psi_coef(:,i)) c0_weight(i) = 1.d0/(c+1.d-20) enddo + endif c = 1.d0/minval(c0_weight(:)) do i=1,N_states c0_weight(i) = c0_weight(i) * c @@ -398,8 +416,23 @@ subroutine get_occupation_from_dets(istate,occupation) ASSERT (istate <= N_states) occupation = 0.d0 - double precision, external :: u_dot_u + + if (is_complex) then + double precision, external :: u_dot_u_complex + norm_2 = 1.d0/u_dot_u_complex(psi_coef_complex(1,istate),N_det) + do i=1,N_det + c = cdabs(psi_coef_complex(i,istate)*psi_coef_complex(i,istate))*norm_2 + call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int) + do ispin=1,2 + do j=1,n_elements(ispin) + ASSERT ( list(j,ispin) < mo_num ) + occupation( list(j,ispin) ) += c + enddo + enddo + enddo + else + double precision, external :: u_dot_u norm_2 = 1.d0/u_dot_u(psi_coef(1,istate),N_det) do i=1,N_det @@ -412,5 +445,6 @@ subroutine get_occupation_from_dets(istate,occupation) enddo enddo enddo + endif end diff --git a/src/determinants/density_matrix_complex.irp.f b/src/determinants/density_matrix_complex.irp.f new file mode 100644 index 00000000..e6c81d33 --- /dev/null +++ b/src/determinants/density_matrix_complex.irp.f @@ -0,0 +1,311 @@ + BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_average_complex, (mo_num,mo_num) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_average_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! $\alpha$ and $\beta$ one-body density matrix for each state + END_DOC + integer :: i + one_e_dm_mo_alpha_average_complex = (0.d0,0.d0) + one_e_dm_mo_beta_average_complex = (0.d0,0.d0) + do i = 1,N_states + one_e_dm_mo_alpha_average_complex(:,:) += one_e_dm_mo_alpha_complex(:,:,i) * state_average_weight(i) + one_e_dm_mo_beta_average_complex(:,:) += one_e_dm_mo_beta_complex(:,:,i) * state_average_weight(i) + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_diff_complex, (mo_num,mo_num,2:N_states) ] + implicit none + BEGIN_DOC + ! Difference of the one-body density matrix with respect to the ground state + END_DOC + integer :: i,j, istate + + do istate=2,N_states + do j=1,mo_num + do i=1,mo_num + one_e_dm_mo_diff_complex(i,j,istate) = & + one_e_dm_mo_alpha_complex(i,j,istate) - one_e_dm_mo_alpha_complex(i,j,1) +& + one_e_dm_mo_beta_complex (i,j,istate) - one_e_dm_mo_beta_complex (i,j,1) + enddo + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_spin_index_complex, (mo_num,mo_num,N_states,2) ] + implicit none + integer :: i,j,ispin,istate + ispin = 1 + do istate = 1, N_states + do j = 1, mo_num + do i = 1, mo_num + one_e_dm_mo_spin_index_complex(i,j,istate,ispin) = one_e_dm_mo_alpha_complex(i,j,istate) + enddo + enddo + enddo + + ispin = 2 + do istate = 1, N_states + do j = 1, mo_num + do i = 1, mo_num + one_e_dm_mo_spin_index_complex(i,j,istate,ispin) = one_e_dm_mo_beta_complex(i,j,istate) + enddo + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_dm_dagger_mo_spin_index_complex, (mo_num,mo_num,N_states,2) ] + print*,irp_here,' not implemented for complex' + stop -1 +! implicit none +! integer :: i,j,ispin,istate +! ispin = 1 +! do istate = 1, N_states +! do j = 1, mo_num +! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_alpha(j,j,istate) +! do i = j+1, mo_num +! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate) +! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate) +! enddo +! enddo +! enddo +! +! ispin = 2 +! do istate = 1, N_states +! do j = 1, mo_num +! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_beta(j,j,istate) +! do i = j+1, mo_num +! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_beta(i,j,istate) +! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_beta(i,j,istate) +! enddo +! enddo +! enddo +! +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_complex, (mo_num,mo_num,N_states) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_complex, (mo_num,mo_num,N_states) ] + implicit none + BEGIN_DOC + ! $\alpha$ and $\beta$ one-body density matrix for each state + ! $\gamma_{\mu\nu} = \langle\Psi|a_{\nu}^{\dagger}a_{\mu}|\Psi\rangle$ + ! $\gamma_{\mu\nu} = \langle a_{\nu} \Psi|a_{\mu} \Psi\rangle$ + ! $\gamma_{\mu\nu} = \sum_{IJ} c^*_J c_I \langle a_{\nu} I|a_{\mu} J\rangle$ + END_DOC + + integer :: j,k,l,m,k_a,k_b + integer :: occ(N_int*bit_kind_size,2) + complex*16 :: ck, cl, ckl + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2, degree + integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int) + integer :: exc(0:2,2),n_occ(2) + complex*16, allocatable :: tmp_a(:,:,:), tmp_b(:,:,:) + integer :: krow, kcol, lrow, lcol + + PROVIDE psi_det + + one_e_dm_mo_alpha_complex = (0.d0,0.d0) + one_e_dm_mo_beta_complex = (0.d0,0.d0) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(j,k,k_a,k_b,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,& + !$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)& + !$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states,elec_alpha_num, & + !$OMP elec_beta_num,one_e_dm_mo_alpha_complex,one_e_dm_mo_beta_complex,N_det,& + !$OMP mo_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns,& + !$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns,& + !$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique,& + !$OMP psi_bilinear_matrix_values_complex, psi_bilinear_matrix_transp_values_complex,& + !$OMP N_det_alpha_unique,N_det_beta_unique,irp_here) + allocate(tmp_a(mo_num,mo_num,N_states), tmp_b(mo_num,mo_num,N_states) ) + tmp_a = (0.d0,0.d0) + !$OMP DO SCHEDULE(dynamic,64) + do k_a=1,N_det + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow) + tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol) + + ! Diagonal part + ! ------------- + + call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int) + do m=1,N_states + ck = cdabs(psi_bilinear_matrix_values_complex(k_a,m)*psi_bilinear_matrix_values_complex(k_a,m)) + do l=1,elec_alpha_num + j = occ(l,1) + tmp_a(j,j,m) += ck + enddo + enddo + + if (k_a == N_det) cycle + l = k_a+1 + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + ! Fix beta determinant, loop over alphas + do while ( lcol == kcol ) + tmp_det2(:) = psi_det_alpha_unique(:, lrow) + call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int) + if (degree == 1) then + exc = 0 + call get_single_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int) + call decode_exc_spin(exc,h1,p1,h2,p2) + ! h1 occ in k + ! p1 occ in l + do m=1,N_states + ckl = dconjg(psi_bilinear_matrix_values_complex(k_a,m))*psi_bilinear_matrix_values_complex(l,m) * phase + tmp_a(h1,p1,m) += dconjg(ckl) + tmp_a(p1,h1,m) += ckl + enddo + endif + l = l+1 + if (l>N_det) exit + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + enddo + + enddo + !$OMP END DO NOWAIT + + !$OMP CRITICAL + one_e_dm_mo_alpha_complex(:,:,:) = one_e_dm_mo_alpha_complex(:,:,:) + tmp_a(:,:,:) + !$OMP END CRITICAL + deallocate(tmp_a) + + tmp_b = (0.d0,0.d0) + !$OMP DO SCHEDULE(dynamic,64) + do k_b=1,N_det + krow = psi_bilinear_matrix_transp_rows(k_b) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_transp_columns(k_b) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow) + tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol) + + ! Diagonal part + ! ------------- + + call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int) + do m=1,N_states + ck = cdabs(psi_bilinear_matrix_transp_values_complex(k_b,m)*psi_bilinear_matrix_transp_values_complex(k_b,m)) + do l=1,elec_beta_num + j = occ(l,2) + tmp_b(j,j,m) += ck + enddo + enddo + + if (k_b == N_det) cycle + l = k_b+1 + lrow = psi_bilinear_matrix_transp_rows(l) + lcol = psi_bilinear_matrix_transp_columns(l) + ! Fix beta determinant, loop over alphas + do while ( lrow == krow ) + tmp_det2(:) = psi_det_beta_unique(:, lcol) + call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int) + if (degree == 1) then + exc = 0 + call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int) + call decode_exc_spin(exc,h1,p1,h2,p2) + do m=1,N_states + ckl = dconjg(psi_bilinear_matrix_transp_values_complex(k_b,m))*psi_bilinear_matrix_transp_values_complex(l,m) * phase + tmp_b(h1,p1,m) += dconjg(ckl) + tmp_b(p1,h1,m) += ckl + enddo + endif + l = l+1 + if (l>N_det) exit + lrow = psi_bilinear_matrix_transp_rows(l) + lcol = psi_bilinear_matrix_transp_columns(l) + enddo + + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + one_e_dm_mo_beta_complex(:,:,:) = one_e_dm_mo_beta_complex(:,:,:) + tmp_b(:,:,:) + !$OMP END CRITICAL + + deallocate(tmp_b) + !$OMP END PARALLEL + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! One-body density matrix + END_DOC + one_e_dm_mo_complex = one_e_dm_mo_alpha_average_complex + one_e_dm_mo_beta_average_complex +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_spin_density_mo_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! $\rho(\alpha) - \rho(\beta)$ + END_DOC + one_e_spin_density_mo_complex = one_e_dm_mo_alpha_average_complex - one_e_dm_mo_beta_average_complex +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_spin_density_ao_complex, (ao_num,ao_num) ] + BEGIN_DOC + ! One body spin density matrix on the |AO| basis : $\rho_{AO}(\alpha) - \rho_{AO}(\beta)$ + ! todo: verify that this is correct for complex + ! equivalent to using mo_to_ao_no_overlap? + END_DOC + implicit none + integer :: i,j,k,l + complex*16 :: dm_mo + + one_e_spin_density_ao_complex = (0.d0,0.d0) + do k = 1, ao_num + do l = 1, ao_num + do i = 1, mo_num + do j = 1, mo_num + dm_mo = one_e_spin_density_mo_complex(j,i) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_spin_density_ao_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * dm_mo + + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, one_e_dm_ao_alpha_complex, (ao_num,ao_num) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_ao_beta_complex, (ao_num,ao_num) ] + BEGIN_DOC + ! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$. + END_DOC + implicit none + integer :: i,j,k,l + complex*16 :: mo_alpha,mo_beta + + one_e_dm_ao_alpha = (0.d0,0.d0) + one_e_dm_ao_beta = (0.d0,0.d0) + do k = 1, ao_num + do l = 1, ao_num + do i = 1, mo_num + do j = 1, mo_num + mo_alpha = one_e_dm_mo_alpha_average_complex(j,i) + mo_beta = one_e_dm_mo_beta_average_complex(j,i) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_dm_ao_alpha_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * mo_alpha + one_e_dm_ao_beta_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * mo_beta + enddo + enddo + enddo + enddo + +END_PROVIDER + + diff --git a/src/determinants/s2_complex.irp.f b/src/determinants/s2_complex.irp.f index bb368f55..e2116db8 100644 --- a/src/determinants/s2_complex.irp.f +++ b/src/determinants/s2_complex.irp.f @@ -1,4 +1,5 @@ subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) + !todo: modify/implement for complex print*,irp_here,' not implemented for complex' stop -1 ! use bitmasks @@ -28,6 +29,7 @@ end subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint) + !todo: modify/implement for complex print*,irp_here,' not implemented for complex' stop -1 ! use bitmasks @@ -46,6 +48,7 @@ subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint) end subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) + !todo: modify/implement for complex print*,irp_here,' not implemented for complex' stop -1 ! use bitmasks @@ -180,6 +183,7 @@ end subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_keys,s2,nstates) + !todo: modify/implement for complex print*,irp_here,' not implemented for complex' stop -1 ! implicit none @@ -232,6 +236,7 @@ end subroutine i_S2_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_S2_psi_array) + !todo: modify/implement for complex print*,irp_here,' not implemented for complex' stop -1 ! use bitmasks diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index ccfeaa2e..65c8ac7f 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -159,3 +159,148 @@ subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij) end + + +BEGIN_PROVIDER [complex*16, fock_operator_closed_shell_ref_bitmask_complex, (mo_num, mo_num) ] + implicit none + integer :: i0,j0,i,j,k0,k + integer :: n_occ_ab(2) + integer :: occ(N_int*bit_kind_size,2) + integer :: n_occ_ab_virt(2) + integer :: occ_virt(N_int*bit_kind_size,2) + integer(bit_kind) :: key_test(N_int) + integer(bit_kind) :: key_virt(N_int,2) + complex*16 :: accu + + call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int) + do i = 1, N_int + key_virt(i,1) = full_ijkl_bitmask(i) + key_virt(i,2) = full_ijkl_bitmask(i) + key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1)) + key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2)) + enddo + complex*16, allocatable :: array_coulomb(:),array_exchange(:) + allocate (array_coulomb(mo_num),array_exchange(mo_num)) + call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) + ! docc ---> virt single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + ! + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + ! + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu + mo_one_e_integrals_complex(i,j) + !fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) + fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(fock_operator_closed_shell_ref_bitmask_complex(i,j)) + enddo + enddo + + ! virt ---> virt single excitations + do i0 = 1, n_occ_ab_virt(1) + i=occ_virt(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + enddo + enddo + + ! docc ---> docc single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab(1) + j = occ(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + enddo + enddo + deallocate(array_coulomb,array_exchange) + +END_PROVIDER + +subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hij) + use bitmasks + implicit none + integer,intent(in) :: h,p,spin + double precision, intent(in) :: phase + integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) + complex*16, intent(out) :: hij + integer(bit_kind) :: differences(N_int,2) + integer(bit_kind) :: hole(N_int,2) + integer(bit_kind) :: partcl(N_int,2) + integer :: occ_hole(N_int*bit_kind_size,2) + integer :: occ_partcl(N_int*bit_kind_size,2) + integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) + integer :: i0,i + complex*16 :: buffer_c(mo_num),buffer_x(mo_num) + do i=1, mo_num + buffer_c(i) = big_array_coulomb_integrals_complex(i,h,p) + buffer_x(i) = big_array_exchange_integrals_complex(i,h,p) + enddo + do i = 1, N_int + differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) + differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) + hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) + hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) + partcl(i,1) = iand(differences(i,1),det_1(i,1)) + partcl(i,2) = iand(differences(i,2),det_1(i,2)) + enddo + call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) + call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) + hij = fock_operator_closed_shell_ref_bitmask_complex(h,p) + ! holes :: direct terms + do i0 = 1, n_occ_ab_hole(1) + i = occ_hole(i0,1) + hij -= buffer_c(i) + enddo + do i0 = 1, n_occ_ab_hole(2) + i = occ_hole(i0,2) + hij -= buffer_c(i) + enddo + + ! holes :: exchange terms + do i0 = 1, n_occ_ab_hole(spin) + i = occ_hole(i0,spin) + hij += buffer_x(i) + enddo + + ! particles :: direct terms + do i0 = 1, n_occ_ab_partcl(1) + i = occ_partcl(i0,1) + hij += buffer_c(i) + enddo + do i0 = 1, n_occ_ab_partcl(2) + i = occ_partcl(i0,2) + hij += buffer_c(i) + enddo + + ! particles :: exchange terms + do i0 = 1, n_occ_ab_partcl(spin) + i = occ_partcl(i0,spin) + hij -= buffer_x(i) + enddo + hij = hij * phase + +end + diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 52dfc143..7f0ccdbc 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -1581,9 +1581,12 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx) end - - double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use bitmasks implicit none BEGIN_DOC @@ -2292,3 +2295,592 @@ subroutine connected_to_hf(key_i,yes_no) yes_no = .True. endif end + + +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + + +subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ and $\langle i|S^2|j \rangle$ + ! where $i$ and $j$ are determinants. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij, s2 + + integer :: exc(0:2,2,2) + integer :: degree + double precision :: get_two_e_integral + integer :: m,n,p,q + integer :: i,j,k + integer :: occ(Nint*bit_kind_size,2) + double precision :: diag_H_mat_elem, phase + integer :: n_occ_ab(2) + PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num) + ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) + + hij = 0.d0 + s2 = 0d0 + !DIR$ FORCEINLINE + call get_excitation_degree(key_i,key_j,degree,Nint) + integer :: spin + select case (degree) + case (2) + call get_double_excitation(key_i,key_j,exc,phase,Nint) + ! Single alpha, single beta + if (exc(0,1,1) == 1) then + if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then + s2 = -phase + endif + if(exc(1,1,1) == exc(1,2,2) )then + hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) ==exc(1,1,2))then + hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_two_e_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif + ! Double alpha + else if (exc(0,1,1) == 2) then + hij = phase*(get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(1,2,1), & + exc(2,2,1) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(2,2,1), & + exc(1,2,1) ,mo_integrals_map) ) + ! Double beta + else if (exc(0,1,2) == 2) then + hij = phase*(get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(1,2,2), & + exc(2,2,2) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(2,2,2), & + exc(1,2,2) ,mo_integrals_map) ) + endif + case (1) + call get_single_excitation(key_i,key_j,exc,phase,Nint) + !DIR$ FORCEINLINE + call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) + ! Single alpha + if (exc(0,1,1) == 1) then + m = exc(1,1,1) + p = exc(1,2,1) + spin = 1 + ! Single beta + else + m = exc(1,1,2) + p = exc(1,2,2) + spin = 2 + endif + call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij) + + case (0) + double precision, external :: diag_S_mat_elem + s2 = diag_S_mat_elem(key_i,Nint) + hij = diag_H_mat_elem(key_i,Nint) + end select +end + + + +subroutine i_H_j_complex(key_i,key_j,Nint,hij) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij + + integer :: exc(0:2,2,2) + integer :: degree + double precision :: get_two_e_integral + integer :: m,n,p,q + integer :: i,j,k + integer :: occ(Nint*bit_kind_size,2) + double precision :: diag_H_mat_elem, phase + integer :: n_occ_ab(2) + PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num) + ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) + + + hij = 0.d0 + !DIR$ FORCEINLINE + call get_excitation_degree(key_i,key_j,degree,Nint) + integer :: spin + select case (degree) + case (2) + call get_double_excitation(key_i,key_j,exc,phase,Nint) + if (exc(0,1,1) == 1) then + ! Single alpha, single beta + if(exc(1,1,1) == exc(1,2,2) )then + hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) ==exc(1,1,2))then + hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_two_e_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif + else if (exc(0,1,1) == 2) then + ! Double alpha + hij = phase*(get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(1,2,1), & + exc(2,2,1) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(2,2,1), & + exc(1,2,1) ,mo_integrals_map) ) + else if (exc(0,1,2) == 2) then + ! Double beta + hij = phase*(get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(1,2,2), & + exc(2,2,2) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(2,2,2), & + exc(1,2,2) ,mo_integrals_map) ) + endif + case (1) + call get_single_excitation(key_i,key_j,exc,phase,Nint) + !DIR$ FORCEINLINE + call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) + if (exc(0,1,1) == 1) then + ! Single alpha + m = exc(1,1,1) + p = exc(1,2,1) + spin = 1 + else + ! Single beta + m = exc(1,1,2) + p = exc(1,2,2) + spin = 2 + endif + call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij) + + case (0) + hij = diag_H_mat_elem(key_i,Nint) + end select +end + + + + + +subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij,hmono,hdouble,phase + + integer :: exc(0:2,2,2) + integer :: degree + double precision :: get_two_e_integral + integer :: m,n,p,q + integer :: i,j,k + integer :: occ(Nint*bit_kind_size,2) + double precision :: diag_H_mat_elem + integer :: n_occ_ab(2) + logical :: has_mipi(Nint*bit_kind_size) + double precision :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size) + PROVIDE mo_two_e_integrals_in_map mo_integrals_map + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num) + ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) + + hij = 0.d0 + hmono = 0.d0 + hdouble = 0.d0 + !DIR$ FORCEINLINE + call get_excitation_degree(key_i,key_j,degree,Nint) + select case (degree) + case (2) + call get_double_excitation(key_i,key_j,exc,phase,Nint) + if (exc(0,1,1) == 1) then + ! Single alpha, single beta + hij = phase*get_two_e_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + else if (exc(0,1,1) == 2) then + ! Double alpha + hij = phase*(get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(1,2,1), & + exc(2,2,1) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(2,2,1), & + exc(1,2,1) ,mo_integrals_map) ) + + else if (exc(0,1,2) == 2) then + ! Double beta + hij = phase*(get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(1,2,2), & + exc(2,2,2) ,mo_integrals_map) - & + get_two_e_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(2,2,2), & + exc(1,2,2) ,mo_integrals_map) ) + endif + case (1) + call get_single_excitation(key_i,key_j,exc,phase,Nint) + !DIR$ FORCEINLINE + call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) + has_mipi = .False. + if (exc(0,1,1) == 1) then + ! Single alpha + m = exc(1,1,1) + p = exc(1,2,1) + do k = 1, elec_alpha_num + i = occ(k,1) + if (.not.has_mipi(i)) then + mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + miip(i) = get_two_e_integral(m,i,i,p,mo_integrals_map) + has_mipi(i) = .True. + endif + enddo + do k = 1, elec_beta_num + i = occ(k,2) + if (.not.has_mipi(i)) then + mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + has_mipi(i) = .True. + endif + enddo + + do k = 1, elec_alpha_num + hdouble = hdouble + mipi(occ(k,1)) - miip(occ(k,1)) + enddo + do k = 1, elec_beta_num + hdouble = hdouble + mipi(occ(k,2)) + enddo + + else + ! Single beta + m = exc(1,1,2) + p = exc(1,2,2) + do k = 1, elec_beta_num + i = occ(k,2) + if (.not.has_mipi(i)) then + mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + miip(i) = get_two_e_integral(m,i,i,p,mo_integrals_map) + has_mipi(i) = .True. + endif + enddo + do k = 1, elec_alpha_num + i = occ(k,1) + if (.not.has_mipi(i)) then + mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + has_mipi(i) = .True. + endif + enddo + + do k = 1, elec_alpha_num + hdouble = hdouble + mipi(occ(k,1)) + enddo + do k = 1, elec_beta_num + hdouble = hdouble + mipi(occ(k,2)) - miip(occ(k,2)) + enddo + + endif + hmono = mo_one_e_integrals(m,p) + hij = phase*(hdouble + hmono) + + case (0) + phase = 1.d0 + hij = diag_H_mat_elem(key_i,Nint) + end select +end + + +subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC +! Computes $\langle i|H|Psi \rangle = \sum_J c_J \langle i | H | J \rangle$. +! +! Uses filter_connected_i_H_psi0 to get all the $|J \rangle$ to which $|i \rangle$ +! is connected. +! The i_H_psi_minilist is much faster but requires to build the +! minilists. + END_DOC + integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate + integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) + integer(bit_kind), intent(in) :: key(Nint,2) + double precision, intent(in) :: coef(Ndet_max,Nstate) + double precision, intent(out) :: i_H_psi_array(Nstate) + + integer :: i, ii,j + double precision :: phase + integer :: exc(0:2,2,2) + double precision :: hij + integer, allocatable :: idx(:) + + ASSERT (Nint > 0) + ASSERT (N_int == Nint) + ASSERT (Nstate > 0) + ASSERT (Ndet > 0) + ASSERT (Ndet_max >= Ndet) + allocate(idx(0:Ndet)) + + i_H_psi_array = 0.d0 + + call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) + if (Nstate == 1) then + + do ii=1,idx(0) + i = idx(ii) + !DIR$ FORCEINLINE + call i_H_j(keys(1,1,i),key,Nint,hij) + i_H_psi_array(1) = i_H_psi_array(1) + coef(i,1)*hij + enddo + + else + + do ii=1,idx(0) + i = idx(ii) + !DIR$ FORCEINLINE + call i_H_j(keys(1,1,i),key,Nint,hij) + do j = 1, Nstate + i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij + enddo + enddo + + endif + +end + + +subroutine i_H_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist + integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) + integer(bit_kind), intent(in) :: key(Nint,2) + double precision, intent(in) :: coef(Ndet_max,Nstate) + double precision, intent(out) :: i_H_psi_array(Nstate) + + integer :: i, ii,j, i_in_key, i_in_coef + double precision :: phase + integer :: exc(0:2,2,2) + double precision :: hij + integer, allocatable :: idx(:) + BEGIN_DOC +! Computes $\langle i|H|\Psi \rangle = \sum_J c_J \langle i|H|J\rangle$. +! +! Uses filter_connected_i_H_psi0 to get all the $|J \rangle$ to which $|i \rangle$ +! is connected. The $|J\rangle$ are searched in short pre-computed lists. + END_DOC + + ASSERT (Nint > 0) + ASSERT (N_int == Nint) + ASSERT (Nstate > 0) + ASSERT (Ndet > 0) + ASSERT (Ndet_max >= Ndet) + allocate(idx(0:Ndet)) + i_H_psi_array = 0.d0 + + call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx) + if (Nstate == 1) then + + do ii=1,idx(0) + i_in_key = idx(ii) + i_in_coef = idx_key(idx(ii)) + !DIR$ FORCEINLINE + call i_H_j(keys(1,1,i_in_key),key,Nint,hij) + ! TODO : Cache misses + i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij + enddo + + else + + do ii=1,idx(0) + i_in_key = idx(ii) + i_in_coef = idx_key(idx(ii)) + !DIR$ FORCEINLINE + call i_H_j(keys(1,1,i_in_key),key,Nint,hij) + do j = 1, Nstate + i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij + enddo + enddo + + endif + +end + + + +subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by + ! a single excitation. + END_DOC + integer, intent(in) :: Nint, spin + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + + PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + + call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + call get_single_excitation_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) +end + +subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by + ! a same-spin double excitation. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint) + double precision, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + double precision, external :: get_two_e_integral + + PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) + hij = phase*(get_two_e_integral( & + exc(1,1), & + exc(2,1), & + exc(1,2), & + exc(2,2), mo_integrals_map) - & + get_two_e_integral( & + exc(1,1), & + exc(2,1), & + exc(2,2), & + exc(1,2), mo_integrals_map) ) +end + +subroutine i_H_j_double_alpha_beta_complex(key_i,key_j,Nint,hij) + !todo: modify/implement for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by + ! an opposite-spin double excitation. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij + + integer :: exc(0:2,2,2) + double precision :: phase, phase2 + double precision, external :: get_two_e_integral + + PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + + call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) + call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) + phase = phase*phase2 + if (exc(1,1,1) == exc(1,2,2)) then + hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) == exc(1,1,2)) then + hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_two_e_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif +end diff --git a/src/determinants/spindeterminants.ezfio_config b/src/determinants/spindeterminants.ezfio_config index 39ccb82b..bd4b80ce 100644 --- a/src/determinants/spindeterminants.ezfio_config +++ b/src/determinants/spindeterminants.ezfio_config @@ -10,6 +10,7 @@ spindeterminants psi_coef_matrix_rows integer (spindeterminants_n_det) psi_coef_matrix_columns integer (spindeterminants_n_det) psi_coef_matrix_values double precision (spindeterminants_n_det,spindeterminants_n_states) + psi_coef_matrix_values_complex double precision (2,spindeterminants_n_det,spindeterminants_n_states) n_svd_coefs integer psi_svd_alpha double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states) psi_svd_beta double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states) diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f index 716c81ee..974ec614 100644 --- a/src/determinants/spindeterminants.irp.f +++ b/src/determinants/spindeterminants.irp.f @@ -307,8 +307,12 @@ integer function get_index_in_psi_det_beta_unique(key,Nint) end - subroutine write_spindeterminants + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use bitmasks implicit none integer(8), allocatable :: tmpdet(:,:) @@ -349,8 +353,12 @@ subroutine write_spindeterminants enddo call ezfio_set_spindeterminants_psi_det_beta(psi_det_beta_unique) deallocate(tmpdet) - + + if (is_complex) then + call ezfio_set_spindeterminants_psi_coef_matrix_values_complex(psi_bilinear_matrix_values_complex) + else call ezfio_set_spindeterminants_psi_coef_matrix_values(psi_bilinear_matrix_values) + endif call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_bilinear_matrix_rows) call ezfio_set_spindeterminants_psi_coef_matrix_columns(psi_bilinear_matrix_columns) @@ -370,6 +378,18 @@ end det_alpha_norm = 0.d0 det_beta_norm = 0.d0 + if (is_complex) then + do k=1,N_det + i = psi_bilinear_matrix_rows(k) + j = psi_bilinear_matrix_columns(k) + f = 0.d0 + do l=1,N_states + f += cdabs(psi_bilinear_matrix_values_complex(k,l)*psi_bilinear_matrix_values_complex(k,l)) * state_average_weight(l) + enddo + det_alpha_norm(i) += f + det_beta_norm(j) += f + enddo + else do k=1,N_det i = psi_bilinear_matrix_rows(k) j = psi_bilinear_matrix_columns(k) @@ -380,6 +400,7 @@ end det_alpha_norm(i) += f det_beta_norm(j) += f enddo + endif det_alpha_norm = det_alpha_norm det_beta_norm = det_beta_norm @@ -392,8 +413,35 @@ END_PROVIDER ! ! !==============================================================================! - BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ] -&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows , (N_det) ] +BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ] + use bitmasks + PROVIDE psi_bilinear_matrix_rows + do k=1,N_det + do l=1,N_states + psi_bilinear_matrix_values(k,l) = psi_coef(k,l) + enddo + enddo + do l=1,N_states + call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det) + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_values_complex, (N_det,N_states) ] + use bitmasks + PROVIDE psi_bilinear_matrix_rows + do k=1,N_det + do l=1,N_states + psi_bilinear_matrix_values_complex(k,l) = psi_coef_complex(k,l) + enddo + enddo + do l=1,N_states + call cdset_order(psi_bilinear_matrix_values_complex(1,l),psi_bilinear_matrix_order,N_det) + enddo +END_PROVIDER + + + + BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows , (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns, (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order , (N_det) ] use bitmasks @@ -408,10 +456,13 @@ END_PROVIDER END_DOC integer :: i,j,k, l integer(bit_kind) :: tmp_det(N_int,2) - integer, external :: get_index_in_psi_det_sorted_bit +! integer, external :: get_index_in_psi_det_sorted_bit - - PROVIDE psi_coef_sorted_bit + if (is_complex) then + PROVIDE psi_coef_sorted_bit_complex + else + PROVIDE psi_coef_sorted_bit + endif integer*8, allocatable :: to_sort(:) integer, external :: get_index_in_psi_det_alpha_unique @@ -427,9 +478,6 @@ END_PROVIDER ASSERT (j>0) ASSERT (j<=N_det_beta_unique) - do l=1,N_states - psi_bilinear_matrix_values(k,l) = psi_coef(k,l) - enddo psi_bilinear_matrix_rows(k) = i psi_bilinear_matrix_columns(k) = j to_sort(k) = int(N_det_alpha_unique,8) * int(j-1,8) + int(i,8) @@ -445,11 +493,6 @@ END_PROVIDER !$OMP SINGLE call iset_order(psi_bilinear_matrix_columns,psi_bilinear_matrix_order,N_det) !$OMP END SINGLE - !$OMP DO - do l=1,N_states - call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det) - enddo - !$OMP END DO !$OMP END PARALLEL deallocate(to_sort) ASSERT (minval(psi_bilinear_matrix_rows) == 1) @@ -514,8 +557,71 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns_loc, (N_det_beta_unique+1) END_PROVIDER - BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ] -&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows , (N_det) ] +BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ] + use bitmasks + implicit none + BEGIN_DOC + ! Transpose of :c:data:`psi_bilinear_matrix` + ! + ! $D_\beta^\dagger.C^\dagger.D_\alpha$ + ! + ! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major + ! format. + END_DOC + integer :: i,j,k,l + + PROVIDE psi_bilinear_matrix_transp_rows + + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l) + do l=1,N_states + !$OMP DO + do k=1,N_det + psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l) + enddo + !$OMP ENDDO NOWAIT + enddo + !$OMP END PARALLEL + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l) + do l=1,N_states + call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det) + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_transp_values_complex, (N_det,N_states) ] + use bitmasks + implicit none + BEGIN_DOC + ! Transpose of :c:data:`psi_bilinear_matrix` + ! + ! $D_\beta^\dagger.C^\dagger.D_\alpha$ + ! + ! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major + ! format. + END_DOC + integer :: i,j,k,l + + PROVIDE psi_bilinear_matrix_transp_rows + + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l) + do l=1,N_states + !$OMP DO + do k=1,N_det + psi_bilinear_matrix_transp_values_complex (k,l) = psi_bilinear_matrix_values_complex (k,l) + enddo + !$OMP ENDDO NOWAIT + enddo + !$OMP END PARALLEL + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l) + do l=1,N_states + call cdset_order(psi_bilinear_matrix_transp_values_complex(1,l),psi_bilinear_matrix_transp_order,N_det) + enddo + !$OMP END PARALLEL DO + +END_PROVIDER + + BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows , (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_columns, (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_order , (N_det) ] use bitmasks @@ -530,18 +636,15 @@ END_PROVIDER END_DOC integer :: i,j,k,l - PROVIDE psi_coef_sorted_bit + if (is_complex) then + PROVIDE psi_coef_sorted_bit_complex + else + PROVIDE psi_coef_sorted_bit + endif integer*8, allocatable :: to_sort(:) allocate(to_sort(N_det)) !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l) - do l=1,N_states - !$OMP DO - do k=1,N_det - psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l) - enddo - !$OMP ENDDO NOWAIT - enddo !$OMP DO do k=1,N_det psi_bilinear_matrix_transp_columns(k) = psi_bilinear_matrix_columns(k) @@ -563,11 +666,6 @@ END_PROVIDER call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1) call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det) call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det) - !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l) - do l=1,N_states - call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det) - enddo - !$OMP END PARALLEL DO deallocate(to_sort) ASSERT (minval(psi_bilinear_matrix_transp_columns) == 1) ASSERT (minval(psi_bilinear_matrix_transp_rows) == 1) @@ -641,7 +739,30 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix, (N_det_alpha_unique,N_de enddo END_PROVIDER +BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_complex, (N_det_alpha_unique,N_det_beta_unique,N_states) ] + implicit none + BEGIN_DOC + ! Coefficient matrix if the wave function is expressed in a bilinear form : + ! + ! $D_\alpha^\dagger.C.D_\beta$ + END_DOC + integer :: i,j,k,istate + psi_bilinear_matrix_complex = (0.d0,0.d0) + do k=1,N_det + i = psi_bilinear_matrix_rows(k) + j = psi_bilinear_matrix_columns(k) + do istate=1,N_states + psi_bilinear_matrix_complex(i,j,istate) = psi_bilinear_matrix_values_complex(k,istate) + enddo + enddo +END_PROVIDER + subroutine create_wf_of_psi_bilinear_matrix(truncate) + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use bitmasks implicit none BEGIN_DOC @@ -713,6 +834,11 @@ subroutine create_wf_of_psi_bilinear_matrix(truncate) end subroutine generate_all_alpha_beta_det_products + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif implicit none BEGIN_DOC ! Creates a wave function from all possible $\alpha \times \beta$ determinants @@ -856,6 +982,11 @@ end subroutine copy_psi_bilinear_to_psi(psi, isize) + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif implicit none BEGIN_DOC ! Overwrites :c:data:`psi_det` and :c:data:`psi_coef` with the wave function @@ -1292,6 +1423,11 @@ END_TEMPLATE subroutine wf_of_psi_bilinear_matrix(truncate) + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use bitmasks implicit none BEGIN_DOC diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index ce609411..cf5e0038 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -409,6 +409,7 @@ BEGIN_TEMPLATE SUBST [ X, type ] ; real ;; d ; double precision ;; + cd; complex*16 ;; i ; integer ;; i8; integer*8 ;; i2; integer*2 ;; diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 884c4341..ad07aeb4 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -3,14 +3,14 @@ current: general: - i_h_j_complex - diag_h_mat_elem if is_complex - + check for dependence on psi_det_sorted, clean up providers determinants: (done) connected_to_ref.irp.f (done) create_excitations.irp.f - (****) density_matrix.irp.f + (done?)density_matrix{,_complex}.irp.f + no one_e_dm_dagger_mo_spin_index_complex + need to test for complex (done) determinants_bitmasks.irp.f (****) determinants{_complex}.irp.f mostly done @@ -41,15 +41,24 @@ determinants: (done) psi_cas{,_complex}.irp.f might be able to combine some providers?? (done) psi_energy_mono_elec.irp.f - (****) ref_bitmask.irp.f + (done) ref_bitmask.irp.f (****) s2{,_complex}.irp.f - (****) single_excitations.irp.f + made copies of needed functions for complex + still need to do implementation + (done) single_excitations.irp.f (****) single_excitation_two_e.irp.f (****) slater_rules.irp.f + made copies of needed functions for complex + still need to do implementation (****) slater_rules_wee_mono.irp.f (done) sort_dets_ab.irp.f spindeterminants.ezfio_config - (****) spindeterminants.irp.f + need svd complex? + (done?) spindeterminants.irp.f + separated psi_bilinear_matrix_values from psi_bilinear_matrix_{rows,columns,order} + new provider for psi_bilinear_matrix_values_complex + same for bilinear matrix transp (no conjugate) + done except for specific functions that are commented with todo (****) two_e_density_matrix.irp.pouet (done) utils.irp.f (****) zmq.irp.f From 156be3b1bb89c6ae59f4584f2b325266edd4bb77 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Sun, 23 Feb 2020 16:05:23 -0600 Subject: [PATCH 093/256] minor changes --- src/determinants/spindeterminants.irp.f | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f index 974ec614..028122ec 100644 --- a/src/determinants/spindeterminants.irp.f +++ b/src/determinants/spindeterminants.irp.f @@ -308,7 +308,7 @@ integer function get_index_in_psi_det_beta_unique(key,Nint) end subroutine write_spindeterminants - !todo: modify for complex + !todo: modify for complex (not called anywhere?) if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -568,11 +568,11 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_ ! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major ! format. END_DOC - integer :: i,j,k,l + integer :: k,l PROVIDE psi_bilinear_matrix_transp_rows - !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l) + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l) do l=1,N_states !$OMP DO do k=1,N_det @@ -600,11 +600,11 @@ BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_transp_values_complex, (N_det, ! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major ! format. END_DOC - integer :: i,j,k,l + integer :: k,l PROVIDE psi_bilinear_matrix_transp_rows - !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l) + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l) do l=1,N_states !$OMP DO do k=1,N_det @@ -758,7 +758,7 @@ BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_complex, (N_det_alpha_unique,N_ END_PROVIDER subroutine create_wf_of_psi_bilinear_matrix(truncate) - !todo: modify for complex + !todo: modify for complex (not called anywhere?) if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -834,7 +834,7 @@ subroutine create_wf_of_psi_bilinear_matrix(truncate) end subroutine generate_all_alpha_beta_det_products - !todo: modify for complex + !todo: modify for complex (only used by create_wf_of_psi_bilinear_matrix?) if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -982,7 +982,7 @@ end subroutine copy_psi_bilinear_to_psi(psi, isize) - !todo: modify for complex + !todo: modify for complex (not called anywhere?) if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -1423,7 +1423,7 @@ END_TEMPLATE subroutine wf_of_psi_bilinear_matrix(truncate) - !todo: modify for complex + !todo: modify for complex (not called anywhere?) if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 From 5ee3fc6e43e5fc720f2b06d3142f6b7e7fdeaada Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Sun, 23 Feb 2020 16:23:50 -0600 Subject: [PATCH 094/256] complex determinants --- .../single_excitation_two_e.irp.f | 134 ++++++++++++++++++ src/utils_complex/qp2-pbc-diff.txt | 4 +- 2 files changed, 136 insertions(+), 2 deletions(-) diff --git a/src/determinants/single_excitation_two_e.irp.f b/src/determinants/single_excitation_two_e.irp.f index f150f531..9fb03619 100644 --- a/src/determinants/single_excitation_two_e.irp.f +++ b/src/determinants/single_excitation_two_e.irp.f @@ -133,4 +133,138 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ] END_PROVIDER +subroutine single_excitation_wee_complex(det_1,det_2,h,p,spin,phase,hij) + use bitmasks + implicit none + integer,intent(in) :: h,p,spin + double precision, intent(in) :: phase + integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) + complex*16, intent(out) :: hij + integer(bit_kind) :: differences(N_int,2) + integer(bit_kind) :: hole(N_int,2) + integer(bit_kind) :: partcl(N_int,2) + integer :: occ_hole(N_int*bit_kind_size,2) + integer :: occ_partcl(N_int*bit_kind_size,2) + integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) + integer :: i0,i + do i = 1, N_int + differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) + differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) + hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) + hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) + partcl(i,1) = iand(differences(i,1),det_1(i,1)) + partcl(i,2) = iand(differences(i,2),det_1(i,2)) + enddo + call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) + call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) + hij = fock_wee_closed_shell_complex(h,p) + ! holes :: direct terms + do i0 = 1, n_occ_ab_hole(1) + i = occ_hole(i0,1) + hij -= big_array_coulomb_integrals_complex(i,h,p) ! get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + do i0 = 1, n_occ_ab_hole(2) + i = occ_hole(i0,2) + hij -= big_array_coulomb_integrals_complex(i,h,p) !get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + + ! holes :: exchange terms + do i0 = 1, n_occ_ab_hole(spin) + i = occ_hole(i0,spin) + hij += big_array_exchange_integrals_complex(i,h,p) ! get_mo_two_e_integral_schwartz(h,i,i,p,mo_integrals_map) + enddo + + ! particles :: direct terms + do i0 = 1, n_occ_ab_partcl(1) + i = occ_partcl(i0,1) + hij += big_array_coulomb_integrals_complex(i,h,p)!get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + do i0 = 1, n_occ_ab_partcl(2) + i = occ_partcl(i0,2) + hij += big_array_coulomb_integrals_complex(i,h,p) !get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + + ! particles :: exchange terms + do i0 = 1, n_occ_ab_partcl(spin) + i = occ_partcl(i0,spin) + hij -= big_array_exchange_integrals_complex(i,h,p)!get_mo_two_e_integral_schwartz(h,i,i,p,mo_integrals_map) + enddo + hij = hij * phase + +end + + +BEGIN_PROVIDER [complex*16, fock_wee_closed_shell_complex, (mo_num, mo_num) ] + implicit none + integer :: i0,j0,i,j,k0,k + integer :: n_occ_ab(2) + integer :: occ(N_int*bit_kind_size,2) + integer :: n_occ_ab_virt(2) + integer :: occ_virt(N_int*bit_kind_size,2) + integer(bit_kind) :: key_test(N_int) + integer(bit_kind) :: key_virt(N_int,2) + complex*16 :: accu + + call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int) + do i = 1, N_int + key_virt(i,1) = full_ijkl_bitmask(i) + key_virt(i,2) = full_ijkl_bitmask(i) + key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1)) + key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2)) + enddo + complex*16 :: array_coulomb(mo_num),array_exchange(mo_num) + call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) + ! docc ---> virt single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_wee_closed_shell_complex(i,j) = accu + fock_wee_closed_shell_complex(j,i) = dconjg(accu) + enddo + enddo + + ! virt ---> virt single excitations + do i0 = 1, n_occ_ab_virt(1) + i=occ_virt(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_wee_closed_shell_complex(i,j) = accu + fock_wee_closed_shell_complex(j,i) = dconjg(accu) + enddo + enddo + + ! docc ---> docc single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab(1) + j = occ(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_wee_closed_shell_complex(i,j) = accu + fock_wee_closed_shell_complex(j,i) = dconjg(accu) + enddo + enddo + +END_PROVIDER + diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index ad07aeb4..46667e68 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -24,7 +24,6 @@ determinants: need to modify ocaml for psi_coef_complex_qp_edit? save_wavefunction_specified? qp_edit save? (wrong for real?) (done) energy.irp.f - needs diag_h_mat_elem function to be modified for complex (????) example.irp.f (****) EZFIO.cfg (done) filter_connected.irp.f @@ -46,7 +45,7 @@ determinants: made copies of needed functions for complex still need to do implementation (done) single_excitations.irp.f - (****) single_excitation_two_e.irp.f + (done?)single_excitation_two_e.irp.f (****) slater_rules.irp.f made copies of needed functions for complex still need to do implementation @@ -59,6 +58,7 @@ determinants: new provider for psi_bilinear_matrix_values_complex same for bilinear matrix transp (no conjugate) done except for specific functions that are commented with todo + remaining functions aren't called anywhere, so don't worry about them for now (****) two_e_density_matrix.irp.pouet (done) utils.irp.f (****) zmq.irp.f From 0e31cfee7fa4eb5aaf8df9d751dfcd2a79ab978a Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Sun, 23 Feb 2020 16:40:26 -0600 Subject: [PATCH 095/256] complex slater_rules_wee_mono --- src/determinants/slater_rules_wee_mono.irp.f | 192 +++++++++++++++++++ src/utils_complex/qp2-pbc-diff.txt | 6 +- 2 files changed, 195 insertions(+), 3 deletions(-) diff --git a/src/determinants/slater_rules_wee_mono.irp.f b/src/determinants/slater_rules_wee_mono.irp.f index 3a8c9075..92754104 100644 --- a/src/determinants/slater_rules_wee_mono.irp.f +++ b/src/determinants/slater_rules_wee_mono.irp.f @@ -361,3 +361,195 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij) end select end +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine i_Wee_j_single_complex(key_i,key_j,Nint,spin,hij) + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by a + ! single excitation. + END_DOC + integer, intent(in) :: Nint, spin + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map + + call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + call single_excitation_wee_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) +end + + +subroutine i_H_j_mono_spin_one_e_complex(key_i,key_j,Nint,spin,hij) + !todo: check hole/particle m/p ordering? + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by + ! a single excitation. + END_DOC + integer, intent(in) :: Nint, spin + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + + call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + integer :: m,p + m = exc(1,1) + p = exc(1,2) + hij = phase * mo_one_e_integrals_complex(m,p) +end + +subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij) + !todo: check hole/particle m/p ordering? + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij + + integer :: degree,m,p + double precision :: diag_h_mat_elem_one_e,phase + integer :: exc(0:2,2,2) + call get_excitation_degree(key_i,key_j,degree,Nint) + hij = (0.d0,0.d0) + if(degree>1)then + return + endif + if(degree==0)then + hij = dcmplx(diag_H_mat_elem_one_e(key_i,N_int),0.d0) + else + call get_single_excitation(key_i,key_j,exc,phase,Nint) + if (exc(0,1,1) == 1) then + ! Mono alpha + m = exc(1,1,1) + p = exc(1,2,1) + else + ! Mono beta + m = exc(1,1,2) + p = exc(1,2,2) + endif + hij = phase * mo_one_e_integrals_complex(m,p) + endif + +end + +subroutine i_H_j_two_e_complex(key_i,key_j,Nint,hij) + !todo: check hole/particle m/p ordering? + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + use bitmasks + implicit none + BEGIN_DOC + ! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij + + integer :: exc(0:2,2,2) + integer :: degree + complex*16 :: get_two_e_integral_complex + integer :: m,n,p,q + integer :: i,j,k + integer :: occ(Nint*bit_kind_size,2) + double precision :: diag_H_mat_elem, phase,phase_2 + integer :: n_occ_ab(2) + PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ref_bitmask_two_e_energy + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num) + ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) + + hij = (0.d0,0.d0) + !DIR$ FORCEINLINE + call get_excitation_degree(key_i,key_j,degree,Nint) + integer :: spin + select case (degree) + case (2) + call get_double_excitation(key_i,key_j,exc,phase,Nint) + if (exc(0,1,1) == 1) then + ! Mono alpha, mono beta + if(exc(1,1,1) == exc(1,2,2) )then + hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) ==exc(1,1,2))then + hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_two_e_integral_complex( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) + endif + else if (exc(0,1,1) == 2) then + ! Double alpha + hij = phase*(get_two_e_integral_complex( & + exc(1,1,1), & + exc(2,1,1), & + exc(1,2,1), & + exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & + exc(1,1,1), & + exc(2,1,1), & + exc(2,2,1), & + exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) ) + else if (exc(0,1,2) == 2) then + ! Double beta + hij = phase*(get_two_e_integral_complex( & + exc(1,1,2), & + exc(2,1,2), & + exc(1,2,2), & + exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & + exc(1,1,2), & + exc(2,1,2), & + exc(2,2,2), & + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) ) + endif + case (1) + call get_single_excitation(key_i,key_j,exc,phase,Nint) + !DIR$ FORCEINLINE + call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) + if (exc(0,1,1) == 1) then + ! Mono alpha + m = exc(1,1,1) + p = exc(1,2,1) + spin = 1 + else + ! Mono beta + m = exc(1,1,2) + p = exc(1,2,2) + spin = 2 + endif + call single_excitation_wee_complex(key_i,key_j,p,m,spin,phase,hij) + case (0) + double precision :: diag_wee_mat_elem + hij = dcmplx(diag_wee_mat_elem(key_i,Nint),0.d0) + end select +end diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 46667e68..f2b3ed38 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -8,7 +8,7 @@ general: determinants: (done) connected_to_ref.irp.f (done) create_excitations.irp.f - (done?)density_matrix{,_complex}.irp.f + (done?) density_matrix{,_complex}.irp.f no one_e_dm_dagger_mo_spin_index_complex need to test for complex (done) determinants_bitmasks.irp.f @@ -45,11 +45,11 @@ determinants: made copies of needed functions for complex still need to do implementation (done) single_excitations.irp.f - (done?)single_excitation_two_e.irp.f + (done?) single_excitation_two_e.irp.f (****) slater_rules.irp.f made copies of needed functions for complex still need to do implementation - (****) slater_rules_wee_mono.irp.f + (done?) slater_rules_wee_mono.irp.f (done) sort_dets_ab.irp.f spindeterminants.ezfio_config need svd complex? From 1fc25159a069178215e561faafe5f03508d92682 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 08:12:31 -0600 Subject: [PATCH 096/256] complex slater rules --- src/determinants/slater_rules.irp.f | 142 +++++++++++++++------------- src/utils_complex/qp2-pbc-diff.txt | 2 + 2 files changed, 77 insertions(+), 67 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 7f0ccdbc..4b421ca9 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2305,7 +2305,7 @@ end subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) - !todo: modify/implement for complex + !todo: check hole/particle index ordering for complex if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -2318,17 +2318,18 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - double precision, intent(out) :: hij, s2 + complex*16, intent(out) :: hij + double precision, intent(out) :: s2 integer :: exc(0:2,2,2) integer :: degree - double precision :: get_two_e_integral + complex*16 :: get_two_e_integral_complex integer :: m,n,p,q integer :: i,j,k integer :: occ(Nint*bit_kind_size,2) - double precision :: diag_H_mat_elem, phase + double precision :: diag_h_mat_elem, phase integer :: n_occ_ab(2) - PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals + PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ASSERT (Nint > 0) ASSERT (Nint == N_int) @@ -2337,8 +2338,8 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) - hij = 0.d0 - s2 = 0d0 + hij = (0.d0,0.d0) + s2 = 0.d0 !DIR$ FORCEINLINE call get_excitation_degree(key_i,key_j,degree,Nint) integer :: spin @@ -2351,40 +2352,42 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) s2 = -phase endif if(exc(1,1,1) == exc(1,2,2) )then - hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + !TODO: check indices + hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + !TODO: check indices + hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else - hij = phase*get_two_e_integral( & + hij = phase*get_two_e_integral_complex( & exc(1,1,1), & exc(1,1,2), & exc(1,2,1), & - exc(1,2,2) ,mo_integrals_map) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) endif ! Double alpha else if (exc(0,1,1) == 2) then - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(1,2,1), & - exc(2,2,1) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(2,2,1), & - exc(1,2,1) ,mo_integrals_map) ) + exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) ) ! Double beta else if (exc(0,1,2) == 2) then - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(1,2,2), & - exc(2,2,2) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(2,2,2), & - exc(1,2,2) ,mo_integrals_map) ) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) ) endif case (1) call get_single_excitation(key_i,key_j,exc,phase,Nint) @@ -2401,19 +2404,20 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) p = exc(1,2,2) spin = 2 endif - call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij) + !TODO: check indices + call get_single_excitation_from_fock_complex(key_i,key_j,p,m,spin,phase,hij) case (0) double precision, external :: diag_S_mat_elem s2 = diag_S_mat_elem(key_i,Nint) - hij = diag_H_mat_elem(key_i,Nint) + hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0) end select end subroutine i_H_j_complex(key_i,key_j,Nint,hij) - !todo: modify/implement for complex + !todo: check index ordering for complex if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -2425,17 +2429,17 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - double precision, intent(out) :: hij + complex*16, intent(out) :: hij integer :: exc(0:2,2,2) integer :: degree - double precision :: get_two_e_integral + complex*16 :: get_two_e_integral_complex integer :: m,n,p,q integer :: i,j,k integer :: occ(Nint*bit_kind_size,2) double precision :: diag_H_mat_elem, phase integer :: n_occ_ab(2) - PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals + PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ASSERT (Nint > 0) ASSERT (Nint == N_int) @@ -2445,7 +2449,7 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) - hij = 0.d0 + hij = (0.d0,0.d0) !DIR$ FORCEINLINE call get_excitation_degree(key_i,key_j,degree,Nint) integer :: spin @@ -2455,40 +2459,42 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) if (exc(0,1,1) == 1) then ! Single alpha, single beta if(exc(1,1,1) == exc(1,2,2) )then - hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + !todo: check indices + hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + !todo: check indices + hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else - hij = phase*get_two_e_integral( & - exc(1,1,1), & - exc(1,1,2), & - exc(1,2,1), & - exc(1,2,2) ,mo_integrals_map) + hij = phase*get_two_e_integral_complex( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) endif else if (exc(0,1,1) == 2) then ! Double alpha - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(1,2,1), & - exc(2,2,1) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(2,2,1), & - exc(1,2,1) ,mo_integrals_map) ) + exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) ) else if (exc(0,1,2) == 2) then ! Double beta - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(1,2,2), & - exc(2,2,2) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(2,2,2), & - exc(1,2,2) ,mo_integrals_map) ) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) ) endif case (1) call get_single_excitation(key_i,key_j,exc,phase,Nint) @@ -2505,10 +2511,11 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) p = exc(1,2,2) spin = 2 endif - call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij) + !todo: check indices + call get_single_excitation_from_fock_complex(key_i,key_j,p,m,spin,phase,hij) case (0) - hij = diag_H_mat_elem(key_i,Nint) + hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0) end select end @@ -2517,7 +2524,7 @@ end subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) - !todo: modify/implement for complex + !todo: check index ordering for complex if (is_complex) then print*,irp_here,' not implemented for complex' stop -1 @@ -2529,11 +2536,12 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - double precision, intent(out) :: hij,hmono,hdouble,phase + complex*16, intent(out) :: hij,hmono,hdouble + double precision, intent(out) :: phase integer :: exc(0:2,2,2) integer :: degree - double precision :: get_two_e_integral + complex*16 :: get_two_e_integral_complex integer :: m,n,p,q integer :: i,j,k integer :: occ(Nint*bit_kind_size,2) @@ -2550,9 +2558,9 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) - hij = 0.d0 - hmono = 0.d0 - hdouble = 0.d0 + hij = (0.d0,0.d0) + hmono = (0.d0,0.d0) + hdouble = (0.d0,0.d0) !DIR$ FORCEINLINE call get_excitation_degree(key_i,key_j,degree,Nint) select case (degree) @@ -2560,36 +2568,36 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) call get_double_excitation(key_i,key_j,exc,phase,Nint) if (exc(0,1,1) == 1) then ! Single alpha, single beta - hij = phase*get_two_e_integral( & + hij = phase*get_two_e_integral_complex( & exc(1,1,1), & exc(1,1,2), & exc(1,2,1), & - exc(1,2,2) ,mo_integrals_map) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) else if (exc(0,1,1) == 2) then ! Double alpha - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(1,2,1), & - exc(2,2,1) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,1), & exc(2,1,1), & exc(2,2,1), & - exc(1,2,1) ,mo_integrals_map) ) + exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) ) else if (exc(0,1,2) == 2) then ! Double beta - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(1,2,2), & - exc(2,2,2) ,mo_integrals_map) - & - get_two_e_integral( & + exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1,2), & exc(2,1,2), & exc(2,2,2), & - exc(1,2,2) ,mo_integrals_map) ) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) ) endif case (1) call get_single_excitation(key_i,key_j,exc,phase,Nint) @@ -2603,15 +2611,15 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) do k = 1, elec_alpha_num i = occ(k,1) if (.not.has_mipi(i)) then - mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) - miip(i) = get_two_e_integral(m,i,i,p,mo_integrals_map) + mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2) + miip(i) = get_two_e_integral_complex(m,i,i,p,mo_integrals_map,mo_integrals_map_2) has_mipi(i) = .True. endif enddo do k = 1, elec_beta_num i = occ(k,2) if (.not.has_mipi(i)) then - mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2) has_mipi(i) = .True. endif enddo @@ -2630,15 +2638,15 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) do k = 1, elec_beta_num i = occ(k,2) if (.not.has_mipi(i)) then - mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) - miip(i) = get_two_e_integral(m,i,i,p,mo_integrals_map) + mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2) + miip(i) = get_two_e_integral_complex(m,i,i,p,mo_integrals_map,mo_integrals_map_2) has_mipi(i) = .True. endif enddo do k = 1, elec_alpha_num i = occ(k,1) if (.not.has_mipi(i)) then - mipi(i) = get_two_e_integral(m,i,p,i,mo_integrals_map) + mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2) has_mipi(i) = .True. endif enddo @@ -2651,12 +2659,12 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) enddo endif - hmono = mo_one_e_integrals(m,p) + hmono = mo_one_e_integrals_complex(m,p) hij = phase*(hdouble + hmono) case (0) phase = 1.d0 - hij = diag_H_mat_elem(key_i,Nint) + hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0) end select end diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index f2b3ed38..00891f32 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -49,7 +49,9 @@ determinants: (****) slater_rules.irp.f made copies of needed functions for complex still need to do implementation + check indices for complex (done?) slater_rules_wee_mono.irp.f + check indices for complex (done) sort_dets_ab.irp.f spindeterminants.ezfio_config need svd complex? From 29670d47294d38a598edbfcdeb6c080201a6df61 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 11:19:45 -0600 Subject: [PATCH 097/256] fixed typo --- src/determinants/psi_cas_complex.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/determinants/psi_cas_complex.irp.f b/src/determinants/psi_cas_complex.irp.f index 9e8ded87..ccc0abef 100644 --- a/src/determinants/psi_cas_complex.irp.f +++ b/src/determinants/psi_cas_complex.irp.f @@ -59,7 +59,7 @@ END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_complex, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef,_complex (psi_det_size,n_states) ] +&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef_complex, (psi_det_size,n_states) ] &BEGIN_PROVIDER [ integer, idx_non_cas_complex, (psi_det_size) ] &BEGIN_PROVIDER [ integer, N_det_non_cas_complex ] implicit none From a59f1e9576cb3dfc21caed56f258c15727e15125 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 11:34:07 -0600 Subject: [PATCH 098/256] fixed complex sort template --- src/utils/sort.irp.f | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index cf5e0038..ccde5752 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -382,6 +382,16 @@ BEGIN_TEMPLATE end subroutine insertion_$Xsort_big +SUBST [ X, type ] + ; real ;; + d ; double precision ;; + i ; integer ;; + i8; integer*8 ;; + i2; integer*2 ;; +END_TEMPLATE + +BEGIN_TEMPLATE + subroutine $Xset_order_big(x,iorder,isize) implicit none BEGIN_DOC From 0ba82990ff39ebcaaebd7c5184af8ad4ed04becd Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 11:34:31 -0600 Subject: [PATCH 099/256] fixed wrong index type --- src/mo_two_e_ints/map_integrals_complex.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_complex.irp.f index b4b6215b..67adec82 100644 --- a/src/mo_two_e_ints/map_integrals_complex.irp.f +++ b/src/mo_two_e_ints/map_integrals_complex.irp.f @@ -39,7 +39,7 @@ BEGIN_PROVIDER [ complex*16, mo_integrals_cache_complex, (0_8:128_8*128_8*128_8* do i=mo_integrals_cache_min_8,mo_integrals_cache_max_8 i4 = int(i,4) !DIR$ FORCEINLINE - integral = get_two_e_integral_complex_simple(i,j,k,l,& + integral = get_two_e_integral_complex_simple(i4,j4,k4,l4,& mo_integrals_map,mo_integrals_map_2) ii = l-mo_integrals_cache_min_8 ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8) From 7db223f6f30008be5f8f80db7aa6aab34d5dcbb6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 11:34:52 -0600 Subject: [PATCH 100/256] minor changes --- src/determinants/density_matrix_complex.irp.f | 2 +- src/determinants/determinants_complex.irp.f | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/determinants/density_matrix_complex.irp.f b/src/determinants/density_matrix_complex.irp.f index e6c81d33..18bae7db 100644 --- a/src/determinants/density_matrix_complex.irp.f +++ b/src/determinants/density_matrix_complex.irp.f @@ -106,7 +106,7 @@ END_PROVIDER complex*16, allocatable :: tmp_a(:,:,:), tmp_b(:,:,:) integer :: krow, kcol, lrow, lcol - PROVIDE psi_det + PROVIDE psi_det psi_coef_complex one_e_dm_mo_alpha_complex = (0.d0,0.d0) one_e_dm_mo_beta_complex = (0.d0,0.d0) diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_complex.irp.f index 692bd253..38e4126a 100644 --- a/src/determinants/determinants_complex.irp.f +++ b/src/determinants/determinants_complex.irp.f @@ -15,9 +15,9 @@ BEGIN_PROVIDER [ complex*16, psi_coef_complex, (psi_det_size,N_states) ] character*(64) :: label PROVIDE read_wf N_det mo_label ezfio_filename - psi_coef = (0.d0,0.d0) + psi_coef_complex = (0.d0,0.d0) do i=1,min(N_states,psi_det_size) - psi_coef(i,i) = (1.d0,0.d0) + psi_coef_complex(i,i) = (1.d0,0.d0) enddo if (mpi_master) then From 315ad54dc782d009d50cb0764bf621f79ef47a98 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 13:28:29 -0600 Subject: [PATCH 101/256] separated providers for sorted wfn separate psi_coef_sorted and psi_coef_sorted_bit from linked providers reuse same det_sorted and order for complex --- src/determinants/determinants.irp.f | 75 ++++++++++--- src/determinants/determinants_complex.irp.f | 111 +++++++++++--------- src/determinants/prune_wf.irp.f | 4 - 3 files changed, 117 insertions(+), 73 deletions(-) diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index deb00e39..a159b48e 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -280,7 +280,6 @@ END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ] &BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted, (psi_det_size) ] &BEGIN_PROVIDER [ integer, psi_det_sorted_order, (psi_det_size) ] implicit none @@ -302,9 +301,6 @@ END_PROVIDER psi_det_sorted(j,1,i) = psi_det(j,1,iorder(i)) psi_det_sorted(j,2,i) = psi_det(j,2,iorder(i)) enddo - do k=1,N_states - psi_coef_sorted(i,k) = psi_coef(iorder(i),k) - enddo psi_average_norm_contrib_sorted(i) = -psi_average_norm_contrib_sorted(i) enddo do i=1,N_det @@ -312,29 +308,74 @@ END_PROVIDER enddo psi_det_sorted(:,:,N_det+1:psi_det_size) = 0_bit_kind - psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0 psi_average_norm_contrib_sorted(N_det+1:psi_det_size) = 0.d0 psi_det_sorted_order(N_det+1:psi_det_size) = 0 deallocate(iorder) +END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ] + implicit none + integer :: i,j,k + do i=1,N_det + j=psi_det_sorted_order(i) + do k=1,N_states + psi_coef_sorted(j,k) = psi_coef(i,k) + enddo + enddo + psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0 END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] - implicit none - BEGIN_DOC - ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. - ! They are sorted by determinants interpreted as integers. Useful - ! to accelerate the search of a random determinant in the wave - ! function. - END_DOC +&BEGIN_PROVIDER [ integer, psi_det_sorted_bit_order, (psi_det_size) ] + implicit none + integer :: i,j + integer*8, allocatable :: bit_tmp(:) + integer*8, external :: det_search_key - call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), & - psi_det_sorted_bit, psi_coef_sorted_bit, N_states) + allocate(bit_tmp(N_det)) + do i=1,N_det + psi_det_sorted_bit_order(i) = i + !$DIR FORCEINLINE + bit_tmp(i) = det_search_key(psi_det(1,1,i),N_int) + enddo + call i8sort(bit_tmp,psi_det_sorted_bit_order,N_det) + do i=1,N_det + do j=1,N_int + psi_det_sorted_bit(j,1,i) = psi_det(j,1,psi_det_sorted_bit_order(i)) + psi_det_sorted_bit(j,2,i) = psi_det(j,2,psi_det_sorted_bit_order(i)) + enddo + enddo + deallocate(bit_tmp) END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] + implicit none + integer :: i,k + do i=1,N_det + do k=1,N_states + psi_coef_sorted_bit(i,k) = psi_coef(psi_det_sorted_bit_order(i),k) + enddo + enddo +END_PROVIDER + + +! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ] +!&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] +! implicit none +! BEGIN_DOC +! ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. +! ! They are sorted by determinants interpreted as integers. Useful +! ! to accelerate the search of a random determinant in the wave +! ! function. +! END_DOC +! +! call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), & +! psi_det_sorted_bit, psi_coef_sorted_bit, N_states) +! +!END_PROVIDER + subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st) use bitmasks implicit none @@ -490,7 +531,7 @@ subroutine save_wavefunction_truncated(thr) if (mpi_master) then if (is_complex) then call save_wavefunction_general_complex(N_det_save,min(N_states,N_det_save),& - psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) else call save_wavefunction_general(N_det_save,min(N_states,N_det_save),psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) endif @@ -513,7 +554,7 @@ subroutine save_wavefunction if (mpi_master) then if (is_complex) then call save_wavefunction_general_complex(N_det,N_states,& - psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) else call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) endif diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_complex.irp.f index 38e4126a..b7b13eff 100644 --- a/src/determinants/determinants_complex.irp.f +++ b/src/determinants/determinants_complex.irp.f @@ -70,62 +70,69 @@ END_PROVIDER ! ! !==============================================================================! -!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?) - BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] -&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ] -&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ] - implicit none - BEGIN_DOC - ! Wave function sorted by determinants contribution to the norm (state-averaged) - ! - ! psi_det_sorted_order(i) -> k : index in psi_det - END_DOC - integer :: i,j,k - integer, allocatable :: iorder(:) - allocate ( iorder(N_det) ) - do i=1,N_det - psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i) - iorder(i) = i - enddo - call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det) - do i=1,N_det - do j=1,N_int - psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i)) - psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i)) - enddo - do k=1,N_states - psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k) - enddo - psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i) - enddo - do i=1,N_det - psi_det_sorted_order_complex(iorder(i)) = i - enddo - - psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind - psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) - psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0 - psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0 - - deallocate(iorder) - +BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] + implicit none + integer :: i,j,k + do i=1,N_det + j=psi_det_sorted_order(i) + do k=1,N_states + psi_coef_sorted_complex(j,k) = psi_coef_complex(i,k) + enddo + enddo + psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit_complex, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ] - implicit none - BEGIN_DOC - ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. - ! They are sorted by determinants interpreted as integers. Useful - ! to accelerate the search of a random determinant in the wave - ! function. - END_DOC +!!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?) +! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ] +!&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] +!&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ] +!&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ] +! implicit none +! BEGIN_DOC +! ! Wave function sorted by determinants contribution to the norm (state-averaged) +! ! +! ! psi_det_sorted_order(i) -> k : index in psi_det +! END_DOC +! integer :: i,j,k +! integer, allocatable :: iorder(:) +! allocate ( iorder(N_det) ) +! do i=1,N_det +! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i) +! iorder(i) = i +! enddo +! call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det) +! do i=1,N_det +! do j=1,N_int +! psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i)) +! psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i)) +! enddo +! do k=1,N_states +! psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k) +! enddo +! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i) +! enddo +! do i=1,N_det +! psi_det_sorted_order_complex(iorder(i)) = i +! enddo +! +! psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind +! psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) +! psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0 +! psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0 +! +! deallocate(iorder) +! +!END_PROVIDER - call sort_dets_by_det_search_key_complex(N_det, psi_det, psi_coef_complex, & - size(psi_coef_complex,1), psi_det_sorted_bit_complex, & - psi_coef_sorted_bit_complex, N_states) +BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ] + implicit none + integer :: i,k + do i=1,N_det + do k=1,N_states + psi_coef_sorted_bit_complex(i,k) = psi_coef_complex(psi_det_sorted_bit_order(i),k) + enddo + enddo END_PROVIDER subroutine sort_dets_by_det_search_key_complex(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st) diff --git a/src/determinants/prune_wf.irp.f b/src/determinants/prune_wf.irp.f index 136d4ec1..c3cd8d12 100644 --- a/src/determinants/prune_wf.irp.f +++ b/src/determinants/prune_wf.irp.f @@ -25,11 +25,7 @@ BEGIN_PROVIDER [ logical, pruned, (N_det) ] else ndet_new = max(1,int( dble(N_det) * (1.d0 - pruning) + 0.5d0 )) - if (is_complex) then - thr = psi_average_norm_contrib_sorted_complex(ndet_new) - else thr = psi_average_norm_contrib_sorted(ndet_new) - endif do i=1, N_det pruned(i) = psi_average_norm_contrib(i) < thr enddo From 953cf046168faa1985d4490fcb2087e9f74d908e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 13:38:49 -0600 Subject: [PATCH 102/256] separated psi_coef_min/max from abs_psi_coef_min/max --- src/determinants/determinants.irp.f | 56 ++++++++++++++------- src/determinants/determinants_complex.irp.f | 24 --------- src/utils_complex/qp2-pbc-diff.txt | 7 --- 3 files changed, 39 insertions(+), 48 deletions(-) diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index a159b48e..cccfb34f 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -424,24 +424,46 @@ end BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ] &BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ] -&BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ] -&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ] - implicit none - BEGIN_DOC - ! Max and min values of the coefficients - END_DOC - integer :: i - do i=1,N_states - psi_coef_min(i) = minval(psi_coef(:,i)) - psi_coef_max(i) = maxval(psi_coef(:,i)) - abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) ) - abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) ) - call write_double(6,psi_coef_max(i), 'Max coef') - call write_double(6,psi_coef_min(i), 'Min coef') - call write_double(6,abs_psi_coef_max(i), 'Max abs coef') - call write_double(6,abs_psi_coef_min(i), 'Min abs coef') - enddo + implicit none + BEGIN_DOC + ! Max and min values of the coefficients + END_DOC + integer :: i + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif + do i=1,N_states + psi_coef_min(i) = minval(psi_coef(:,i)) + psi_coef_max(i) = maxval(psi_coef(:,i)) + call write_double(6,psi_coef_max(i), 'Max coef') + call write_double(6,psi_coef_min(i), 'Min coef') + enddo +END_PROVIDER + + BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ] +&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ] + implicit none + BEGIN_DOC + ! Max and min magnitudes of the coefficients + END_DOC + integer :: i + if (is_complex) then + do i=1,N_states + abs_psi_coef_min(i) = minval( cdabs(psi_coef_complex(:,i)) ) + abs_psi_coef_max(i) = maxval( cdabs(psi_coef_complex(:,i)) ) + call write_double(6,abs_psi_coef_max(i), 'Max abs coef') + call write_double(6,abs_psi_coef_min(i), 'Min abs coef') + enddo + else + do i=1,N_states + abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) ) + abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) ) + call write_double(6,abs_psi_coef_max(i), 'Max abs coef') + call write_double(6,abs_psi_coef_min(i), 'Min abs coef') + enddo + endif END_PROVIDER diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_complex.irp.f index b7b13eff..76e4d9fc 100644 --- a/src/determinants/determinants_complex.irp.f +++ b/src/determinants/determinants_complex.irp.f @@ -180,30 +180,6 @@ subroutine sort_dets_by_det_search_key_complex(Ndet, det_in, coef_in, sze, det_o end -! TODO:complex? only keep abs max/min? real max/min? -! BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ] -!&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ] -!&BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ] -!&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ] -! implicit none -! BEGIN_DOC -! ! Max and min values of the coefficients -! END_DOC -! integer :: i -! do i=1,N_states -! psi_coef_min(i) = minval(psi_coef(:,i)) -! psi_coef_max(i) = maxval(psi_coef(:,i)) -! abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) ) -! abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) ) -! call write_double(6,psi_coef_max(i), 'Max coef') -! call write_double(6,psi_coef_min(i), 'Min coef') -! call write_double(6,abs_psi_coef_max(i), 'Max abs coef') -! call write_double(6,abs_psi_coef_min(i), 'Min abs coef') -! enddo -! -!END_PROVIDER - - !==============================================================================! ! ! ! Read/write routines ! diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 00891f32..61726ec2 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -14,13 +14,6 @@ determinants: (done) determinants_bitmasks.irp.f (****) determinants{_complex}.irp.f mostly done - could separate/combine some providers instead of copying - for psi_{det,coef}_sorted: - use same linked provider for psi_average_norm_contrib_sorted - psi_det_sorted_order - psi_det_sorted - different providers for psi_coef{,_complex}_sorted - need to figure out {,abs_}psi_coef_{min,max} need to modify ocaml for psi_coef_complex_qp_edit? save_wavefunction_specified? qp_edit save? (wrong for real?) (done) energy.irp.f From c2e1301f276f1a2fbdc369550f5f8e278b37f823 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 14:43:01 -0600 Subject: [PATCH 103/256] fixed orbital ordering for complex --- src/determinants/slater_rules.irp.f | 30 ++--------------------------- src/utils_complex/qp2-pbc-diff.txt | 4 +++- 2 files changed, 5 insertions(+), 29 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 4b421ca9..ee331295 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -1582,11 +1582,6 @@ end double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2305,11 +2300,6 @@ end subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) - !todo: check hole/particle index ordering for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2352,10 +2342,8 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) s2 = -phase endif if(exc(1,1,1) == exc(1,2,2) )then - !TODO: check indices hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - !TODO: check indices hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else hij = phase*get_two_e_integral_complex( & @@ -2404,8 +2392,7 @@ subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2) p = exc(1,2,2) spin = 2 endif - !TODO: check indices - call get_single_excitation_from_fock_complex(key_i,key_j,p,m,spin,phase,hij) + call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij) case (0) double precision, external :: diag_S_mat_elem @@ -2417,11 +2404,6 @@ end subroutine i_H_j_complex(key_i,key_j,Nint,hij) - !todo: check index ordering for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2459,10 +2441,8 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) if (exc(0,1,1) == 1) then ! Single alpha, single beta if(exc(1,1,1) == exc(1,2,2) )then - !todo: check indices hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - !todo: check indices hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else hij = phase*get_two_e_integral_complex( & @@ -2511,8 +2491,7 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) p = exc(1,2,2) spin = 2 endif - !todo: check indices - call get_single_excitation_from_fock_complex(key_i,key_j,p,m,spin,phase,hij) + call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij) case (0) hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0) @@ -2524,11 +2503,6 @@ end subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) - !todo: check index ordering for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 61726ec2..0146fc16 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -154,7 +154,9 @@ NOTES: _{4,n} = _{8,n} + <(k+1)j|i(l+1)>_{8,n-1} - + indices out of order; needed to switch for complex: + i_h_j_s2 for singles + i_h_j for singles ############################ # utils, ezfio, ... # From 6584bd46db21bdd93567c7166dac78d06b7bec17 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 14:50:06 -0600 Subject: [PATCH 104/256] i_h_psi_complex --- src/determinants/slater_rules.irp.f | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index ee331295..0ce55109 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2644,11 +2644,6 @@ end subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2662,13 +2657,13 @@ subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) integer(bit_kind), intent(in) :: key(Nint,2) - double precision, intent(in) :: coef(Ndet_max,Nstate) - double precision, intent(out) :: i_H_psi_array(Nstate) + complex*16, intent(in) :: coef(Ndet_max,Nstate) + complex*16, intent(out) :: i_H_psi_array(Nstate) integer :: i, ii,j double precision :: phase integer :: exc(0:2,2,2) - double precision :: hij + complex*16 :: hij integer, allocatable :: idx(:) ASSERT (Nint > 0) @@ -2678,15 +2673,15 @@ subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array ASSERT (Ndet_max >= Ndet) allocate(idx(0:Ndet)) - i_H_psi_array = 0.d0 + i_H_psi_array = (0.d0,0.d0) - call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) + call filter_connected_i_h_psi0(keys,key,Nint,Ndet,idx) if (Nstate == 1) then do ii=1,idx(0) i = idx(ii) !DIR$ FORCEINLINE - call i_H_j(keys(1,1,i),key,Nint,hij) + call i_h_j_complex(key,keys(1,1,i),Nint,hij) i_H_psi_array(1) = i_H_psi_array(1) + coef(i,1)*hij enddo @@ -2695,7 +2690,7 @@ subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array do ii=1,idx(0) i = idx(ii) !DIR$ FORCEINLINE - call i_H_j(keys(1,1,i),key,Nint,hij) + call i_h_j_complex(key,keys(1,1,i),Nint,hij) do j = 1, Nstate i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij enddo From 7d55f314a40de8b3a9898ba500ac4089117b0e59 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 14:53:22 -0600 Subject: [PATCH 105/256] i_h_psi_minilist_complex --- src/determinants/slater_rules.irp.f | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 0ce55109..3d274179 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2702,23 +2702,18 @@ end subroutine i_H_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) integer(bit_kind), intent(in) :: key(Nint,2) - double precision, intent(in) :: coef(Ndet_max,Nstate) - double precision, intent(out) :: i_H_psi_array(Nstate) + complex*16, intent(in) :: coef(Ndet_max,Nstate) + complex*16, intent(out) :: i_H_psi_array(Nstate) integer :: i, ii,j, i_in_key, i_in_coef double precision :: phase integer :: exc(0:2,2,2) - double precision :: hij + complex*16 :: hij integer, allocatable :: idx(:) BEGIN_DOC ! Computes $\langle i|H|\Psi \rangle = \sum_J c_J \langle i|H|J\rangle$. @@ -2735,14 +2730,14 @@ subroutine i_H_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,N allocate(idx(0:Ndet)) i_H_psi_array = 0.d0 - call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx) + call filter_connected_i_h_psi0(keys,key,Nint,N_minilist,idx) if (Nstate == 1) then do ii=1,idx(0) i_in_key = idx(ii) i_in_coef = idx_key(idx(ii)) !DIR$ FORCEINLINE - call i_H_j(keys(1,1,i_in_key),key,Nint,hij) + call i_h_j_complex(key,keys(1,1,i_in_key),Nint,hij) ! TODO : Cache misses i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij enddo @@ -2753,7 +2748,7 @@ subroutine i_H_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,N i_in_key = idx(ii) i_in_coef = idx_key(idx(ii)) !DIR$ FORCEINLINE - call i_H_j(keys(1,1,i_in_key),key,Nint,hij) + call i_h_j_complex(key,keys(1,1,i_in_key),Nint,hij) do j = 1, Nstate i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij enddo From a2b662d7956faec4cf2721fabd2c930198988b11 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 14:54:48 -0600 Subject: [PATCH 106/256] i_h_j_single_spin_complex --- src/determinants/slater_rules.irp.f | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 3d274179..246fb061 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2761,11 +2761,6 @@ end subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2774,12 +2769,12 @@ subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) END_DOC integer, intent(in) :: Nint, spin integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - double precision, intent(out) :: hij + complex*16, intent(out) :: hij integer :: exc(0:2,2) double precision :: phase - PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) call get_single_excitation_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) From ed5a9fa40476e3cd0b36f78af6dff90918cf010b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 15:02:05 -0600 Subject: [PATCH 107/256] finished complex slater rules --- src/determinants/slater_rules.irp.f | 38 +++++++++++------------------ 1 file changed, 14 insertions(+), 24 deletions(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 246fb061..be82516a 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2781,11 +2781,6 @@ subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) end subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2794,32 +2789,27 @@ subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij) END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint) - double precision, intent(out) :: hij + complex*16, intent(out) :: hij integer :: exc(0:2,2) double precision :: phase - double precision, external :: get_two_e_integral + complex*16, external :: get_two_e_integral_complex - PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) - hij = phase*(get_two_e_integral( & + hij = phase*(get_two_e_integral_complex( & exc(1,1), & exc(2,1), & exc(1,2), & - exc(2,2), mo_integrals_map) - & - get_two_e_integral( & + exc(2,2), mo_integrals_map,mo_integrals_map_2) - & + get_two_e_integral_complex( & exc(1,1), & exc(2,1), & exc(2,2), & - exc(1,2), mo_integrals_map) ) + exc(1,2), mo_integrals_map,mo_integrals_map_2) ) end subroutine i_H_j_double_alpha_beta_complex(key_i,key_j,Nint,hij) - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -2828,26 +2818,26 @@ subroutine i_H_j_double_alpha_beta_complex(key_i,key_j,Nint,hij) END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - double precision, intent(out) :: hij + complex*16, intent(out) :: hij integer :: exc(0:2,2,2) double precision :: phase, phase2 - double precision, external :: get_two_e_integral + complex*16, external :: get_two_e_integral_complex - PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) phase = phase*phase2 if (exc(1,1,1) == exc(1,2,2)) then - hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) == exc(1,1,2)) then - hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else - hij = phase*get_two_e_integral( & + hij = phase*get_two_e_integral_complex( & exc(1,1,1), & exc(1,1,2), & exc(1,2,1), & - exc(1,2,2) ,mo_integrals_map) + exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) endif end From dffd10375b2396552da3f2cb1ba73a375acf02d4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 15:11:13 -0600 Subject: [PATCH 108/256] wee complex slater rules --- src/determinants/slater_rules_wee_mono.irp.f | 19 ++----------------- src/utils_complex/qp2-pbc-diff.txt | 6 ++---- 2 files changed, 4 insertions(+), 21 deletions(-) diff --git a/src/determinants/slater_rules_wee_mono.irp.f b/src/determinants/slater_rules_wee_mono.irp.f index 92754104..50ec4f79 100644 --- a/src/determinants/slater_rules_wee_mono.irp.f +++ b/src/determinants/slater_rules_wee_mono.irp.f @@ -389,11 +389,6 @@ end subroutine i_H_j_mono_spin_one_e_complex(key_i,key_j,Nint,spin,hij) - !todo: check hole/particle m/p ordering? - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -415,11 +410,6 @@ subroutine i_H_j_mono_spin_one_e_complex(key_i,key_j,Nint,spin,hij) end subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij) - !todo: check hole/particle m/p ordering? - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -438,7 +428,7 @@ subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij) return endif if(degree==0)then - hij = dcmplx(diag_H_mat_elem_one_e(key_i,N_int),0.d0) + hij = dcmplx(diag_h_mat_elem_one_e(key_i,N_int),0.d0) else call get_single_excitation(key_i,key_j,exc,phase,Nint) if (exc(0,1,1) == 1) then @@ -456,11 +446,6 @@ subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij) end subroutine i_H_j_two_e_complex(key_i,key_j,Nint,hij) - !todo: check hole/particle m/p ordering? - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif use bitmasks implicit none BEGIN_DOC @@ -547,7 +532,7 @@ subroutine i_H_j_two_e_complex(key_i,key_j,Nint,hij) p = exc(1,2,2) spin = 2 endif - call single_excitation_wee_complex(key_i,key_j,p,m,spin,phase,hij) + call single_excitation_wee_complex(key_i,key_j,m,p,spin,phase,hij) case (0) double precision :: diag_wee_mat_elem hij = dcmplx(diag_wee_mat_elem(key_i,Nint),0.d0) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 0146fc16..0034c4ac 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -39,10 +39,7 @@ determinants: still need to do implementation (done) single_excitations.irp.f (done?) single_excitation_two_e.irp.f - (****) slater_rules.irp.f - made copies of needed functions for complex - still need to do implementation - check indices for complex + (done?) slater_rules.irp.f (done?) slater_rules_wee_mono.irp.f check indices for complex (done) sort_dets_ab.irp.f @@ -157,6 +154,7 @@ NOTES: indices out of order; needed to switch for complex: i_h_j_s2 for singles i_h_j for singles + i_h_j_two_e for singles ############################ # utils, ezfio, ... # From 3982ee447968a778ab512fbfe22094247408ebd7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 15:57:20 -0600 Subject: [PATCH 109/256] s2 complex --- src/determinants/s2_complex.irp.f | 341 ++++++++++++++--------------- src/utils_complex/qp2-pbc-diff.txt | 6 +- 2 files changed, 169 insertions(+), 178 deletions(-) diff --git a/src/determinants/s2_complex.irp.f b/src/determinants/s2_complex.irp.f index e2116db8..4db82f14 100644 --- a/src/determinants/s2_complex.irp.f +++ b/src/determinants/s2_complex.irp.f @@ -1,179 +1,171 @@ subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) - !todo: modify/implement for complex - print*,irp_here,' not implemented for complex' - stop -1 -! use bitmasks -! implicit none -! BEGIN_DOC -! ! Computes e_0 = / -! ! -! ! n : number of determinants -! ! -! END_DOC -! integer, intent(in) :: n,Nint, N_st, sze_8 -! double precision, intent(out) :: e_0(N_st) -! double precision, intent(in) :: u_0(sze_8,N_st) -! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) -! -! double precision, allocatable :: v_0(:,:) -! double precision :: u_dot_u,u_dot_v -! integer :: i,j -! allocate (v_0(sze_8,N_st)) -! -! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) -! do i=1,N_st -! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) + S_z2_Sz -! enddo + use bitmasks + implicit none + BEGIN_DOC + ! Computes e_0 = / + ! + ! n : number of determinants + ! + END_DOC + integer, intent(in) :: n,Nint, N_st, sze_8 + double precision, intent(out) :: e_0(N_st) + complex*16, intent(in) :: u_0(sze_8,N_st) + integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) + + complex*16, allocatable :: v_0(:,:) + double precision :: u_dot_u_complex + complex*16 :: u_dot_v_complex + integer :: i,j + allocate (v_0(sze_8,N_st)) + + call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) + do i=1,N_st + e_0(i) = dble(u_dot_v_complex(u_0(1,i),v_0(1,i),n))/u_dot_u_complex(u_0(1,i),n) + S_z2_Sz + enddo end subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint) - !todo: modify/implement for complex - print*,irp_here,' not implemented for complex' - stop -1 -! use bitmasks -! implicit none -! BEGIN_DOC -! ! Computes v_0 = S^2|u_0> -! ! -! ! n : number of determinants -! ! -! END_DOC -! integer, intent(in) :: n,Nint -! double precision, intent(out) :: v_0(n) -! double precision, intent(in) :: u_0(n) -! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) -! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,1,n) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_0 = S^2|u_0> + ! + ! n : number of determinants + ! + END_DOC + integer, intent(in) :: n,Nint + complex*16, intent(out) :: v_0(n) + complex*16, intent(in) :: u_0(n) + integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) + call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,1,n) end subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) - !todo: modify/implement for complex - print*,irp_here,' not implemented for complex' - stop -1 -! use bitmasks -! implicit none -! BEGIN_DOC -! ! Computes v_0 = S^2|u_0> -! ! -! ! n : number of determinants -! ! -! END_DOC -! integer, intent(in) :: N_st,n,Nint, sze_8 -! double precision, intent(out) :: v_0(sze_8,N_st) -! double precision, intent(in) :: u_0(sze_8,N_st) -! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) -! double precision :: s2_tmp -! double precision, allocatable :: vt(:,:) -! integer :: i,j,k,l, jj,ii -! integer :: i0, j0 -! -! integer, allocatable :: shortcut(:,:), sort_idx(:,:) -! integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) -! integer(bit_kind) :: sorted_i(Nint) -! -! integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate -! -! -! ASSERT (Nint > 0) -! ASSERT (Nint == N_int) -! ASSERT (n>0) -! PROVIDE ref_bitmask_energy -! -! allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) -! v_0 = 0.d0 -! -! call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) -! call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) -! -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& -! !$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8) -! allocate(vt(sze_8,N_st)) -! vt = 0.d0 -! -! do sh=1,shortcut(0,1) -! !$OMP DO SCHEDULE(static,1) -! do sh2=sh,shortcut(0,1) -! exa = 0 -! do ni=1,Nint -! exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) -! end do -! if(exa > 2) then -! cycle -! end if -! -! do i=shortcut(sh,1),shortcut(sh+1,1)-1 -! org_i = sort_idx(i,1) -! if(sh==sh2) then -! endi = i-1 -! else -! endi = shortcut(sh2+1,1)-1 -! end if -! do ni=1,Nint -! sorted_i(ni) = sorted(ni,i,1) -! enddo -! -! do j=shortcut(sh2,1),endi -! org_j = sort_idx(j,1) -! ext = exa -! do ni=1,Nint -! ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) -! end do -! if(ext <= 4) then -! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) -! do istate=1,N_st -! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) -! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) -! enddo -! endif -! enddo -! enddo -! enddo -! !$OMP END DO NOWAIT -! enddo -! -! do sh=1,shortcut(0,2) -! !$OMP DO -! do i=shortcut(sh,2),shortcut(sh+1,2)-1 -! org_i = sort_idx(i,2) -! do j=shortcut(sh,2),i-1 -! org_j = sort_idx(j,2) -! ext = 0 -! do ni=1,Nint -! ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) -! end do -! if(ext == 4) then -! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) -! do istate=1,N_st -! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) -! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) -! enddo -! end if -! end do -! end do -! !$OMP END DO NOWAIT -! enddo -! !$OMP BARRIER -! -! do istate=1,N_st -! do i=n,1,-1 -! !$OMP ATOMIC -! v_0(i,istate) = v_0(i,istate) + vt(i,istate) -! enddo -! enddo -! -! deallocate(vt) -! !$OMP END PARALLEL -! -! do i=1,n -! call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp) -! do istate=1,N_st -! v_0(i,istate) += s2_tmp * u_0(i,istate) -! enddo -! enddo -! -! deallocate (shortcut, sort_idx, sorted, version) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_0 = S^2|u_0> + ! + ! n : number of determinants + ! + END_DOC + integer, intent(in) :: N_st,n,Nint, sze_8 + complex*16, intent(out) :: v_0(sze_8,N_st) + complex*16, intent(in) :: u_0(sze_8,N_st) + integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) + double precision :: s2_tmp + complex*16, allocatable :: vt(:,:) + integer :: i,j,k,l, jj,ii + integer :: i0, j0 + + integer, allocatable :: shortcut(:,:), sort_idx(:,:) + integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) + integer(bit_kind) :: sorted_i(Nint) + + integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate + + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (n>0) + PROVIDE ref_bitmask_energy + + allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) + v_0 = (0.d0,0.d0) + + call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) + call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& + !$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8) + allocate(vt(sze_8,N_st)) + vt = (0.d0,0.d0) + + do sh=1,shortcut(0,1) + !$OMP DO SCHEDULE(static,1) + do sh2=sh,shortcut(0,1) + exa = 0 + do ni=1,Nint + exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) + end do + if(exa > 2) then + cycle + end if + + do i=shortcut(sh,1),shortcut(sh+1,1)-1 + org_i = sort_idx(i,1) + if(sh==sh2) then + endi = i-1 + else + endi = shortcut(sh2+1,1)-1 + end if + do ni=1,Nint + sorted_i(ni) = sorted(ni,i,1) + enddo + + do j=shortcut(sh2,1),endi + org_j = sort_idx(j,1) + ext = exa + do ni=1,Nint + ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + end do + if(ext <= 4) then + call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) + do istate=1,N_st + vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) + vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) + enddo + endif + enddo + enddo + enddo + !$OMP END DO NOWAIT + enddo + + do sh=1,shortcut(0,2) + !$OMP DO + do i=shortcut(sh,2),shortcut(sh+1,2)-1 + org_i = sort_idx(i,2) + do j=shortcut(sh,2),i-1 + org_j = sort_idx(j,2) + ext = 0 + do ni=1,Nint + ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) + end do + if(ext == 4) then + call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) + do istate=1,N_st + vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) + vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) + enddo + end if + end do + end do + !$OMP END DO NOWAIT + enddo + !$OMP BARRIER + + do istate=1,N_st + do i=n,1,-1 + !$OMP ATOMIC + v_0(i,istate) = v_0(i,istate) + vt(i,istate) + enddo + enddo + + deallocate(vt) + !$OMP END PARALLEL + + do i=1,n + call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp) + do istate=1,N_st + v_0(i,istate) += s2_tmp * u_0(i,istate) + enddo + enddo + + deallocate (shortcut, sort_idx, sorted, version) end @@ -190,19 +182,20 @@ subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_key ! use bitmasks ! integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates ! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys) -! double precision, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates) -! double precision, intent(out) :: s2(nstates,nstates) -! double precision :: s2_tmp,accu +! complex*16, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates) +! complex*16, intent(out) :: s2(nstates,nstates) +! double precision :: s2_tmp +! complex*16 :: accu ! integer :: i,j,l,jj,ll,kk ! integer, allocatable :: idx(:) ! BEGIN_DOC ! ! returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states ! ! psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j) ! END_DOC -! s2 = 0.d0 +! s2 = (0.d0,0.d0) ! do ll = 1, nstates ! do jj = 1, nstates -! accu = 0.d0 +! accu = (0.d0,0.d0) ! !$OMP PARALLEL DEFAULT(NONE) & ! !$OMP PRIVATE (i,j,kk,idx,s2_tmp) & ! !$OMP SHARED (ll,jj,psi_keys_tmp,psi_coefs_tmp,N_int,n,nstates)& @@ -211,12 +204,12 @@ subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_key ! !$OMP DO SCHEDULE(dynamic) ! do i = n,1,-1 ! Better OMP scheduling ! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),N_int,s2_tmp) -! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(i,jj) +! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(i,jj) ! call filter_connected(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx) ! do kk=1,idx(0) ! j = idx(kk) ! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),N_int,s2_tmp) -! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll) +! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll) ! enddo ! enddo ! !$OMP END DO diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 0034c4ac..abec037c 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -34,14 +34,12 @@ determinants: might be able to combine some providers?? (done) psi_energy_mono_elec.irp.f (done) ref_bitmask.irp.f - (****) s2{,_complex}.irp.f - made copies of needed functions for complex - still need to do implementation + (done?) s2{,_complex}.irp.f + remaining functions not needed? (done) single_excitations.irp.f (done?) single_excitation_two_e.irp.f (done?) slater_rules.irp.f (done?) slater_rules_wee_mono.irp.f - check indices for complex (done) sort_dets_ab.irp.f spindeterminants.ezfio_config need svd complex? From 338e793ed6f5fe908f36b11d0d53e53426081ab0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 16:36:56 -0600 Subject: [PATCH 110/256] complex zmq determinants --- src/determinants/zmq.irp.f | 125 +++++++++++++++++++++++++++- src/mpi/mpi.irp.f | 1 + src/utils_complex/qp2-pbc-diff.txt | 6 +- src/zmq/put_get.irp.f | 128 +++++++++++++++++++++++++++++ 4 files changed, 255 insertions(+), 5 deletions(-) diff --git a/src/determinants/zmq.irp.f b/src/determinants/zmq.irp.f index 5a114533..ee8165da 100644 --- a/src/determinants/zmq.irp.f +++ b/src/determinants/zmq.irp.f @@ -13,6 +13,7 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id) integer, external :: zmq_put_psi_det_size integer*8, external :: zmq_put_psi_det integer*8, external :: zmq_put_psi_coef + integer*8, external :: zmq_put_psi_coef_complex zmq_put_psi = 0 if (zmq_put_N_states(zmq_to_qp_run_socket, worker_id) == -1) then @@ -31,11 +32,17 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id) zmq_put_psi = -1 return endif + if (is_complex) then + if (zmq_put_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1) then + zmq_put_psi = -1 + return + endif + else if (zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id) == -1) then zmq_put_psi = -1 return endif - + endif end @@ -54,6 +61,7 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id) integer, external :: zmq_get_psi_det_size integer*8, external :: zmq_get_psi_det integer*8, external :: zmq_get_psi_coef + integer*8, external :: zmq_get_psi_coef_complex zmq_get_psi_notouch = 0 @@ -75,19 +83,35 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id) allocate(psi_det(N_int,2,psi_det_size)) endif + if (is_complex) then + !todo: check this + if (size(psi_coef_complex,kind=8) /= psi_det_size*N_states) then + deallocate(psi_coef_complex) + allocate(psi_coef_complex(psi_det_size,N_states)) + endif + else if (size(psi_coef,kind=8) /= psi_det_size*N_states) then deallocate(psi_coef) allocate(psi_coef(psi_det_size,N_states)) endif + endif if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then zmq_get_psi_notouch = -1 return endif + + if (is_complex) then + if (zmq_get_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then + zmq_get_psi_notouch = -1 + return + endif + else if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then zmq_get_psi_notouch = -1 return endif + endif end @@ -102,8 +126,11 @@ integer function zmq_get_psi(zmq_to_qp_run_socket, worker_id) integer, intent(in) :: worker_id integer, external :: zmq_get_psi_notouch zmq_get_psi = zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id) + if (is_complex) then + SOFT_TOUCH psi_det psi_coef_complex psi_det_size N_det N_states + else SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states - + endif end @@ -146,12 +173,20 @@ integer function zmq_put_psi_bilinear(zmq_to_qp_run_socket,worker_id) zmq_put_psi_bilinear = -1 return endif - + + if (is_complex) then + integer*8, external :: zmq_put_psi_bilinear_matrix_values_complex + if (zmq_put_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1) then + zmq_put_psi_bilinear = -1 + return + endif + else integer*8, external :: zmq_put_psi_bilinear_matrix_values if (zmq_put_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1) then zmq_put_psi_bilinear = -1 return endif + endif integer, external :: zmq_put_N_det_alpha_unique if (zmq_put_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then @@ -197,10 +232,17 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id) zmq_get_psi_bilinear= 0 + if (is_complex) then + if (size(psi_bilinear_matrix_values_complex,kind=8) /= N_det*N_states) then + deallocate(psi_bilinear_matrix_values_complex) + allocate(psi_bilinear_matrix_values_complex(N_det,N_states)) + endif + else if (size(psi_bilinear_matrix_values,kind=8) /= N_det*N_states) then deallocate(psi_bilinear_matrix_values) allocate(psi_bilinear_matrix_values(N_det,N_states)) endif + endif if (size(psi_bilinear_matrix_rows,kind=8) /= N_det) then deallocate(psi_bilinear_matrix_rows) @@ -216,12 +258,20 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id) deallocate(psi_bilinear_matrix_order) allocate(psi_bilinear_matrix_order(N_det)) endif - + + if (is_complex) then + integer*8, external :: zmq_get_psi_bilinear_matrix_values_complex + if (zmq_get_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then + zmq_get_psi_bilinear = -1 + return + endif + else integer*8, external :: zmq_get_psi_bilinear_matrix_values if (zmq_get_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1_8) then zmq_get_psi_bilinear = -1 return endif + endif integer*8, external :: zmq_get_psi_bilinear_matrix_rows if (zmq_get_psi_bilinear_matrix_rows(zmq_to_qp_run_socket, worker_id) == -1_8) then @@ -266,7 +316,11 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id) return endif + if (is_complex) then + SOFT_TOUCH psi_bilinear_matrix_values_complex psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef_complex psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique + else SOFT_TOUCH psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique + endif end @@ -563,6 +617,69 @@ psi_bilinear_matrix_values ;; END_TEMPLATE +BEGIN_TEMPLATE + +integer*8 function zmq_put_$X(zmq_to_qp_run_socket,worker_id) + use f77_zmq + implicit none + BEGIN_DOC +! Put $X on the qp_run scheduler + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id + integer*8 :: rc8 + character*(256) :: msg + + zmq_put_$X = 0 + + integer*8 :: zmq_put_cdmatrix + integer :: ni, nj + + if (size($X,kind=8) <= 8388608_8) then + ni = size($X,kind=4) + nj = 1 + else + ni = 8388608 + nj = int(size($X,kind=8)/8388608_8,4) + 1 + endif + rc8 = zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) ) + zmq_put_$X = rc8 +end + +integer*8 function zmq_get_$X(zmq_to_qp_run_socket,worker_id) + use f77_zmq + implicit none + BEGIN_DOC +! get $X on the qp_run scheduler + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id + integer*8 :: rc8 + character*(256) :: msg + + zmq_get_$X = 0_8 + + integer*8 :: zmq_get_cdmatrix + integer :: ni, nj + + if (size($X,kind=8) <= 8388608_8) then + ni = size($X,kind=4) + nj = 1 + else + ni = 8388608 + nj = int(size($X,kind=8)/8388608_8,4) + 1 + endif + rc8 = zmq_get_cdmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) ) + zmq_get_$X = rc8 +end + +SUBST [ X ] + +psi_coef_complex ;; +psi_bilinear_matrix_values_complex ;; + +END_TEMPLATE + !--------------------------------------------------------------------------- diff --git a/src/mpi/mpi.irp.f b/src/mpi/mpi.irp.f index d947f1b9..41f303ea 100644 --- a/src/mpi/mpi.irp.f +++ b/src/mpi/mpi.irp.f @@ -93,6 +93,7 @@ SUBST [ double, type, 8, DOUBLE_PRECISION ] double ; double precision ; 8 ; DOUBLE_PRECISION ;; integer ; integer ; 4 ; INTEGER ;; integer8 ; integer*8 ; 8 ; INTEGER8 ;; +complex_double ; complex*16 ; 16 ; DOUBLE_COMPLEX ;; END_TEMPLATE diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index abec037c..cbe87d05 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -51,7 +51,11 @@ determinants: remaining functions aren't called anywhere, so don't worry about them for now (****) two_e_density_matrix.irp.pouet (done) utils.irp.f - (****) zmq.irp.f + (done?) zmq.irp.f + make sure template is correct for put/get psi_coef_complex + (why is limit 2^23? is this specific for doubles? should we divide by 2 for complex*16?) + also depends on zmq_{put,get}_cdmatrix in zmq/put_get.irp.f + and broadcast_chunks_complex_double in mpi/mpi.irp.f ------------------------------------------------------------------------------------- diff --git a/src/zmq/put_get.irp.f b/src/zmq/put_get.irp.f index fce8722d..3985721d 100644 --- a/src/zmq/put_get.irp.f +++ b/src/zmq/put_get.irp.f @@ -443,6 +443,134 @@ integer function zmq_get_dmatrix(zmq_to_qp_run_socket, worker_id, name, x, size_ end +integer function zmq_put_cdmatrix(zmq_to_qp_run_socket, worker_id, name, x, size_x1, size_x2, sze) + use f77_zmq + implicit none + BEGIN_DOC +! Put a complex vector on the qp_run scheduler + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id + character*(*) :: name + integer, intent(in) :: size_x1, size_x2 + integer*8, intent(in) :: sze + complex*16, intent(in) :: x(size_x1, size_x2) + integer*8 :: rc, ni + integer :: j + character*(256) :: msg + + zmq_put_cdmatrix = 0 + + ni = size_x1 + do j=1,size_x2 + if (j == size_x2) then + ni = int(sze - int(j-1,8)*int(size_x1,8),8) + endif + write(msg,'(A,1X,I8,1X,A,I8.8)') 'put_data '//trim(zmq_state), worker_id, trim(name), j + rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE) + if (rc /= len(trim(msg))) then + print *, trim(msg) + zmq_put_cdmatrix = -1 + print *, 'Failed in put_data', rc, j + return + endif + + rc = f77_zmq_send8(zmq_to_qp_run_socket,x(1,j),ni*8_8*2,0) + if (rc /= ni*8_8*2) then + print *, 'Failed in send ', rc, j + zmq_put_cdmatrix = -1 + return + endif + + rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) + if (msg(1:rc) /= 'put_data_reply ok') then + print *, trim(msg) + print *, 'Failed in recv ', rc, j + zmq_put_cdmatrix = -1 + return + endif + enddo + +end + + +integer function zmq_get_cdmatrix(zmq_to_qp_run_socket, worker_id, name, x, size_x1, size_x2, sze) + use f77_zmq + implicit none + BEGIN_DOC +! Get a float vector from the qp_run scheduler + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id + integer, intent(in) :: size_x1, size_x2 + integer*8, intent(in) :: sze + character*(*), intent(in) :: name + complex*16, intent(out) :: x(size_x1,size_x2) + integer*8 :: rc, ni + integer*8 :: j + character*(256) :: msg + + PROVIDE zmq_state + ! Success + zmq_get_cdmatrix = 0 + + if (mpi_master) then + ni = size_x1 + do j=1, size_x2 + if (j == size_x2) then + ni = sze - (j-1)*size_x1 + endif + write(msg,'(A,1X,I8,1X,A,I8.8)') 'get_data '//trim(zmq_state), worker_id, trim(name),j + rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) + if (rc /= len(trim(msg))) then + print *, trim(msg) + zmq_get_cdmatrix = -1 + print *, irp_here, 'rc /= len(trim(msg))' + print *, irp_here, ' received : ', rc + print *, irp_here, ' expected : ', len(trim(msg)) + go to 10 + endif + + rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) + if (msg(1:14) /= 'get_data_reply') then + print *, irp_here, 'msg(1:14) /= get_data_reply' + print *, trim(msg) + zmq_get_cdmatrix = -1 + go to 10 + endif + + rc = f77_zmq_recv8(zmq_to_qp_run_socket,x(1,j),ni*8_8*2,0) + if (rc /= ni*8_8*2) then + print *, irp_here, 'rc /= size_x1*8*2 : ', trim(name) + print *, irp_here, ' received: ', rc + print *, irp_here, ' expected: ', ni*8_8*2 + zmq_get_cdmatrix = -1 + go to 10 + endif + enddo + endif + + 10 continue + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + integer :: ierr + include 'mpif.h' + call MPI_BCAST (zmq_get_cdmatrix, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast zmq_get_cdmatrix' + stop -1 + endif + call MPI_BARRIER(MPI_COMM_WORLD,ierr) + call broadcast_chunks_complex_double(x, sze) + IRP_ENDIF + +end + + integer function zmq_put8_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x) use f77_zmq From 01d6d5acbcfb5429411e56108aa9ab18949ec3a4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 18:12:30 -0600 Subject: [PATCH 111/256] complex nos --- src/determinants/density_matrix.irp.f | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 4cc20cc1..e645c390 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -248,11 +248,6 @@ BEGIN_PROVIDER [ double precision, one_e_spin_density_mo, (mo_num,mo_num) ] END_PROVIDER subroutine set_natural_mos - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif implicit none BEGIN_DOC ! Set natural orbitals, obtained by diagonalization of the one-body density matrix @@ -263,6 +258,20 @@ subroutine set_natural_mos label = "Natural" integer :: i,j,iorb,jorb + if (is_complex) then + do i = 1, n_virt_orb + iorb = list_virt(i) + do j = 1, n_core_inact_act_orb + jorb = list_core_inact_act(j) + if(cdabs(one_e_dm_mo_complex(iorb,jorb)).ne. 0.d0)then + print*,'AHAHAH' + print*,iorb,jorb,one_e_dm_mo_complex(iorb,jorb) + stop + endif + enddo + enddo + call mo_as_svd_vectors_of_mo_matrix_eig_complex(one_e_dm_mo_complex,size(one_e_dm_mo_complex,1),mo_num,mo_num,mo_occ,label) + else do i = 1, n_virt_orb iorb = list_virt(i) do j = 1, n_core_inact_act_orb @@ -275,15 +284,11 @@ subroutine set_natural_mos enddo enddo call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label) + endif soft_touch mo_occ end subroutine save_natural_mos - !todo: modify/implement for complex - if (is_complex) then - print*,irp_here,' not implemented for complex' - stop -1 - endif implicit none BEGIN_DOC ! Save natural orbitals, obtained by diagonalization of the one-body density matrix in From f7a7ba2a3e2920062b0e64e24e376714a156cc36 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 09:11:16 -0600 Subject: [PATCH 112/256] started complex h_apply --- src/determinants/h_apply.irp.f | 140 ++++++++++++++++++++-- src/determinants/h_apply_nozmq.template.f | 5 +- src/determinants/occ_pattern.irp.f | 4 +- src/generators_full/generators.irp.f | 41 ++++++- src/utils_complex/qp2-pbc-diff.txt | 5 + 5 files changed, 180 insertions(+), 15 deletions(-) diff --git a/src/determinants/h_apply.irp.f b/src/determinants/h_apply.irp.f index 1c79bc75..cfbbf847 100644 --- a/src/determinants/h_apply.irp.f +++ b/src/determinants/h_apply.irp.f @@ -6,6 +6,7 @@ type H_apply_buffer_type integer :: sze integer(bit_kind), pointer :: det(:,:,:) double precision , pointer :: coef(:,:) + complex*16 , pointer :: coef_complex(:,:) double precision , pointer :: e2(:,:) end type H_apply_buffer_type @@ -32,11 +33,16 @@ type(H_apply_buffer_type), pointer :: H_apply_buffer(:) H_apply_buffer(iproc)%sze = sze allocate ( & H_apply_buffer(iproc)%det(N_int,2,sze), & - H_apply_buffer(iproc)%coef(sze,N_states), & H_apply_buffer(iproc)%e2(sze,N_states) & ) + if (is_complex) then + allocate(H_apply_buffer(iproc)%coef_complex(sze,N_states)) + H_apply_buffer(iproc)%coef_complex = (0.d0,0.d0) + else + allocate(H_apply_buffer(iproc)%coef(sze,N_states)) + H_apply_buffer(iproc)%coef = 0.d0 + endif H_apply_buffer(iproc)%det = 0_bit_kind - H_apply_buffer(iproc)%coef = 0.d0 H_apply_buffer(iproc)%e2 = 0.d0 call omp_init_lock(H_apply_buffer_lock(1,iproc)) !$OMP END PARALLEL @@ -59,6 +65,7 @@ subroutine resize_H_apply_buffer(new_size,iproc) integer, intent(in) :: new_size, iproc integer(bit_kind), pointer :: buffer_det(:,:,:) double precision, pointer :: buffer_coef(:,:) + complex*16, pointer :: buffer_coef_complex(:,:) double precision, pointer :: buffer_e2(:,:) integer :: i,j,k integer :: Ndet @@ -74,9 +81,14 @@ subroutine resize_H_apply_buffer(new_size,iproc) ASSERT (iproc < nproc) allocate ( buffer_det(N_int,2,new_size), & - buffer_coef(new_size,N_states), & buffer_e2(new_size,N_states) ) - buffer_coef = 0.d0 + if (is_complex) then + allocate(buffer_coef_complex(new_size,N_states)) + buffer_coef_complex = (0.d0,0.d0) + else + allocate(buffer_coef(new_size,N_states)) + buffer_coef = 0.d0 + endif buffer_e2 = 0.d0 do i=1,min(new_size,H_apply_buffer(iproc)%N_det) do k=1,N_int @@ -89,6 +101,15 @@ subroutine resize_H_apply_buffer(new_size,iproc) deallocate(H_apply_buffer(iproc)%det) H_apply_buffer(iproc)%det => buffer_det + if (is_complex) then + do k=1,N_states + do i=1,min(new_size,H_apply_buffer(iproc)%N_det) + buffer_coef_complex(i,k) = H_apply_buffer(iproc)%coef_complex(i,k) + enddo + enddo + deallocate(H_apply_buffer(iproc)%coef_complex) + H_apply_buffer(iproc)%coef_complex => buffer_coef_complex + else do k=1,N_states do i=1,min(new_size,H_apply_buffer(iproc)%N_det) buffer_coef(i,k) = H_apply_buffer(iproc)%coef(i,k) @@ -96,6 +117,7 @@ subroutine resize_H_apply_buffer(new_size,iproc) enddo deallocate(H_apply_buffer(iproc)%coef) H_apply_buffer(iproc)%coef => buffer_coef + endif do k=1,N_states do i=1,min(new_size,H_apply_buffer(iproc)%N_det) @@ -119,6 +141,7 @@ subroutine copy_H_apply_buffer_to_wf END_DOC integer(bit_kind), allocatable :: buffer_det(:,:,:) double precision, allocatable :: buffer_coef(:,:) + complex*16, allocatable :: buffer_coef_complex(:,:) integer :: i,j,k integer :: N_det_old @@ -128,7 +151,12 @@ subroutine copy_H_apply_buffer_to_wf ASSERT (N_int > 0) ASSERT (N_det > 0) - allocate ( buffer_det(N_int,2,N_det), buffer_coef(N_det,N_states) ) + allocate ( buffer_det(N_int,2,N_det)) + if (is_complex) then + allocate(buffer_coef_complex(N_det,N_states)) + else + allocate(buffer_coef(N_det,N_states)) + endif ! Backup determinants j=0 @@ -142,6 +170,17 @@ subroutine copy_H_apply_buffer_to_wf N_det_old = j ! Backup coefficients + if (is_complex) then + do k=1,N_states + j=0 + do i=1,N_det + if (pruned(i)) cycle ! Pruned determinants + j += 1 + buffer_coef_complex(j,k) = psi_coef_complex(i,k) + enddo + ASSERT ( j == N_det_old ) + enddo + else do k=1,N_states j=0 do i=1,N_det @@ -151,6 +190,7 @@ subroutine copy_H_apply_buffer_to_wf enddo ASSERT ( j == N_det_old ) enddo + endif ! Update N_det N_det = N_det_old @@ -170,14 +210,57 @@ subroutine copy_H_apply_buffer_to_wf ASSERT (sum(popcnt(psi_det(:,1,i))) == elec_alpha_num) ASSERT (sum(popcnt(psi_det(:,2,i))) == elec_beta_num ) enddo + if (is_complex) then + do k=1,N_states + do i=1,N_det_old + psi_coef_complex(i,k) = buffer_coef_complex(i,k) + enddo + enddo + else do k=1,N_states do i=1,N_det_old psi_coef(i,k) = buffer_coef(i,k) enddo enddo + endif ! Copy new buffers + if (is_complex) then + !$OMP PARALLEL DEFAULT(SHARED) & + !$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) & + !$OMP SHARED(N_int,H_apply_buffer,psi_det,psi_coef_complex,N_states,psi_det_size) + j=0 + !$ j=omp_get_thread_num() + do k=0,j-1 + N_det_old += H_apply_buffer(k)%N_det + enddo + do i=1,H_apply_buffer(j)%N_det + do k=1,N_int + psi_det(k,1,i+N_det_old) = H_apply_buffer(j)%det(k,1,i) + psi_det(k,2,i+N_det_old) = H_apply_buffer(j)%det(k,2,i) + enddo + ASSERT (sum(popcnt(psi_det(:,1,i+N_det_old))) == elec_alpha_num) + ASSERT (sum(popcnt(psi_det(:,2,i+N_det_old))) == elec_beta_num ) + enddo + do k=1,N_states + do i=1,H_apply_buffer(j)%N_det + psi_coef_complex(i+N_det_old,k) = H_apply_buffer(j)%coef_complex(i,k) + enddo + enddo + !$OMP BARRIER + H_apply_buffer(j)%N_det = 0 + !$OMP END PARALLEL + SOFT_TOUCH N_det psi_det psi_coef_complex + + logical :: found_duplicates + call remove_duplicates_in_psi_det(found_duplicates) + do k=1,N_states + call normalize(psi_coef_complex(1,k),N_det) + enddo + SOFT_TOUCH N_det psi_det psi_coef_complex + else + !$OMP PARALLEL DEFAULT(SHARED) & !$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) & !$OMP SHARED(N_int,H_apply_buffer,psi_det,psi_coef,N_states,psi_det_size) @@ -210,7 +293,8 @@ subroutine copy_H_apply_buffer_to_wf call normalize(psi_coef(1,k),N_det) enddo SOFT_TOUCH N_det psi_det psi_coef - + + endif end subroutine remove_duplicates_in_psi_det(found_duplicates) @@ -274,7 +358,30 @@ subroutine remove_duplicates_in_psi_det(found_duplicates) enddo !$OMP END DO !$OMP END PARALLEL - + + if (is_complex) then + if (found_duplicates) then + k=0 + do i=1,N_det + if (.not.duplicate(i)) then + k += 1 + psi_det(:,:,k) = psi_det_sorted_bit (:,:,i) + psi_coef_complex(k,:) = psi_coef_sorted_bit_complex(i,:) + else + if (sum(cdabs(psi_coef_sorted_bit_complex(i,:))) /= 0.d0 ) then + psi_coef_complex(k,:) = psi_coef_sorted_bit_complex(i,:) + endif + endif + enddo + N_det = k + psi_det_sorted_bit(:,:,1:N_det) = psi_det(:,:,1:N_det) + psi_coef_sorted_bit_complex(1:N_det,:) = psi_coef_complex(1:N_det,:) + TOUCH N_det psi_det psi_coef_complex psi_det_sorted_bit psi_coef_sorted_bit_complex c0_weight + endif + psi_det = psi_det_sorted + psi_coef_complex = psi_coef_sorted_complex + SOFT_TOUCH psi_det psi_coef_complex psi_det_sorted_bit psi_coef_sorted_bit_complex + else if (found_duplicates) then k=0 do i=1,N_det @@ -296,6 +403,7 @@ subroutine remove_duplicates_in_psi_det(found_duplicates) psi_det = psi_det_sorted psi_coef = psi_coef_sorted SOFT_TOUCH psi_det psi_coef psi_det_sorted_bit psi_coef_sorted_bit + endif deallocate (duplicate,bit_tmp) end @@ -329,11 +437,19 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num) enddo + if (is_complex) then + do j=1,N_states + do i=1,N_selected + H_apply_buffer(iproc)%coef_complex(i+H_apply_buffer(iproc)%N_det,j) = (0.d0,0.d0) + enddo + enddo + else do j=1,N_states do i=1,N_selected H_apply_buffer(iproc)%coef(i+H_apply_buffer(iproc)%N_det,j) = 0.d0 enddo enddo + endif H_apply_buffer(iproc)%N_det = new_size do i=1,H_apply_buffer(iproc)%N_det ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num) @@ -343,6 +459,11 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc) end subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id) + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use f77_zmq implicit none BEGIN_DOC @@ -404,6 +525,11 @@ IRP_ENDIF end subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,i_generator,N_st,n,task_id) + !todo: modify for complex + if (is_complex) then + print*,irp_here,' not implemented for complex' + stop -1 + endif use f77_zmq implicit none BEGIN_DOC diff --git a/src/determinants/h_apply_nozmq.template.f b/src/determinants/h_apply_nozmq.template.f index bd261bbe..6d769556 100644 --- a/src/determinants/h_apply_nozmq.template.f +++ b/src/determinants/h_apply_nozmq.template.f @@ -17,8 +17,11 @@ subroutine $subroutine($params_main) double precision, allocatable :: fock_diag_tmp(:,:) $initialization + if (is_complex) then + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex + else PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators - + endif call wall_time(wall_0) diff --git a/src/determinants/occ_pattern.irp.f b/src/determinants/occ_pattern.irp.f index 9e0ccd33..8596a3c1 100644 --- a/src/determinants/occ_pattern.irp.f +++ b/src/determinants/occ_pattern.irp.f @@ -513,7 +513,7 @@ subroutine make_s2_eigenfunction N_det_new += 1 det_buffer(:,:,N_det_new) = d(:,:,j) if (N_det_new == bufsze) then - call fill_H_apply_buffer_no_selection(bufsze,det_buffer,N_int,ithread) + call fill_h_apply_buffer_no_selection(bufsze,det_buffer,N_int,ithread) N_det_new = 0 endif enddo @@ -528,7 +528,7 @@ subroutine make_s2_eigenfunction !$OMP END PARALLEL if (update) then - call copy_H_apply_buffer_to_wf + call copy_h_apply_buffer_to_wf if (is_complex) then TOUCH N_det psi_coef_complex psi_det psi_occ_pattern N_occ_pattern else diff --git a/src/generators_full/generators.irp.f b/src/generators_full/generators.irp.f index 7f18947f..f6a42fad 100644 --- a/src/generators_full/generators.irp.f +++ b/src/generators_full/generators.irp.f @@ -22,20 +22,35 @@ BEGIN_PROVIDER [ integer, N_det_generators ] call write_int(6,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,psi_det_size) ] implicit none BEGIN_DOC ! For Single reference wave functions, the generator is the ! Hartree-Fock determinant END_DOC psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted(1:N_int,1:2,1:N_det) - psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted(1:N_det,1:N_states) END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_generators, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! For Single reference wave functions, the generator is the + ! Hartree-Fock determinant + END_DOC + psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted(1:N_det,1:N_states) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, psi_coef_generators_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! For Single reference wave functions, the generator is the + ! Hartree-Fock determinant + END_DOC + psi_coef_generators_complex(1:N_det,1:N_states) = psi_coef_sorted_complex(1:N_det,1:N_states) +END_PROVIDER + BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_gen, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ] &BEGIN_PROVIDER [ integer, psi_det_sorted_gen_order, (psi_det_size) ] implicit none @@ -44,10 +59,26 @@ END_PROVIDER ! Hartree-Fock determinant END_DOC psi_det_sorted_gen = psi_det_sorted - psi_coef_sorted_gen = psi_coef_sorted psi_det_sorted_gen_order = psi_det_sorted_order END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! For Single reference wave functions, the generator is the + ! Hartree-Fock determinant + END_DOC + psi_coef_sorted_gen = psi_coef_sorted +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, psi_coef_sorted_gen_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! For Single reference wave functions, the generator is the + ! Hartree-Fock determinant + END_DOC + psi_coef_sorted_gen_complex = psi_coef_sorted_complex +END_PROVIDER BEGIN_PROVIDER [integer, degree_max_generators] implicit none diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index cbe87d05..cdc7a7f7 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -22,6 +22,11 @@ determinants: (done) filter_connected.irp.f (done) fock_diag.irp.f (****) h_apply.irp.f + added coef_complex to h_apply_buffer_type + either coef or coef_complex will remain unallocated + (if this causes problems (it shouldn't), maybe just allocate unused one with size 1?) + check {push,pull}_pt2 + pt2, norm_pert, h_pert_diag types? (should be real? documentation?) (****) h_apply_nozmq.template.f (****) h_apply.template.f (****) h_apply_zmq.template.f From 7e3e2b9db92ef96e99cc8037b85c4b8ec10a35e0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 10:26:53 -0600 Subject: [PATCH 113/256] minor --- src/determinants/h_apply.irp.f | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/determinants/h_apply.irp.f b/src/determinants/h_apply.irp.f index cfbbf847..44966310 100644 --- a/src/determinants/h_apply.irp.f +++ b/src/determinants/h_apply.irp.f @@ -27,7 +27,7 @@ type(H_apply_buffer_type), pointer :: H_apply_buffer(:) allocate(H_apply_buffer(0:nproc-1)) iproc = 0 !$OMP PARALLEL PRIVATE(iproc) DEFAULT(NONE) & - !$OMP SHARED(H_apply_buffer,N_int,sze,N_states,H_apply_buffer_lock) + !$OMP SHARED(H_apply_buffer,N_int,sze,N_states,H_apply_buffer_lock,is_complex) !$ iproc = omp_get_thread_num() H_apply_buffer(iproc)%N_det = 0 H_apply_buffer(iproc)%sze = sze @@ -225,6 +225,7 @@ subroutine copy_H_apply_buffer_to_wf endif ! Copy new buffers + logical :: found_duplicates if (is_complex) then !$OMP PARALLEL DEFAULT(SHARED) & @@ -253,7 +254,6 @@ subroutine copy_H_apply_buffer_to_wf !$OMP END PARALLEL SOFT_TOUCH N_det psi_det psi_coef_complex - logical :: found_duplicates call remove_duplicates_in_psi_det(found_duplicates) do k=1,N_states call normalize(psi_coef_complex(1,k),N_det) @@ -287,7 +287,6 @@ subroutine copy_H_apply_buffer_to_wf !$OMP END PARALLEL SOFT_TOUCH N_det psi_det psi_coef - logical :: found_duplicates call remove_duplicates_in_psi_det(found_duplicates) do k=1,N_states call normalize(psi_coef(1,k),N_det) From 5418ed0f1cba220de445ffcc00508c1dcc44ddc4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 10:27:08 -0600 Subject: [PATCH 114/256] notes --- src/utils_complex/qp2-pbc-diff.txt | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index cdc7a7f7..9f3598e3 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,6 +1,28 @@ ------------------------------------------------------------------------------------- current: + h_apply.irp.f + push/pull_pt2 + pt2,norm_pert,h_pert_diag + types? + if complex, do we need to keep imag part? (should imag sum to zero?) + h_apply_{,{,no}zmq}.template.f + see generate_h_apply.py script + may need to modify + selectors + (looks like nothing in e_corr_selectors.irp.f is used elsewhere?) + (only e_corr_per_sel outside of src (provided in h apply gen script)) + coef_hf_selector (inv, invsquared) + for real, is sign important, or just magnitude? + e_corr_per_selectors (is this used anywhere?) + provided in generate_h_apply.py? + * c(Di) / c(HF) + complex, but does this matter? + is magnitude important or just real part? + i_H_HF_per_selectors + + not used anywhere else, so no additional concerns other than for e_corr_per_selectors + delta_E_per_selector general: check for dependence on psi_det_sorted, clean up providers @@ -30,10 +52,8 @@ determinants: (****) h_apply_nozmq.template.f (****) h_apply.template.f (****) h_apply_zmq.template.f - (****) occ_pattern.irp.f - mostly done? - might need to change calls to fill_h_apply_buffer_no_selection? - check again after modifying h_apply for complex + (done) occ_pattern.irp.f + (might need to change if we change h_apply) (done) prune_wf.irp.f (done) psi_cas{,_complex}.irp.f might be able to combine some providers?? From f869d347b80fc1f51f0990a53aeb6732d609ebf7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 13:09:15 -0600 Subject: [PATCH 115/256] working on complex davidson --- src/cipsi/cipsi.irp.f | 21 +- src/davidson/davidson_parallel.irp.f | 462 +++++++++++++++++- src/davidson/u0_h_u0.irp.f | 706 ++++++++++++++++++++++++++- src/utils/transpose.irp.f | 97 ++++ src/utils_complex/qp2-pbc-diff.txt | 29 +- 5 files changed, 1288 insertions(+), 27 deletions(-) diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f index ba922c49..66881b28 100644 --- a/src/cipsi/cipsi.irp.f +++ b/src/cipsi/cipsi.irp.f @@ -45,13 +45,19 @@ subroutine run_cipsi if (N_det > N_det_max) then psi_det = psi_det_sorted - psi_coef = psi_coef_sorted - N_det = N_det_max - soft_touch N_det psi_det psi_coef + if (is_complex) then + psi_coef_complex = psi_coef_sorted_complex + N_det = N_det_max + soft_touch N_det psi_det psi_coef_complex + else + psi_coef = psi_coef_sorted + N_det = N_det_max + soft_touch N_det psi_det psi_coef + endif if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_CI + call diagonalize_ci call save_wavefunction endif @@ -109,8 +115,11 @@ subroutine run_cipsi to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor) to_select = max(N_states_diag, to_select) call ZMQ_selection(to_select, pt2, variance, norm) - - PROVIDE psi_coef + if (is_complex) then + PROVIDE psi_coef_complex + else + PROVIDE psi_coef + endif PROVIDE psi_det PROVIDE psi_det_sorted diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index c0d94b35..b98ec377 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -89,21 +89,93 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, character*(512) :: msg integer :: imin, imax, ishift, istep - integer, allocatable :: psi_det_read(:,:,:) - double precision, allocatable :: v_t(:,:), s_t(:,:), u_t(:,:) - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t, v_t, s_t - - ! Get wave function (u_t) - ! ----------------------- - integer :: rc, ni, nj integer*8 :: rc8 integer :: N_states_read, N_det_read, psi_det_size_read integer :: N_det_selectors_read, N_det_generators_read - integer, external :: zmq_get_dvector + integer, allocatable :: psi_det_read(:,:,:) + logical :: sending + integer, external :: get_task_from_taskserver + integer, external :: task_done_to_taskserver + integer :: k + integer :: ierr + + +! integer, external :: zmq_get_dvector integer, external :: zmq_get_dmatrix + + if (is_complex) then + complex*16, allocatable :: v_tc(:,:), s_tc(:,:), u_tc(:,:) + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_tc, v_tc, s_tc + + + ! Get wave function (u_tc) + ! ----------------------- + + PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique + PROVIDE psi_bilinear_matrix_transp_values_complex psi_bilinear_matrix_values_complex psi_bilinear_matrix_columns_loc + PROVIDE ref_bitmask_energy nproc + PROVIDE mpi_initialized + + allocate(u_tc(N_st,N_det)) + + !todo: resize for complex? + ! Warning : dimensions are modified for efficiency, It is OK since we get the + ! full matrix + if (size(u_tc,kind=8) < 8388608_8) then + ni = size(u_tc) + nj = 1 + else + ni = 8388608 + nj = int(size(u_tc,kind=8)/8388608_8,4) + 1 + endif + + do while (zmq_get_cdmatrix(zmq_to_qp_run_socket, worker_id, 'u_tc', u_tc, ni, nj, size(u_tc,kind=8)) == -1) + print *, 'mpi_rank, N_states_diag, N_det' + print *, mpi_rank, N_states_diag, N_det + stop 'u_t' + enddo + + IRP_IF MPI + include 'mpif.h' + call broadcast_chunks_complex_double(u_tc,size(u_tc,kind=8)) + IRP_ENDIF + + ! Run tasks + ! --------- + + sending=.False. + + allocate(v_tc(N_st,N_det), s_tc(N_st,N_det)) + do + if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then + exit + endif + if(task_id == 0) exit + read (msg,*) imin, imax, ishift, istep + do k=imin,imax + v_tc(:,k) = (0.d0,0.d0) + s_tc(:,k) = (0.d0,0.d0) + enddo + call h_s2_u_0_nstates_openmp_work_complex(v_tc,s_tc,u_tc,N_st,N_det,imin,imax,ishift,istep) + if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then + print *, irp_here, 'Unable to send task_done' + endif + call davidson_push_results_async_recv(zmq_socket_push, sending) + call davidson_push_results_async_send_complex(zmq_socket_push, v_tc, s_tc, imin, imax, task_id, sending) + end do + deallocate(u_tc,v_tc, s_tc) + call davidson_push_results_async_recv(zmq_socket_push, sending) + else + double precision, allocatable :: v_t(:,:), s_t(:,:), u_t(:,:) + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t, v_t, s_t + + + ! Get wave function (u_t) + ! ----------------------- PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique PROVIDE psi_bilinear_matrix_transp_values psi_bilinear_matrix_values psi_bilinear_matrix_columns_loc @@ -130,28 +202,21 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, IRP_IF MPI include 'mpif.h' - integer :: ierr - call broadcast_chunks_double(u_t,size(u_t,kind=8)) - IRP_ENDIF ! Run tasks ! --------- - logical :: sending sending=.False. allocate(v_t(N_st,N_det), s_t(N_st,N_det)) do - integer, external :: get_task_from_taskserver - integer, external :: task_done_to_taskserver if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then exit endif if(task_id == 0) exit read (msg,*) imin, imax, ishift, istep - integer :: k do k=imin,imax v_t(:,k) = 0.d0 s_t(:,k) = 0.d0 @@ -165,7 +230,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, end do deallocate(u_t,v_t, s_t) call davidson_push_results_async_recv(zmq_socket_push, sending) - + endif end subroutine @@ -533,6 +598,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze) end + BEGIN_PROVIDER [ integer, nthreads_davidson ] implicit none BEGIN_DOC @@ -643,3 +709,365 @@ integer function zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id) IRP_ENDIF end + +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id) + !todo: implement for complex; check double sz + print*,irp_here,' not implemented for complex' + stop -1 + use f77_zmq + implicit none + BEGIN_DOC +! Push the results of $H | U \rangle$ from a worker to the master. + END_DOC + + integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push + integer ,intent(in) :: task_id, imin, imax + complex*16 ,intent(in) :: v_t(N_states_diag,N_det) + complex*16 ,intent(in) :: s_t(N_states_diag,N_det) + integer :: rc, sz + integer*8 :: rc8 + + sz = (imax-imin+1)*N_states_diag + + rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push task_id' + + rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push imin' + + rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push imax' + + !todo: double sz for complex? + rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE) + if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' + + !todo: double sz for complex? + rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0) + if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' + +! Activate is zmq_socket_push is a REQ +IRP_IF ZMQ_PUSH +IRP_ELSE + character*(2) :: ok + rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) + if ((rc /= 2).and.(ok(1:2)/='ok')) then + print *, irp_here, ': f77_zmq_recv( zmq_socket_push, ok, 2, 0)' + stop -1 + endif +IRP_ENDIF + +end subroutine + +subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending) + !todo: implement for complex; check double sz + print*,irp_here,' not implemented for complex' + stop -1 + use f77_zmq + implicit none + BEGIN_DOC +! Push the results of $H | U \rangle$ from a worker to the master. + END_DOC + + integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push + integer ,intent(in) :: task_id, imin, imax + complex*16 ,intent(in) :: v_t(N_states_diag,N_det) + complex*16 ,intent(in) :: s_t(N_states_diag,N_det) + logical ,intent(inout) :: sending + integer :: rc, sz + integer*8 :: rc8 + + if (sending) then + print *, irp_here, ': sending=true' + stop -1 + endif + sending = .True. + + sz = (imax-imin+1)*N_states_diag + + rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push task_id' + + rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push imin' + + rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) + if(rc /= 4) stop 'davidson_push_results failed to push imax' + + !todo: double sz for complex? + rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE) + if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' + + !todo: double sz for complex? + rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0) + if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' + +end subroutine + + +subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id) + !todo: implement for complex; check double sz + print*,irp_here,' not implemented for complex' + stop -1 + use f77_zmq + implicit none + BEGIN_DOC +! Pull the results of $H | U \rangle$ on the master. + END_DOC + + integer(ZMQ_PTR) ,intent(in) :: zmq_socket_pull + integer ,intent(out) :: task_id, imin, imax + complex*16 ,intent(out) :: v_t(N_states_diag,N_det) + complex*16 ,intent(out) :: s_t(N_states_diag,N_det) + + integer :: rc, sz + integer*8 :: rc8 + + rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) + if(rc /= 4) stop 'davidson_pull_results failed to pull task_id' + + rc = f77_zmq_recv( zmq_socket_pull, imin, 4, 0) + if(rc /= 4) stop 'davidson_pull_results failed to pull imin' + + rc = f77_zmq_recv( zmq_socket_pull, imax, 4, 0) + if(rc /= 4) stop 'davidson_pull_results failed to pull imax' + + sz = (imax-imin+1)*N_states_diag + + !todo: double sz for complex? + rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0) + if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t' + + !todo: double sz for complex? + rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0) + if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t' + +! Activate if zmq_socket_pull is a REP +IRP_IF ZMQ_PUSH +IRP_ELSE + rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) + if (rc /= 2) then + print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...' + stop -1 + endif +IRP_ENDIF + +end subroutine + + +subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze, N_st) + !todo: implement for complex; check conjg v_t s_t + print*,irp_here,' not implemented for complex' + stop -1 + use f77_zmq + implicit none + BEGIN_DOC +! Routine collecting the results of the workers in Davidson's algorithm. + END_DOC + + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + integer, intent(in) :: sze, N_st + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + + complex*16 ,intent(inout) :: v0(sze, N_st) + complex*16 ,intent(inout) :: s0(sze, N_st) + + integer :: more, task_id, imin, imax + + complex*16, allocatable :: v_t(:,:), s_t(:,:) + logical :: sending + integer :: i,j + integer, external :: zmq_delete_task_async_send + integer, external :: zmq_delete_task_async_recv + + allocate(v_t(N_st,N_det), s_t(N_st,N_det)) + v0 = (0.d0,0.d0) + s0 = (0.d0,0.d0) + more = 1 + sending = .False. + do while (more == 1) + call davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id) + if (zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending) == -1) then + stop 'davidson: Unable to delete task (send)' + endif + do j=1,N_st + do i=imin,imax + !todo: conjg or no? + print*,irp_here,' not implemented for complex (conjg?)' + v0(i,j) = v0(i,j) + v_t(j,i) + s0(i,j) = s0(i,j) + s_t(j,i) + enddo + enddo + if (zmq_delete_task_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then + stop 'davidson: Unable to delete task (recv)' + endif + end do + deallocate(v_t,s_t) + +end subroutine + + + +subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) + !todo: implement for complex + print*,irp_here,' not implemented for complex' + stop -1 + use omp_lib + use bitmasks + use f77_zmq + implicit none + BEGIN_DOC + ! Computes $v_0 = H | u_0\rangle$ and $s_0 = S^2 | u_0\rangle$ + ! + ! n : number of determinants + ! + ! H_jj : array of $\langle j | H | j \rangle$ + ! + ! S2_jj : array of $\langle j | S^2 | j \rangle$ + END_DOC + integer, intent(in) :: N_st, sze + complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st) + complex*16, intent(inout) :: u_0(sze,N_st) + integer :: i,j,k + integer :: ithread + complex*16, allocatable :: u_t(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull + PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique + PROVIDE psi_bilinear_matrix_transp_values_complex psi_bilinear_matrix_values_complex psi_bilinear_matrix_columns_loc + PROVIDE ref_bitmask_energy nproc + PROVIDE mpi_initialized + + call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'davidson') + +! integer :: N_states_diag_save +! N_states_diag_save = N_states_diag +! N_states_diag = N_st + if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_states_diag on ZMQ server' + endif + + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + energy = 0.d0 + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + + + ! Create tasks + ! ============ + + integer :: istep, imin, imax, ishift, ipos + integer, external :: add_task_to_taskserver + integer, parameter :: tasksize=10000 + character*(100000) :: task + istep=1 + ishift=0 + imin=1 + + + ipos=1 + do imin=1,N_det,tasksize + imax = min(N_det,imin-1+tasksize) + do ishift=0,istep-1 + write(task(ipos:ipos+50),'(4(I11,1X),1X,1A)') imin, imax, ishift, istep, '|' + ipos = ipos+50 + if (ipos > 100000-50) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task' + endif + ipos=1 + endif + enddo + enddo + + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task' + endif + ipos=1 + endif + + allocate(u_t(N_st,N_det)) + do k=1,N_st + call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) + enddo + + call cdtranspose( & + u_0, & + size(u_0, 1), & + u_t, & + size(u_t, 1), & + N_det, N_st) + + + ASSERT (N_st == N_states_diag) + ASSERT (sze >= N_det) + + integer :: rc, ni, nj + integer*8 :: rc8 + double precision :: energy(N_st) + + integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag + integer, external :: zmq_put_cdmatrix + !todo: size/2 for complex? + if (size(u_t) < 8388608) then + ni = size(u_t) + nj = 1 + else + ni = 8388608 + nj = size(u_t)/8388608 + 1 + endif + ! Warning : dimensions are modified for efficiency, It is OK since we get the + ! full matrix + if (zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, 'u_t', u_t, ni, nj, size(u_t,kind=8)) == -1) then + stop 'Unable to put u_t on ZMQ server' + endif + + deallocate(u_t) + + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + call omp_set_nested(.True.) + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) + ithread = omp_get_thread_num() + if (ithread == 0 ) then + call davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v_0, s_0, N_det, N_st) + else + call davidson_slave_inproc(1) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'davidson') + + !$OMP PARALLEL + !$OMP SINGLE + do k=1,N_st + !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det) + call cdset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + !$OMP END TASK + !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det) + call cdset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + !$OMP END TASK + !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det) + call cdset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + !$OMP END TASK + enddo + !$OMP END SINGLE + !$OMP TASKWAIT + !$OMP END PARALLEL + +! N_states_diag = N_states_diag_save +! SOFT_TOUCH N_states_diag +end + diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 6117a13e..e3a2e1ed 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -6,7 +6,11 @@ ! ! psi_s2(i) = $\langle \Psi_i | S^2 | \Psi_i \rangle$ END_DOC - call u_0_H_u_0(psi_energy,psi_s2,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size) + if (is_complex) then + call u_0_h_u_0_complex(psi_energy,psi_s2,psi_coef_complex,N_det,psi_det,N_int,N_states,psi_det_size) + else + call u_0_H_u_0(psi_energy,psi_s2,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size) + endif integer :: i do i=N_det+1,N_states psi_energy(i) = 0.d0 @@ -708,3 +712,703 @@ N_int;; END_TEMPLATE +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine u_0_H_u_0_complex(e_0,s_0,u_0,n,keys_tmp,Nint,N_st,sze) + !todo: implement for complex + print*,irp_here,' not implemented for complex' + stop -1 + use bitmasks + implicit none + BEGIN_DOC + ! Computes $E_0 = \frac{\langle u_0 | H | u_0 \rangle}{\langle u_0 | u_0 \rangle}$ + ! + ! and $S_0 = \frac{\langle u_0 | S^2 | u_0 \rangle}{\langle u_0 | u_0 \rangle}$ + ! + ! n : number of determinants + ! + END_DOC + integer, intent(in) :: n,Nint, N_st, sze + double precision, intent(out) :: e_0(N_st),s_0(N_st) + complex*16, intent(inout) :: u_0(sze,N_st) + integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) + + complex*16, allocatable :: v_0(:,:), s_vec(:,:), u_1(:,:) + double precision :: u_dot_u_complex,diag_H_mat_elem + complex*16 :: u_dot_v_complex + integer :: i,j, istate + + if ((n > 100000).and.distributed_davidson) then + allocate (v_0(n,N_states_diag),s_vec(n,N_states_diag), u_1(n,N_states_diag)) + u_1(:,:) = (0.d0,0.d0) + u_1(1:n,1:N_st) = u_0(1:n,1:N_st) + call h_s2_u_0_nstates_zmq(v_0,s_vec,u_1,N_states_diag,n) + else if (n < n_det_max_full) then + allocate (v_0(n,N_st),s_vec(n,N_st), u_1(n,N_st)) + v_0(:,:) = 0.d0 + u_1(:,:) = 0.d0 + s_vec(:,:) = 0.d0 + u_1(1:n,1:N_st) = u_0(1:n,1:N_st) + do istate = 1,N_st + do j=1,n + do i=1,n + v_0(i,istate) = v_0(i,istate) + h_matrix_all_dets(i,j) * u_0(j,istate) + s_vec(i,istate) = s_vec(i,istate) + S2_matrix_all_dets(i,j) * u_0(j,istate) + enddo + enddo + enddo + else + allocate (v_0(n,N_st),s_vec(n,N_st),u_1(n,N_st)) + u_1(:,:) = 0.d0 + u_1(1:n,1:N_st) = u_0(1:n,1:N_st) + call H_S2_u_0_nstates_openmp(v_0,s_vec,u_1,N_st,n) + endif + u_0(1:n,1:N_st) = u_1(1:n,1:N_st) + deallocate(u_1) + double precision :: norm + !$OMP PARALLEL DO PRIVATE(i,norm) DEFAULT(SHARED) + do i=1,N_st + norm = u_dot_u(u_0(1,i),n) + if (norm /= 0.d0) then + e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n) + s_0(i) = u_dot_v(s_vec(1,i),u_0(1,i),n) + else + e_0(i) = 0.d0 + s_0(i) = 0.d0 + endif + enddo + !$OMP END PARALLEL DO + deallocate (s_vec, v_0) +end + + +subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) + !todo: implement for complex + print*,irp_here,' not implemented for complex' + stop -1 + use bitmasks + implicit none + BEGIN_DOC + ! Computes $v_0 = H | u_0\rangle$ and $s_0 = S^2 | u_0\rangle$. + ! + ! Assumes that the determinants are in psi_det + ! + ! istart, iend, ishift, istep are used in ZMQ parallelization. + END_DOC + integer, intent(in) :: N_st,sze + double precision, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) + integer :: k + double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t + allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det)) + + do k=1,N_st + call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) + enddo + v_t = 0.d0 + s_t = 0.d0 + call dtranspose( & + u_0, & + size(u_0, 1), & + u_t, & + size(u_t, 1), & + N_det, N_st) + + call H_S2_u_0_nstates_openmp_work(v_t,s_t,u_t,N_st,sze,1,N_det,0,1) + deallocate(u_t) + + call dtranspose( & + v_t, & + size(v_t, 1), & + v_0, & + size(v_0, 1), & + N_st, N_det) + call dtranspose( & + s_t, & + size(s_t, 1), & + s_0, & + size(s_0, 1), & + N_st, N_det) + deallocate(v_t,s_t) + + do k=1,N_st + call dset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + call dset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + call dset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + enddo + +end +subroutine H_S2_u_0_nstates_openmp_work_complex(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + !todo: implement for complex + print*,irp_here,' not implemented for complex' + stop -1 + use bitmasks + implicit none + BEGIN_DOC + ! Computes $v_t = H | u_t\rangle$ and $s_t = S^2 | u_t\rangle$ + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer, intent(in) :: N_st,sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_st,N_det) + complex*16, intent(out) :: v_t(N_st,sze), s_t(N_st,sze) + + + PROVIDE ref_bitmask_energy N_int + + select case (N_int) + case (1) + call H_S2_u_0_nstates_openmp_work_complex_1(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + case (2) + call H_S2_u_0_nstates_openmp_work_complex_2(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + case (3) + call H_S2_u_0_nstates_openmp_work_complex_3(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + case (4) + call H_S2_u_0_nstates_openmp_work_complex_4(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + case default + call H_S2_u_0_nstates_openmp_work_complex_N_int(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + end select +end + +BEGIN_TEMPLATE + +subroutine H_S2_u_0_nstates_openmp_work_complex_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) + !todo: implement for complex + print*,irp_here,' not implemented for complex' + stop -1 + use bitmasks + implicit none + BEGIN_DOC + ! Computes $v_t = H | u_t \\rangle$ and $s_t = S^2 | u_t\\rangle$ + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer, intent(in) :: N_st,sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_st,N_det) + complex*16, intent(out) :: v_t(N_st,sze), s_t(N_st,sze) + + complex*16 :: hij, sij + integer :: i,j,k,l,kk + integer :: k_a, k_b, l_a, l_b, m_a, m_b + integer :: istate + integer :: krow, kcol, krow_b, kcol_b + integer :: lrow, lcol + integer :: mrow, mcol + integer(bit_kind) :: spindet($N_int) + integer(bit_kind) :: tmp_det($N_int,2) + integer(bit_kind) :: tmp_det2($N_int,2) + integer(bit_kind) :: tmp_det3($N_int,2) + integer(bit_kind), allocatable :: buffer(:,:) + integer :: n_doubles + integer, allocatable :: doubles(:) + integer, allocatable :: singles_a(:) + integer, allocatable :: singles_b(:) + integer, allocatable :: idx(:), idx0(:) + integer :: maxab, n_singles_a, n_singles_b, kcol_prev + integer*8 :: k8 + logical :: compute_singles + integer*8 :: last_found, left, right, right_max + double precision :: rss, mem, ratio + complex*16, allocatable :: utl(:,:) + integer, parameter :: block_size=128 + +! call resident_memory(rss) +! mem = dble(singles_beta_csc_size) / 1024.d0**3 +! +! compute_singles = (mem+rss > qp_max_mem) +! +! if (.not.compute_singles) then +! provide singles_beta_csc +! endif +compute_singles=.True. + + maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + allocate(idx0(maxab)) + + do i=1,maxab + idx0(i) = i + enddo + + ! Prepare the array of all alpha single excitations + ! ------------------------------------------------- + + PROVIDE N_int nthreads_davidson + !$OMP PARALLEL DEFAULT(SHARED) NUM_THREADS(nthreads_davidson) & + !$OMP SHARED(psi_bilinear_matrix_rows, N_det, & + !$OMP psi_bilinear_matrix_columns, & + !$OMP psi_det_alpha_unique, psi_det_beta_unique, & + !$OMP n_det_alpha_unique, n_det_beta_unique, N_int, & + !$OMP psi_bilinear_matrix_transp_rows, & + !$OMP psi_bilinear_matrix_transp_columns, & + !$OMP psi_bilinear_matrix_transp_order, N_st, & + !$OMP psi_bilinear_matrix_order_transp_reverse, & + !$OMP psi_bilinear_matrix_columns_loc, & + !$OMP psi_bilinear_matrix_transp_rows_loc, & + !$OMP istart, iend, istep, irp_here, v_t, s_t, & + !$OMP ishift, idx0, u_t, maxab, compute_singles, & + !$OMP singles_alpha_csc,singles_alpha_csc_idx, & + !$OMP singles_beta_csc,singles_beta_csc_idx) & + !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & + !$OMP lcol, lrow, l_a, l_b, utl, kk, & + !$OMP buffer, doubles, n_doubles, & + !$OMP tmp_det2, hij, sij, idx, l, kcol_prev, & + !$OMP singles_a, n_singles_a, singles_b, ratio, & + !$OMP n_singles_b, k8, last_found,left,right,right_max) + + ! Alpha/Beta double excitations + ! ============================= + + allocate( buffer($N_int,maxab), & + singles_a(maxab), & + singles_b(maxab), & + doubles(maxab), & + idx(maxab), utl(N_st,block_size)) + + kcol_prev=-1 + + ASSERT (iend <= N_det) + ASSERT (istart > 0) + ASSERT (istep > 0) + + !$OMP DO SCHEDULE(guided,64) + do k_a=istart+ishift,iend,istep + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + + if (kcol /= kcol_prev) then + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + if (compute_singles) then + call get_all_spin_singles_$N_int( & + psi_det_beta_unique, idx0, & + tmp_det(1,2), N_det_beta_unique, & + singles_b, n_singles_b) + else + n_singles_b = 0 + !DIR$ LOOP COUNT avg(1000) + do k8=singles_beta_csc_idx(kcol),singles_beta_csc_idx(kcol+1)-1 + n_singles_b = n_singles_b+1 + singles_b(n_singles_b) = singles_beta_csc(k8) + enddo + endif + endif + kcol_prev = kcol + + ! Loop over singly excited beta columns + ! ------------------------------------- + + !DIR$ LOOP COUNT avg(1000) + do i=1,n_singles_b + lcol = singles_b(i) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol) + +!--- +! if (compute_singles) then + + l_a = psi_bilinear_matrix_columns_loc(lcol) + ASSERT (l_a <= N_det) + + !DIR$ UNROLL(8) + !DIR$ LOOP COUNT avg(50000) + do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! hot spot + + ASSERT (l_a <= N_det) + idx(j) = l_a + l_a = l_a+1 + enddo + j = j-1 + + call get_all_spin_singles_$N_int( & + buffer, idx, tmp_det(1,1), j, & + singles_a, n_singles_a ) + +!----- +! else +! +! ! Search for singles +! +!call cpu_time(time0) +! ! Right boundary +! l_a = psi_bilinear_matrix_columns_loc(lcol+1)-1 +! ASSERT (l_a <= N_det) +! do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) +! lrow = psi_bilinear_matrix_rows(l_a) +! ASSERT (lrow <= N_det_alpha_unique) +! +! left = singles_alpha_csc_idx(krow) +! right_max = -1_8 +! right = singles_alpha_csc_idx(krow+1) +! do while (right-left>0_8) +! k8 = shiftr(right+left,1) +! if (singles_alpha_csc(k8) > lrow) then +! right = k8 +! else if (singles_alpha_csc(k8) < lrow) then +! left = k8 + 1_8 +! else +! right_max = k8+1_8 +! exit +! endif +! enddo +! if (right_max > 0_8) exit +! l_a = l_a-1 +! enddo +! if (right_max < 0_8) right_max = singles_alpha_csc_idx(krow) +! +! ! Search +! n_singles_a = 0 +! l_a = psi_bilinear_matrix_columns_loc(lcol) +! ASSERT (l_a <= N_det) +! +! last_found = singles_alpha_csc_idx(krow) +! do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) +! lrow = psi_bilinear_matrix_rows(l_a) +! ASSERT (lrow <= N_det_alpha_unique) +! +! left = last_found +! right = right_max +! do while (right-left>0_8) +! k8 = shiftr(right+left,1) +! if (singles_alpha_csc(k8) > lrow) then +! right = k8 +! else if (singles_alpha_csc(k8) < lrow) then +! left = k8 + 1_8 +! else +! n_singles_a += 1 +! singles_a(n_singles_a) = l_a +! last_found = k8+1_8 +! exit +! endif +! enddo +! l_a = l_a+1 +! enddo +! j = j-1 +! +! endif +!----- + + ! Loop over alpha singles + ! ----------------------- + + !DIR$ LOOP COUNT avg(1000) + do k = 1,n_singles_a,block_size + ! Prefetch u_t(:,l_a) + do kk=0,block_size-1 + if (k+kk > n_singles_a) exit + l_a = singles_a(k+kk) + ASSERT (l_a <= N_det) + + do l=1,N_st + utl(l,kk+1) = u_t(l,l_a) + enddo + enddo + + do kk=0,block_size-1 + if (k+kk > n_singles_a) exit + l_a = singles_a(k+kk) + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call i_H_j_double_alpha_beta(tmp_det,tmp_det2,$N_int,hij) + call get_s2(tmp_det,tmp_det2,$N_int,sij) + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) + s_t(l,k_a) = s_t(l,k_a) + sij * utl(l,kk+1) + enddo + enddo + enddo + + enddo + + enddo + !$OMP END DO + + !$OMP DO SCHEDULE(guided,64) + do k_a=istart+ishift,iend,istep + + + ! Single and double alpha excitations + ! =================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + ! Initial determinant is at k_b in beta-major representation + ! ---------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + spindet(1:$N_int) = tmp_det(1:$N_int,1) + + ! Loop inside the beta column to gather all the connected alphas + lcol = psi_bilinear_matrix_columns(k_a) + l_a = psi_bilinear_matrix_columns_loc(lcol) + + !DIR$ LOOP COUNT avg(200000) + do i=1,N_det_alpha_unique + if (l_a > N_det) exit + lcol = psi_bilinear_matrix_columns(l_a) + if (lcol /= kcol) exit + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) ! Hot spot + idx(i) = l_a + l_a = l_a+1 + enddo + i = i-1 + + call get_all_spin_singles_and_doubles_$N_int( & + buffer, idx, spindet, i, & + singles_a, doubles, n_singles_a, n_doubles ) + + ! Compute Hij for all alpha singles + ! ---------------------------------- + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + !DIR$ LOOP COUNT avg(1000) + do i=1,n_singles_a,block_size + ! Prefetch u_t(:,l_a) + do kk=0,block_size-1 + if (i+kk > n_singles_a) exit + l_a = singles_a(i+kk) + ASSERT (l_a <= N_det) + + do l=1,N_st + utl(l,kk+1) = u_t(l,l_a) + enddo + enddo + + do kk=0,block_size-1 + if (i+kk > n_singles_a) exit + l_a = singles_a(i+kk) + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 1, hij) + + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) + ! single => sij = 0 + enddo + enddo + enddo + + + ! Compute Hij for all alpha doubles + ! ---------------------------------- + + !DIR$ LOOP COUNT avg(50000) + do i=1,n_doubles,block_size + ! Prefetch u_t(:,l_a) + do kk=0,block_size-1 + if (i+kk > n_doubles) exit + l_a = doubles(i+kk) + ASSERT (l_a <= N_det) + + do l=1,N_st + utl(l,kk+1) = u_t(l,l_a) + enddo + enddo + + do kk=0,block_size-1 + if (i+kk > n_doubles) exit + l_a = doubles(i+kk) + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) + ! same spin => sij = 0 + enddo + enddo + enddo + + + ! Single and double beta excitations + ! ================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + kcol = psi_bilinear_matrix_columns(k_a) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + spindet(1:$N_int) = tmp_det(1:$N_int,2) + + ! Initial determinant is at k_b in beta-major representation + ! ----------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + ! Loop inside the alpha row to gather all the connected betas + lrow = psi_bilinear_matrix_transp_rows(k_b) + l_b = psi_bilinear_matrix_transp_rows_loc(lrow) + !DIR$ LOOP COUNT avg(200000) + do i=1,N_det_beta_unique + if (l_b > N_det) exit + lrow = psi_bilinear_matrix_transp_rows(l_b) + if (lrow /= krow) exit + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol) + idx(i) = l_b + l_b = l_b+1 + enddo + i = i-1 + + call get_all_spin_singles_and_doubles_$N_int( & + buffer, idx, spindet, i, & + singles_b, doubles, n_singles_b, n_doubles ) + + ! Compute Hij for all beta singles + ! ---------------------------------- + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + !DIR$ LOOP COUNT avg(1000) + do i=1,n_singles_b,block_size + do kk=0,block_size-1 + if (i+kk > n_singles_b) exit + l_b = singles_b(i+kk) + ASSERT (l_b <= N_det) + + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + + do l=1,N_st + utl(l,kk+1) = u_t(l,l_a) + enddo + enddo + + do kk=0,block_size-1 + if (i+kk > n_singles_b) exit + l_b = singles_b(i+kk) + l_a = psi_bilinear_matrix_transp_order(l_b) + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) + call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 2, hij) + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) + ! single => sij = 0 + enddo + enddo + enddo + + ! Compute Hij for all beta doubles + ! ---------------------------------- + + !DIR$ LOOP COUNT avg(50000) + do i=1,n_doubles,block_size + do kk=0,block_size-1 + if (i+kk > n_doubles) exit + l_b = doubles(i+kk) + ASSERT (l_b <= N_det) + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + + do l=1,N_st + utl(l,kk+1) = u_t(l,l_a) + enddo + enddo + + do kk=0,block_size-1 + if (i+kk > n_doubles) exit + l_b = doubles(i+kk) + l_a = psi_bilinear_matrix_transp_order(l_b) + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) + + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) + ! same spin => sij = 0 + enddo + enddo + enddo + + + ! Diagonal contribution + ! ===================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + double precision, external :: diag_H_mat_elem, diag_S_mat_elem + + hij = diag_H_mat_elem(tmp_det,$N_int) + sij = diag_S_mat_elem(tmp_det,$N_int) + !DIR$ LOOP COUNT AVG(4) + do l=1,N_st + v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a) + s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a) + enddo + + end do + !$OMP END DO + deallocate(buffer, singles_a, singles_b, doubles, idx, utl) + !$OMP END PARALLEL + +end + +SUBST [ N_int ] + +1;; +2;; +3;; +4;; +N_int;; + +END_TEMPLATE + + diff --git a/src/utils/transpose.irp.f b/src/utils/transpose.irp.f index 7c86f458..ddffb172 100644 --- a/src/utils/transpose.irp.f +++ b/src/utils/transpose.irp.f @@ -84,3 +84,100 @@ recursive subroutine dtranspose(A,LDA,B,LDB,d1,d2) end + +!DIR$ attributes forceinline :: cdtranspose +recursive subroutine cdtranspose(A,LDA,B,LDB,d1,d2) + implicit none + BEGIN_DOC +! Transpose input matrix A into output matrix B +! don't take complex conjugate + END_DOC + integer, intent(in) :: d1, d2, LDA, LDB + complex*16, intent(in) :: A(LDA,d2) + complex*16, intent(out) :: B(LDB,d1) + + +! do j=1,d1 +! do i=1,d2 +! B(i,j ) = A(j ,i) +! enddo +! enddo +! return + + integer :: i,j,k + if ( d2 < 32 ) then + do j=1,d1 + !DIR$ LOOP COUNT (16) + do i=1,d2 + B(i,j ) = A(j ,i) + enddo + enddo + return + else if (d1 > d2) then + !DIR$ forceinline + k=d1/2 + !DIR$ forceinline recursive + call cdtranspose(A(1,1),LDA,B(1,1),LDB,k,d2) + !DIR$ forceinline recursive + call cdtranspose(A(k+1,1),LDA,B(1,k+1),LDB,d1-k,d2) + return + else + !DIR$ forceinline + k=d2/2 + !DIR$ forceinline recursive + call cdtranspose(A(1,k+1),LDA,B(k+1,1),LDB,d1,d2-k) + !DIR$ forceinline recursive + call cdtranspose(A(1,1),LDA,B(1,1),LDB,d1,k) + return + endif + +end + +!DIR$ attributes forceinline :: cdadjoint +recursive subroutine cdadjoint(A,LDA,B,LDB,d1,d2) + implicit none + BEGIN_DOC +! Transpose input matrix A into output matrix B +! and take complex conjugate + END_DOC + integer, intent(in) :: d1, d2, LDA, LDB + complex*16, intent(in) :: A(LDA,d2) + complex*16, intent(out) :: B(LDB,d1) + + +! do j=1,d1 +! do i=1,d2 +! B(i,j ) = A(j ,i) +! enddo +! enddo +! return + + integer :: i,j,k + if ( d2 < 32 ) then + do j=1,d1 + !DIR$ LOOP COUNT (16) + do i=1,d2 + B(i,j ) = conjg(A(j ,i)) + enddo + enddo + return + else if (d1 > d2) then + !DIR$ forceinline + k=d1/2 + !DIR$ forceinline recursive + call cdadjoint(A(1,1),LDA,B(1,1),LDB,k,d2) + !DIR$ forceinline recursive + call cdadjoint(A(k+1,1),LDA,B(1,k+1),LDB,d1-k,d2) + return + else + !DIR$ forceinline + k=d2/2 + !DIR$ forceinline recursive + call cdadjoint(A(1,k+1),LDA,B(k+1,1),LDB,d1,d2-k) + !DIR$ forceinline recursive + call cdadjoint(A(1,1),LDA,B(1,1),LDB,d1,k) + return + endif + +end + diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 9f3598e3..730a3970 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,6 +1,11 @@ ------------------------------------------------------------------------------------- current: + + irp_align for complex? + zmq_put_psi_complex instead of branch inside zmq_put_psi? + are there cases where we call this without already being on a complex branch of code? + h_apply.irp.f push/pull_pt2 pt2,norm_pert,h_pert_diag @@ -83,6 +88,27 @@ determinants: and broadcast_chunks_complex_double in mpi/mpi.irp.f +davidson + (****) davidson_parallel.irp.f + davidson_slave_work + branch inside or outside? + (currently inside) + same broadcast size issue as in h_apply (2^23 elements) + needs h_s2_u_0_nstates_openmp_work_complex (be careful with transp/conjg) + needs davidson_push_results_async_send_complex + davidson_pu{sh,ll}_results{,_async_send}_complex + double sz? + does f77_zmq_send8 know about types, or just send raw data? + davidson_collector_complex + is {v,s}_t conjugate transpose or just transpose? + (****) diagonalization_hs2_dressed.irp.f + (****) diagonalize_ci.irp.f + (****) EZFIO.cfg + (****) ezfio_interface.irp.f + (****) input.irp.f + (****) print_e_components.irp.f + (****) u0_h_u0.irp.f + (****) u0_wee_u0.irp.f ------------------------------------------------------------------------------------- for complex data, add extra dim (size 2) and treat as real in EZFIO.cfg @@ -496,6 +522,3 @@ src/scf_utils/scf_density_matrix_ao_complex.irp.f [ complex*16, SCF_density_matrix_ao_complex, (ao_num,ao_num) ] - - - From 102d930452ab99069aa0e948a9054e27e610766e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 16:19:07 -0600 Subject: [PATCH 116/256] complex qr --- src/utils/linear_algebra.irp.f | 61 ++++++++++++++++++++++++++-------- 1 file changed, 48 insertions(+), 13 deletions(-) diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index 93b367aa..84985a53 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -167,7 +167,7 @@ subroutine ortho_canonical_complex(overlap,LDA,N,C,LDC,m) end -subroutine ortho_qr_complex(A,LDA,m,n) +subroutine ortho_qr_complex_old(A,LDA,m,n) implicit none BEGIN_DOC ! Orthogonalization using Q.R factorization @@ -199,6 +199,45 @@ subroutine ortho_qr_complex(A,LDA,m,n) deallocate(WORK,jpvt,tau) end +subroutine ortho_qr_complex(A,LDA,m,n) + implicit none + BEGIN_DOC + ! Orthogonalization using Q.R factorization + ! + ! A : matrix to orthogonalize + ! + ! LDA : leftmost dimension of A + ! + ! n : Number of columns? of A + ! + ! m : Number of rows? of A + ! + END_DOC + integer, intent(in) :: m,n, LDA + complex*16, intent(inout) :: A(LDA,n) + + integer :: lwork, info + complex*16, allocatable :: tau(:), work(:) + + allocate(tau(n), work(1)) + lwork=-1 + call zgeqrf( m, n, A, LDA, tau, work, lwork, info ) + lwork=int(work(1)) + deallocate(work) + allocate(work(lwork)) + call zgeqrf(m, n, A, LDA, tau, work, lwork, info ) + deallocate(work) + + lwork=-1 + allocate(work(1)) + call zungqr(m, n, n, A, LDA, tau, work, lwork, info) + lwork=int(work(1)) + deallocate(work) + allocate(work(lwork)) + call zungqr(m, n, n, A, LDA, tau, work, lwork, info) + deallocate(work,tau) +end + subroutine ortho_qr_unblocked_complex(A,LDA,m,n) implicit none BEGIN_DOC @@ -208,25 +247,21 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n) ! ! LDA : leftmost dimension of A ! - ! n : Number of rows of A + ! n : Number of columns of A ! - ! m : Number of columns of A + ! m : Number of rows of A ! END_DOC integer, intent(in) :: m,n, LDA - double precision, intent(inout) :: A(LDA,n) + complex*16, intent(inout) :: A(LDA,n) integer :: info - integer, allocatable :: jpvt(:) - double precision, allocatable :: tau(:), work(:) + complex*16, allocatable :: tau(:), work(:) - print *, irp_here, ': TO DO' - stop -1 - -! allocate (jpvt(n), tau(n), work(n)) -! call dgeqr2( m, n, A, LDA, TAU, WORK, INFO ) -! call dorg2r(m, n, n, A, LDA, tau, WORK, INFO) -! deallocate(WORK,jpvt,tau) + allocate(tau(n),work(n)) + call zgeqr2(m,n,A,LDA,tau,work,info) + call zung2r(m,n,n,A,LDA,tau,work,info) + deallocate(work,tau) end subroutine ortho_lowdin_complex(overlap,LDA,N,C,LDC,m) From 9ea4377f07a62b61918e4a156d1219ae8b5a6eab Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 25 Feb 2020 17:52:34 -0600 Subject: [PATCH 117/256] working on complex davidson --- src/davidson/davidson_parallel.irp.f | 1 + .../diagonalization_hs2_dressed.irp.f | 699 ++++++++++++++++++ src/davidson/u0_h_u0.irp.f | 73 +- 3 files changed, 743 insertions(+), 30 deletions(-) diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index b98ec377..e898585f 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -104,6 +104,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, ! integer, external :: zmq_get_dvector integer, external :: zmq_get_dmatrix + integer, external :: zmq_get_cdmatrix if (is_complex) then complex*16, allocatable :: v_tc(:,:), s_tc(:,:), u_tc(:,:) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index a5e85777..2c4888cc 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -33,9 +33,16 @@ BEGIN_PROVIDER [ integer, dressed_column_idx, (N_states) ] integer :: i double precision :: tmp integer, external :: idamax + if (is_complex) then + do i=1,N_states + !todo: check for complex + dressed_column_idx(i) = idamax(N_det, cdabs(psi_coef_complex(1,i)), 1) + enddo + else do i=1,N_states dressed_column_idx(i) = idamax(N_det, psi_coef(1,i), 1) enddo + endif END_PROVIDER subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged) @@ -721,7 +728,699 @@ end +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged) + print*,irp_here,' not implemented for complex' + stop -1 + use bitmasks + implicit none + BEGIN_DOC + ! Davidson diagonalization. + ! + ! dets_in : bitmasks corresponding to determinants + ! + ! u_in : guess coefficients on the various states. Overwritten + ! on exit + ! + ! dim_in : leftmost dimension of u_in + ! + ! sze : Number of determinants + ! + ! N_st : Number of eigenstates + ! + ! Initial guess vectors are not necessarily orthonormal + END_DOC + integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint + integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) + complex*16, intent(inout) :: u_in(dim_in,N_st_diag) + double precision, intent(out) :: energies(N_st_diag), s2_out(N_st_diag) + integer, intent(in) :: dressing_state + logical, intent(out) :: converged + double precision, allocatable :: H_jj(:) + + double precision, external :: diag_H_mat_elem, diag_S_mat_elem + integer :: i,k + ASSERT (N_st > 0) + ASSERT (sze > 0) + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + PROVIDE mo_two_e_integrals_in_map + allocate(H_jj(sze)) + + H_jj(1) = diag_h_mat_elem(dets_in(1,1,1),Nint) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(sze,H_jj, dets_in,Nint) & + !$OMP PRIVATE(i) + !$OMP DO SCHEDULE(static) + do i=2,sze + H_jj(i) = diag_H_mat_elem(dets_in(1,1,i),Nint) + enddo + !$OMP END DO + !$OMP END PARALLEL + + if (dressing_state > 0) then + print*,irp_here,' not implemented for complex if dressing_state > 0' + stop -1 + do k=1,N_st + do i=1,sze + H_jj(i) += dble(u_in(i,k) * dressing_column_h(i,k)) + enddo + enddo + endif + + call davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,S2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,dressing_state,converged) + deallocate (H_jj) +end +subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag_in,Nint,dressing_state,converged) + print*,irp_here,' not implemented for complex' + stop -1 +! use bitmasks +! use mmap_module +! implicit none +! BEGIN_DOC +! ! Davidson diagonalization with specific diagonal elements of the H matrix +! ! +! ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson +! ! +! ! S2_out : Output : s^2 +! ! +! ! dets_in : bitmasks corresponding to determinants +! ! +! ! u_in : guess coefficients on the various states. Overwritten +! ! on exit +! ! +! ! dim_in : leftmost dimension of u_in +! ! +! ! sze : Number of determinants +! ! +! ! N_st : Number of eigenstates +! ! +! ! N_st_diag_in : Number of states in which H is diagonalized. Assumed > sze +! ! +! ! Initial guess vectors are not necessarily orthonormal +! END_DOC +! integer, intent(in) :: dim_in, sze, N_st, N_st_diag_in, Nint +! integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) +! double precision, intent(in) :: H_jj(sze) +! integer, intent(in) :: dressing_state +! double precision, intent(inout) :: s2_out(N_st_diag_in) +! complex*16, intent(inout) :: u_in(dim_in,N_st_diag_in) +! double precision, intent(out) :: energies(N_st_diag_in) +! +! integer :: iter, N_st_diag +! integer :: i,j,k,l,m +! logical, intent(inout) :: converged +! +! double precision, external :: u_dot_u_complex +! complex*16, external :: u_dot_v_complex +! +! integer :: k_pairs, kl +! +! integer :: iter2, itertot +! double precision, allocatable :: y(:,:), h(:,:), h_p(:,:), lambda(:), s2(:) +! real, allocatable :: y_s(:,:) +! double precision, allocatable :: s_(:,:), s_tmp(:,:) +! double precision :: diag_h_mat_elem +! double precision, allocatable :: residual_norm(:) +! character*(16384) :: write_buffer +! double precision :: to_print(3,N_st) +! double precision :: cpu, wall +! integer :: shift, shift2, itermax, istate +! double precision :: r1, r2, alpha +! logical :: state_ok(N_st_diag_in*davidson_sze_max) +! integer :: nproc_target +! integer :: order(N_st_diag_in) +! double precision :: cmax +! double precision, allocatable :: U(:,:), overlap(:,:), S_d(:,:) +! double precision, pointer :: W(:,:) +! real, pointer :: S(:,:) +! logical :: disk_based +! double precision :: energy_shift(N_st_diag_in*davidson_sze_max) +! +! include 'constants.include.F' +! +! N_st_diag = N_st_diag_in +! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, y_s, S_d, h, lambda +! if (N_st_diag*3 > sze) then +! print *, 'error in Davidson :' +! print *, 'Increase n_det_max_full to ', N_st_diag*3 +! stop -1 +! endif +! +! itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1 +! itertot = 0 +! +! if (state_following) then +! allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) +! else +! allocate(overlap(1,1)) ! avoid 'if' for deallocate +! endif +! overlap = 0.d0 +! +! PROVIDE nuclear_repulsion expected_s2 psi_bilinear_matrix_order psi_bilinear_matrix_order_reverse threshold_davidson_pt2 +! +! call write_time(6) +! write(6,'(A)') '' +! write(6,'(A)') 'Davidson Diagonalization' +! write(6,'(A)') '------------------------' +! write(6,'(A)') '' +! +! ! Find max number of cores to fit in memory +! ! ----------------------------------------- +! +! nproc_target = nproc +! double precision :: rss +! integer :: maxab +! maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 +! +! m=1 +! disk_based = .False. +! call resident_memory(rss) +! do +! r1 = 8.d0 * &! bytes +! ( dble(sze)*(N_st_diag*itermax) &! U +! + 1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S +! + 1.d0*dble(sze)*(N_st_diag) &! S_d +! + 4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp +! + 2.d0*(N_st_diag*itermax) &! s2,lambda +! + 1.d0*(N_st_diag) &! residual_norm +! ! In H_S2_u_0_nstates_zmq +! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector +! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave +! + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_* +! + nproc_target * &! In OMP section +! ( 1.d0*(N_int*maxab) &! buffer +! + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx +! ) / 1024.d0**3 +! +! if (nproc_target == 0) then +! call check_mem(r1,irp_here) +! nproc_target = 1 +! exit +! endif +! +! if (r1+rss < qp_max_mem) then +! exit +! endif +! +! if (itermax > 4) then +! itermax = itermax - 1 +! else if (m==1.and.disk_based_davidson) then +! m=0 +! disk_based = .True. +! itermax = 6 +! else +! nproc_target = nproc_target - 1 +! endif +! +! enddo +! nthreads_davidson = nproc_target +! TOUCH nthreads_davidson +! call write_int(6,N_st,'Number of states') +! call write_int(6,N_st_diag,'Number of states in diagonalization') +! call write_int(6,sze,'Number of determinants') +! call write_int(6,nproc_target,'Number of threads for diagonalization') +! call write_double(6, r1, 'Memory(Gb)') +! if (disk_based) then +! print *, 'Using swap space to reduce RAM' +! endif +! +! !--------------- +! +! write(6,'(A)') '' +! write_buffer = '=====' +! do i=1,N_st +! write_buffer = trim(write_buffer)//' ================ =========== ===========' +! enddo +! write(6,'(A)') write_buffer(1:6+41*N_st) +! write_buffer = 'Iter' +! do i=1,N_st +! write_buffer = trim(write_buffer)//' Energy S^2 Residual ' +! enddo +! write(6,'(A)') write_buffer(1:6+41*N_st) +! write_buffer = '=====' +! do i=1,N_st +! write_buffer = trim(write_buffer)//' ================ =========== ===========' +! enddo +! write(6,'(A)') write_buffer(1:6+41*N_st) +! +! +! if (disk_based) then +! ! Create memory-mapped files for W and S +! type(c_ptr) :: ptr_w, ptr_s +! integer :: fd_s, fd_w +! call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),& +! 8, fd_w, .False., ptr_w) +! call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),& +! 4, fd_s, .False., ptr_s) +! call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) +! call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) +! else +! allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) +! endif +! +! allocate( & +! ! Large +! U(sze,N_st_diag*itermax), & +! S_d(sze,N_st_diag), & +! +! ! Small +! h(N_st_diag*itermax,N_st_diag*itermax), & +! h_p(N_st_diag*itermax,N_st_diag*itermax), & +! y(N_st_diag*itermax,N_st_diag*itermax), & +! s_(N_st_diag*itermax,N_st_diag*itermax), & +! s_tmp(N_st_diag*itermax,N_st_diag*itermax), & +! residual_norm(N_st_diag), & +! s2(N_st_diag*itermax), & +! y_s(N_st_diag*itermax,N_st_diag*itermax), & +! lambda(N_st_diag*itermax)) +! +! h = 0.d0 +! U = 0.d0 +! y = 0.d0 +! s_ = 0.d0 +! s_tmp = 0.d0 +! +! +! ASSERT (N_st > 0) +! ASSERT (N_st_diag >= N_st) +! ASSERT (sze > 0) +! ASSERT (Nint > 0) +! ASSERT (Nint == N_int) +! +! ! Davidson iterations +! ! =================== +! +! converged = .False. +! +! do k=N_st+1,N_st_diag +! u_in(k,k) = 10.d0 +! do i=1,sze +! call random_number(r1) +! call random_number(r2) +! r1 = dsqrt(-2.d0*dlog(r1)) +! r2 = dtwo_pi*r2 +! !u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) +! u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) +! enddo +! enddo +! do k=1,N_st_diag +! call normalize_complex(u_in(1,k),sze) +! enddo +! +! do k=1,N_st_diag +! do i=1,sze +! U(i,k) = u_in(i,k) +! enddo +! enddo +! +! +! do while (.not.converged) +! itertot = itertot+1 +! if (itertot == 8) then +! exit +! endif +! +! do iter=1,itermax-1 +! +! shift = N_st_diag*(iter-1) +! shift2 = N_st_diag*iter +! +! if ((iter > 1).or.(itertot == 1)) then +! ! Compute |W_k> = \sum_i |i> +! ! ----------------------------------- +! +! if (disk_based) then +! call ortho_qr_unblocked(U,size(U,1),sze,shift2) +! call ortho_qr_unblocked(U,size(U,1),sze,shift2) +! else +! call ortho_qr(U,size(U,1),sze,shift2) +! call ortho_qr(U,size(U,1),sze,shift2) +! endif +! +! if ((sze > 100000).and.distributed_davidson) then +! call H_S2_u_0_nstates_zmq (W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) +! else +! call H_S2_u_0_nstates_openmp(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) +! endif +! S(1:sze,shift+1:shift+N_st_diag) = real(S_d(1:sze,1:N_st_diag)) +! else +! ! Already computed in update below +! continue +! endif +! +! if (dressing_state > 0) then +! +! if (N_st == 1) then +! +! l = dressed_column_idx(1) +! double precision :: f +! f = 1.0d0/psi_coef(l,1) +! do istate=1,N_st_diag +! do i=1,sze +! W(i,shift+istate) += dressing_column_h(i,1) *f * U(l,shift+istate) +! W(l,shift+istate) += dressing_column_h(i,1) *f * U(i,shift+istate) +! S(i,shift+istate) += real(dressing_column_s(i,1) *f * U(l,shift+istate)) +! S(l,shift+istate) += real(dressing_column_s(i,1) *f * U(i,shift+istate)) +! enddo +! +! enddo +! +! else +! +! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +! psi_coef, size(psi_coef,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), & +! 1.d0, S_d, size(S_d,1)) +! +! +! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +! dressing_column_h, size(dressing_column_h,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) +! +! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +! dressing_column_s, size(dressing_column_s,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +! 1.d0, S_d, size(S_d,1)) +! +! endif +! endif +! +! ! Compute s_kl = = +! ! ------------------------------------------- +! +! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k) COLLAPSE(2) +! do j=1,shift2 +! do i=1,shift2 +! s_(i,j) = 0.d0 +! do k=1,sze +! s_(i,j) = s_(i,j) + U(k,i) * dble(S(k,j)) +! enddo +! enddo +! enddo +! !$OMP END PARALLEL DO +! +! ! Compute h_kl = = +! ! ------------------------------------------- +! +! call dgemm('T','N', shift2, shift2, sze, & +! 1.d0, U, size(U,1), W, size(W,1), & +! 0.d0, h, size(h_p,1)) +! +! ! Penalty method +! ! -------------- +! +! if (s2_eig) then +! h_p = s_ +! do k=1,shift2 +! h_p(k,k) = h_p(k,k) + S_z2_Sz - expected_s2 +! enddo +! if (only_expected_s2) then +! alpha = 0.1d0 +! h_p = h + alpha*h_p +! else +! alpha = 0.0001d0 +! h_p = h + alpha*h_p +! endif +! else +! h_p = h +! alpha = 0.d0 +! endif +! +! ! Diagonalize h_p +! ! --------------- +! +! call lapack_diag(lambda,y,h_p,size(h_p,1),shift2) +! +! ! Compute Energy for each eigenvector +! ! ----------------------------------- +! +! call dgemm('N','N',shift2,shift2,shift2, & +! 1.d0, h, size(h,1), y, size(y,1), & +! 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('T','N',shift2,shift2,shift2, & +! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & +! 0.d0, h, size(h,1)) +! +! do k=1,shift2 +! lambda(k) = h(k,k) +! enddo +! +! ! Compute S2 for each eigenvector +! ! ------------------------------- +! +! call dgemm('N','N',shift2,shift2,shift2, & +! 1.d0, s_, size(s_,1), y, size(y,1), & +! 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('T','N',shift2,shift2,shift2, & +! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & +! 0.d0, s_, size(s_,1)) +! +! do k=1,shift2 +! s2(k) = s_(k,k) + S_z2_Sz +! enddo +! +! if (only_expected_s2) then +! do k=1,shift2 +! state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) +! enddo +! else +! do k=1,size(state_ok) +! state_ok(k) = .True. +! enddo +! endif +! +! do k=1,shift2 +! if (.not. state_ok(k)) then +! do l=k+1,shift2 +! if (state_ok(l)) then +! call dswap(shift2, y(1,k), 1, y(1,l), 1) +! call dswap(1, s2(k), 1, s2(l), 1) +! call dswap(1, lambda(k), 1, lambda(l), 1) +! state_ok(k) = .True. +! state_ok(l) = .False. +! exit +! endif +! enddo +! endif +! enddo +! +! if (state_following) then +! +! overlap = -1.d0 +! do k=1,shift2 +! do i=1,shift2 +! overlap(k,i) = dabs(y(k,i)) +! enddo +! enddo +! do k=1,N_st +! cmax = -1.d0 +! do i=1,N_st +! if (overlap(i,k) > cmax) then +! cmax = overlap(i,k) +! order(k) = i +! endif +! enddo +! do i=1,N_st_diag +! overlap(order(k),i) = -1.d0 +! enddo +! enddo +! overlap = y +! do k=1,N_st +! l = order(k) +! if (k /= l) then +! y(1:shift2,k) = overlap(1:shift2,l) +! endif +! enddo +! do k=1,N_st +! overlap(k,1) = lambda(k) +! overlap(k,2) = s2(k) +! enddo +! do k=1,N_st +! l = order(k) +! if (k /= l) then +! lambda(k) = overlap(l,1) +! s2(k) = overlap(l,2) +! endif +! enddo +! +! endif +! +! +! ! Express eigenvectors of h in the determinant basis +! ! -------------------------------------------------- +! +! call dgemm('N','N', sze, N_st_diag, shift2, & +! 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) +! call dgemm('N','N', sze, N_st_diag, shift2, & +! 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) +! +! y_s(:,:) = real(y(:,:)) +! call sgemm('N','N', sze, N_st_diag, shift2, & +! 1., S, size(S,1), y_s, size(y_s,1), 0., S(1,shift2+1), size(S,1)) +! +! ! Compute residual vector and davidson step +! ! ----------------------------------------- +! +! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) +! do k=1,N_st_diag +! do i=1,sze +! U(i,shift2+k) = & +! (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & +! /max(H_jj(i) - lambda (k),1.d-2) +! enddo +! +! if (k <= N_st) then +! residual_norm(k) = u_dot_u_complex(U(1,shift2+k),sze) +! to_print(1,k) = lambda(k) + nuclear_repulsion +! to_print(2,k) = s2(k) +! to_print(3,k) = residual_norm(k) +! endif +! enddo +! !$OMP END PARALLEL DO +! +! +! if ((itertot>1).and.(iter == 1)) then +! !don't print +! continue +! else +! write(*,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter-1, to_print(1:3,1:N_st) +! endif +! +! ! Check convergence +! if (iter > 1) then +! converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson_pt2 +! endif +! +! +! do k=1,N_st +! if (residual_norm(k) > 1.e8) then +! print *, 'Davidson failed' +! stop -1 +! endif +! enddo +! if (converged) then +! exit +! endif +! +! logical, external :: qp_stop +! if (qp_stop()) then +! converged = .True. +! exit +! endif +! +! +! enddo +! +! ! Re-contract U and update S and W +! ! -------------------------------- +! +! call sgemm('N','N', sze, N_st_diag, shift2, 1., & +! S, size(S,1), y_s, size(y_s,1), 0., S(1,shift2+1), size(S,1)) +! do k=1,N_st_diag +! do i=1,sze +! S(i,k) = S(i,shift2+k) +! enddo +! enddo +! +! call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & +! W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) +! do k=1,N_st_diag +! do i=1,sze +! W(i,k) = u_in(i,k) +! enddo +! enddo +! +! call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & +! U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) +! do k=1,N_st_diag +! do i=1,sze +! U(i,k) = u_in(i,k) +! enddo +! enddo +! if (disk_based) then +! call ortho_qr_unblocked(U,size(U,1),sze,N_st_diag) +! call ortho_qr_unblocked(U,size(U,1),sze,N_st_diag) +! else +! call ortho_qr(U,size(U,1),sze,N_st_diag) +! call ortho_qr(U,size(U,1),sze,N_st_diag) +! endif +! do j=1,N_st_diag +! k=1 +! do while ((k sij = 0 enddo @@ -1245,9 +1252,11 @@ compute_singles=.True. lrow = psi_bilinear_matrix_rows(l_a) ASSERT (lrow <= N_det_alpha_unique) - call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) + !todo: check arg order conjg/noconjg + call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st + !todo: check arg order conjg/noconjg v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! same spin => sij = 0 enddo @@ -1324,9 +1333,10 @@ compute_singles=.True. ASSERT (lcol <= N_det_beta_unique) tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) - call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 2, hij) + call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st + !todo: check arg order conjg/noconjg v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! single => sij = 0 enddo @@ -1357,10 +1367,12 @@ compute_singles=.True. lcol = psi_bilinear_matrix_transp_columns(l_b) ASSERT (lcol <= N_det_beta_unique) - call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) + !todo: check arg order conjg/noconjg + call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st + !todo: check arg order conjg/noconjg v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! same spin => sij = 0 enddo @@ -1386,10 +1398,11 @@ compute_singles=.True. double precision, external :: diag_H_mat_elem, diag_S_mat_elem - hij = diag_H_mat_elem(tmp_det,$N_int) - sij = diag_S_mat_elem(tmp_det,$N_int) + hij = dcmplx(diag_H_mat_elem(tmp_det,$N_int),0.d0) + sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0) !DIR$ LOOP COUNT AVG(4) do l=1,N_st + !todo: check arg order conjg/noconjg v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a) s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a) enddo From 273200c829b47e3909e0318b39400d6da9742e26 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 26 Feb 2020 10:44:40 +0100 Subject: [PATCH 118/256] save before merge --- REPLACE | 76 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 39 insertions(+), 37 deletions(-) diff --git a/REPLACE b/REPLACE index 8ec6d09d..31d939f8 100755 --- a/REPLACE +++ b/REPLACE @@ -835,40 +835,42 @@ qp_name potential_sr_c_beta_ao_pbe --rename=potential_c_beta_ao_sr_pbe qp_name potential_sr_xc_alpha_ao_pbe --rename=potential_xc_alpha_ao_sr_pbe qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe qp_name disk_access_nuclear_repulsion --rename=io_nuclear_repulsion -qp_name nucl_elec_ref_bitmask_energy -r ref_bitmask_n_e_energy -qp_name ref_bitmask_e_n_energy -r ref_bitmask_n_e_energy -qp_name read_ao_integrals_e_n -r read_ao_integrals_n_e -qp_name write_ao_integrals_e_n -r write_ao_integrals_n_e -qp_name is_periodic -r is_complex -qp_name two_e_integrals_index_periodic -r two_e_integrals_index_complex -qp_name get_ao_two_e_integral_periodic -r get_ao_two_e_integral_complex -qp_name import_ao_integrals_periodic -r import_ao_integrals_complex -qp_name ao_two_e_integral_periodic_map_idx_sign -r ao_two_e_integral_complex_map_idx_sign -qp_name ao_ints_periodic_1 -r ao_ints_complex_1 -qp_name ao_ints_periodic_2 -r ao_ints_complex_2 -qp_name import_mo_coef_periodic -r import_mo_coef_complex -qp_name is_periodic -r is_complex -qp_name get_ao_two_e_integral_periodic_simple -r get_ao_two_e_integral_complex_simple -qp_name ao_integrals_cache_periodic -r ao_integrals_cache_complex -qp_name get_two_e_integral_periodic -r get_two_e_integral_complex -qp_name get_ao_two_e_integrals_non_zero_periodic -r get_ao_two_e_integrals_non_zero_complex -qp_name get_mo_two_e_integrals_exch_ii_periodic -r get_mo_two_e_integrals_exch_ii_complex -qp_name mo_ints_periodic_2 -r mo_ints_complex_2 -qp_name mo_ints_periodic_1 -r mo_ints_complex_1 -qp_name get_mo_two_e_integrals_i1j1_periodic -r get_mo_two_e_integrals_i1j1_complex -qp_name get_mo_two_e_integrals_exch_ijji_periodic -r get_mo_two_e_integrals_exch_ijji_complex -qp_name get_mo_two_e_integrals_periodic -r get_mo_two_e_integrals_complex -qp_name mo_integrals_cache_periodic -r mo_integrals_cache_complex -qp_name get_two_e_integral_periodic_simple -r get_two_e_integral_complex_simple -qp_name big_array_coulomb_integrals_periodic -r big_array_coulomb_integrals_complex -qp_name big_array_exchange_integrals_periodic -r big_array_exchange_integrals_complex -qp_name get_ao_two_e_integrals_periodic -r get_ao_two_e_integrals_complex -qp_name get_ao_two_e_integrals_non_zero_jl_periodic -r get_ao_two_e_integrals_non_zero_jl_complex -qp_name get_ao_two_e_integrals_non_zero_jl_from_list_periodic -r get_ao_two_e_integrals_non_zero_jl_from_list_complex -qp_name mo_two_e_integral_periodic -r mo_two_e_integral_complex -qp_name get_mo_two_e_integrals_ij_periodic -r get_mo_two_e_integrals_ij_complex -qp_name get_mo_two_e_integrals_coulomb_ii_periodic -r get_mo_two_e_integrals_coulomb_ii_complex -qp_name get_mo_two_e_integrals_coulomb_ijij_periodic -r get_mo_two_e_integrals_coulomb_ijij_complex -qp_name ao_kpt_num -r ao_num_per_kpt -qp_name mo_kpt_num -r mo_num_per_kpt -qp_name num_kpts -r kpt_num + + +# qp_name nucl_elec_ref_bitmask_energy -r ref_bitmask_n_e_energy +# qp_name ref_bitmask_e_n_energy -r ref_bitmask_n_e_energy +# qp_name read_ao_integrals_e_n -r read_ao_integrals_n_e +# qp_name write_ao_integrals_e_n -r write_ao_integrals_n_e +# qp_name is_periodic -r is_complex +# qp_name two_e_integrals_index_periodic -r two_e_integrals_index_complex +# qp_name get_ao_two_e_integral_periodic -r get_ao_two_e_integral_complex +# qp_name import_ao_integrals_periodic -r import_ao_integrals_complex +# qp_name ao_two_e_integral_periodic_map_idx_sign -r ao_two_e_integral_complex_map_idx_sign +# qp_name ao_ints_periodic_1 -r ao_ints_complex_1 +# qp_name ao_ints_periodic_2 -r ao_ints_complex_2 +# qp_name import_mo_coef_periodic -r import_mo_coef_complex +# qp_name is_periodic -r is_complex +# qp_name get_ao_two_e_integral_periodic_simple -r get_ao_two_e_integral_complex_simple +# qp_name ao_integrals_cache_periodic -r ao_integrals_cache_complex +# qp_name get_two_e_integral_periodic -r get_two_e_integral_complex +# qp_name get_ao_two_e_integrals_non_zero_periodic -r get_ao_two_e_integrals_non_zero_complex +# qp_name get_mo_two_e_integrals_exch_ii_periodic -r get_mo_two_e_integrals_exch_ii_complex +# qp_name mo_ints_periodic_2 -r mo_ints_complex_2 +# qp_name mo_ints_periodic_1 -r mo_ints_complex_1 +# qp_name get_mo_two_e_integrals_i1j1_periodic -r get_mo_two_e_integrals_i1j1_complex +# qp_name get_mo_two_e_integrals_exch_ijji_periodic -r get_mo_two_e_integrals_exch_ijji_complex +# qp_name get_mo_two_e_integrals_periodic -r get_mo_two_e_integrals_complex +# qp_name mo_integrals_cache_periodic -r mo_integrals_cache_complex +# qp_name get_two_e_integral_periodic_simple -r get_two_e_integral_complex_simple +# qp_name big_array_coulomb_integrals_periodic -r big_array_coulomb_integrals_complex +# qp_name big_array_exchange_integrals_periodic -r big_array_exchange_integrals_complex +# qp_name get_ao_two_e_integrals_periodic -r get_ao_two_e_integrals_complex +# qp_name get_ao_two_e_integrals_non_zero_jl_periodic -r get_ao_two_e_integrals_non_zero_jl_complex +# qp_name get_ao_two_e_integrals_non_zero_jl_from_list_periodic -r get_ao_two_e_integrals_non_zero_jl_from_list_complex +# qp_name mo_two_e_integral_periodic -r mo_two_e_integral_complex +# qp_name get_mo_two_e_integrals_ij_periodic -r get_mo_two_e_integrals_ij_complex +# qp_name get_mo_two_e_integrals_coulomb_ii_periodic -r get_mo_two_e_integrals_coulomb_ii_complex +# qp_name get_mo_two_e_integrals_coulomb_ijij_periodic -r get_mo_two_e_integrals_coulomb_ijij_complex +# qp_name ao_kpt_num -r ao_num_per_kpt +# qp_name mo_kpt_num -r mo_num_per_kpt +# qp_name num_kpts -r kpt_num From 6b3593bf745d2d0e7986622cf05bf046bac3e9eb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 26 Feb 2020 13:14:25 -0600 Subject: [PATCH 119/256] complex diagonalize_ci --- src/davidson/diagonalize_ci.irp.f | 254 +++++++++++++++++++++++++++--- 1 file changed, 235 insertions(+), 19 deletions(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 8339406f..156d8521 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -20,8 +20,21 @@ BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ] END_PROVIDER BEGIN_PROVIDER [ double precision, CI_electronic_energy, (N_states_diag) ] -&BEGIN_PROVIDER [ double precision, CI_eigenvectors, (N_det,N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_s2, (N_states_diag) ] + implicit none + if (is_complex) then + ci_s2(1:N_states_diag) = ci_s2_complex(1:N_states_diag) + ci_electronic_energy(1:N_states_diag) = ci_electronic_energy_complex(1:N_states_diag) + else + ci_s2(1:N_states_diag) = ci_s2_real(1:N_states_diag) + ci_electronic_energy(1:N_states_diag) = ci_electronic_energy_real(1:N_states_diag) + endif +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, CI_electronic_energy_real, (N_states_diag) ] +&BEGIN_PROVIDER [ double precision, CI_eigenvectors, (N_det,N_states_diag) ] +&BEGIN_PROVIDER [ double precision, CI_s2_real, (N_states_diag) ] BEGIN_DOC ! Eigenvectors/values of the |CI| matrix END_DOC @@ -57,8 +70,8 @@ END_PROVIDER if (diag_algorithm == "Davidson") then - call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_s2, & - size(CI_eigenvectors,1),CI_electronic_energy, & + call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_s2_real, & + size(CI_eigenvectors,1),CI_electronic_energy_real, & N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged) integer :: N_states_diag_save @@ -75,17 +88,17 @@ END_PROVIDER allocate (CI_eigenvectors_tmp (N_det,N_states_diag) ) allocate (CI_s2_tmp (N_states_diag) ) - CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy(1:N_states_diag_save) + CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_real(1:N_states_diag_save) CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors(1:N_det,1:N_states_diag_save) - CI_s2_tmp(1:N_states_diag_save) = CI_s2(1:N_states_diag_save) + CI_s2_tmp(1:N_states_diag_save) = CI_s2_real(1:N_states_diag_save) call davidson_diag_HS2(psi_det,CI_eigenvectors_tmp, CI_s2_tmp, & size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp, & N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged) - CI_electronic_energy(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save) + CI_electronic_energy_real(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save) CI_eigenvectors(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) - CI_s2(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save) + CI_s2_real(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save) deallocate (CI_electronic_energy_tmp) deallocate (CI_eigenvectors_tmp) @@ -110,7 +123,7 @@ END_PROVIDER H_prime(j,j) = H_prime(j,j) + alpha*(S_z2_Sz - expected_s2) enddo call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) - CI_electronic_energy(:) = 0.d0 + CI_electronic_energy_real(:) = 0.d0 i_state = 0 allocate (s2_eigvalues(N_det)) allocate(index_good_state_array(N_det),good_state_array(N_det)) @@ -141,8 +154,8 @@ END_PROVIDER do i=1,N_det CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j)) enddo - CI_electronic_energy(j) = eigenvalues(index_good_state_array(j)) - CI_s2(j) = s2_eigvalues(index_good_state_array(j)) + CI_electronic_energy_real(j) = eigenvalues(index_good_state_array(j)) + CI_s2_real(j) = s2_eigvalues(index_good_state_array(j)) enddo i_other_state = 0 do j = 1, N_det @@ -154,8 +167,8 @@ END_PROVIDER do i=1,N_det CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j) enddo - CI_electronic_energy(i_state+i_other_state) = eigenvalues(j) - CI_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + CI_electronic_energy_real(i_state+i_other_state) = eigenvalues(j) + CI_s2_real(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) enddo else @@ -172,8 +185,8 @@ END_PROVIDER do i=1,N_det CI_eigenvectors(i,j) = eigenvectors(i,j) enddo - CI_electronic_energy(j) = eigenvalues(j) - CI_s2(j) = s2_eigvalues(j) + CI_electronic_energy_real(j) = eigenvalues(j) + CI_s2_real(j) = s2_eigvalues(j) enddo endif deallocate(index_good_state_array,good_state_array) @@ -181,22 +194,22 @@ END_PROVIDER else call lapack_diag(eigenvalues,eigenvectors, & H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) - CI_electronic_energy(:) = 0.d0 - call u_0_S2_u_0(CI_s2,eigenvectors,N_det,psi_det,N_int,& + CI_electronic_energy_real(:) = 0.d0 + call u_0_S2_u_0(CI_s2_real,eigenvectors,N_det,psi_det,N_int,& min(N_det,N_states_diag),size(eigenvectors,1)) ! Select the "N_states_diag" states of lowest energy do j=1,min(N_det,N_states_diag) do i=1,N_det CI_eigenvectors(i,j) = eigenvectors(i,j) enddo - CI_electronic_energy(j) = eigenvalues(j) + CI_electronic_energy_real(j) = eigenvalues(j) enddo endif do k=1,N_states_diag - CI_electronic_energy(k) = 0.d0 + CI_electronic_energy_real(k) = 0.d0 do j=1,N_det do i=1,N_det - CI_electronic_energy(k) += & + CI_electronic_energy_real(k) += & CI_eigenvectors(i,k) * CI_eigenvectors(j,k) * & H_matrix_all_dets(i,j) enddo @@ -205,6 +218,196 @@ END_PROVIDER deallocate(eigenvectors,eigenvalues) endif +END_PROVIDER + + BEGIN_PROVIDER [ double precision, CI_electronic_energy_complex, (N_states_diag) ] +&BEGIN_PROVIDER [ complex*16, CI_eigenvectors_complex, (N_det,N_states_diag) ] +&BEGIN_PROVIDER [ double precision, CI_s2_complex, (N_states_diag) ] + BEGIN_DOC + ! Eigenvectors/values of the |CI| matrix + END_DOC + implicit none + double precision :: ovrlp + complex*16 :: u_dot_v_complex + integer :: i_good_state + integer, allocatable :: index_good_state_array(:) + logical, allocatable :: good_state_array(:) + double precision, allocatable :: s2_values_tmp(:) + integer :: i_other_state + double precision, allocatable :: eigenvalues(:) + complex*16, allocatable :: eigenvectors(:,:), H_prime(:,:) + integer :: i_state + double precision :: e_0 + integer :: i,j,k + double precision, allocatable :: s2_eigvalues(:) + double precision, allocatable :: e_array(:) + integer, allocatable :: iorder(:) + logical :: converged + + PROVIDE threshold_davidson nthreads_davidson + ! Guess values for the "N_states" states of the |CI| eigenvectors + do j=1,min(N_states,N_det) + do i=1,N_det + ci_eigenvectors_complex(i,j) = psi_coef_complex(i,j) + enddo + enddo + + do j=min(N_states,N_det)+1,N_states_diag + do i=1,N_det + ci_eigenvectors_complex(i,j) = (0.d0,0.d0) + enddo + enddo + + if (diag_algorithm == "Davidson") then + + call davidson_diag_hs2_complex(psi_det,ci_eigenvectors_complex, ci_s2_complex, & + size(ci_eigenvectors_complex,1),ci_electronic_energy_complex, & + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged) + + integer :: N_states_diag_save + N_states_diag_save = N_states_diag + do while (.not.converged) + double precision, allocatable :: ci_electronic_energy_tmp (:) + complex*16, allocatable :: ci_eigenvectors_tmp (:,:) + double precision, allocatable :: ci_s2_tmp (:) + + N_states_diag *= 2 + TOUCH N_states_diag + + allocate (ci_electronic_energy_tmp (N_states_diag) ) + allocate (ci_eigenvectors_tmp (N_det,N_states_diag) ) + allocate (ci_s2_tmp (N_states_diag) ) + + ci_electronic_energy_tmp(1:N_states_diag_save) = ci_electronic_energy_complex(1:N_states_diag_save) + ci_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = ci_eigenvectors_complex(1:N_det,1:N_states_diag_save) + ci_s2_tmp(1:N_states_diag_save) = ci_s2_complex(1:N_states_diag_save) + + call davidson_diag_hs2_complex(psi_det,ci_eigenvectors_tmp, ci_s2_tmp, & + size(ci_eigenvectors_tmp,1),ci_electronic_energy_tmp, & + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged) + + ci_electronic_energy_complex(1:N_states_diag_save) = ci_electronic_energy_tmp(1:N_states_diag_save) + ci_eigenvectors_complex(1:N_det,1:N_states_diag_save) = ci_eigenvectors_tmp(1:N_det,1:N_states_diag_save) + ci_s2_complex(1:N_states_diag_save) = ci_s2_tmp(1:N_states_diag_save) + + deallocate (ci_electronic_energy_tmp) + deallocate (ci_eigenvectors_tmp) + deallocate (ci_s2_tmp) + enddo + if (N_states_diag > N_states_diag_save) then + N_states_diag = N_states_diag_save + TOUCH N_states_diag + endif + + else if (diag_algorithm == "Lapack") then + + print *, 'Diagonalization of H using Lapack' + allocate (eigenvectors(size(h_matrix_all_dets_complex,1),N_det)) + allocate (eigenvalues(N_det)) + if (s2_eig) then + double precision, parameter :: alpha = 0.1d0 + allocate (H_prime(N_det,N_det) ) + H_prime(1:N_det,1:N_det) = h_matrix_all_dets_complex(1:N_det,1:N_det) + & + alpha * s2_matrix_all_dets(1:N_det,1:N_det) + do j=1,N_det + H_prime(j,j) = H_prime(j,j) + alpha*(s_z2_sz - expected_s2) + enddo + call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) + ci_electronic_energy_complex(:) = 0.d0 + i_state = 0 + allocate (s2_eigvalues(N_det)) + allocate(index_good_state_array(N_det),good_state_array(N_det)) + good_state_array = .False. + call u_0_s2_u_0_complex(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& + N_det,size(eigenvectors,1)) + if (only_expected_s2) then + do j=1,N_det + ! Select at least n_states states with S^2 values closed to "expected_s2" + if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then + i_state +=1 + index_good_state_array(i_state) = j + good_state_array(j) = .True. + endif + if(i_state.eq.N_states) then + exit + endif + enddo + else + do j=1,N_det + index_good_state_array(j) = j + good_state_array(j) = .True. + enddo + endif + if(i_state .ne.0)then + ! Fill the first "i_state" states that have a correct S^2 value + do j = 1, i_state + do i=1,N_det + ci_eigenvectors_complex(i,j) = eigenvectors(i,index_good_state_array(j)) + enddo + ci_electronic_energy_complex(j) = eigenvalues(index_good_state_array(j)) + ci_s2_complex(j) = s2_eigvalues(index_good_state_array(j)) + enddo + i_other_state = 0 + do j = 1, N_det + if(good_state_array(j))cycle + i_other_state +=1 + if(i_state+i_other_state.gt.n_states_diag)then + exit + endif + do i=1,N_det + ci_eigenvectors_complex(i,i_state+i_other_state) = eigenvectors(i,j) + enddo + ci_electronic_energy_complex(i_state+i_other_state) = eigenvalues(j) + ci_s2_complex(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + enddo + + else + print*,'' + print*,'!!!!!!!! WARNING !!!!!!!!!' + print*,' Within the ',N_det,'determinants selected' + print*,' and the ',N_states_diag,'states requested' + print*,' We did not find any state with S^2 values close to ',expected_s2 + print*,' We will then set the first N_states eigenvectors of the H matrix' + print*,' as the ci_eigenvectors_complex' + print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' + print*,'' + do j=1,min(N_states_diag,N_det) + do i=1,N_det + ci_eigenvectors_complex(i,j) = eigenvectors(i,j) + enddo + ci_electronic_energy_complex(j) = eigenvalues(j) + ci_s2_complex(j) = s2_eigvalues(j) + enddo + endif + deallocate(index_good_state_array,good_state_array) + deallocate(s2_eigvalues) + else + call lapack_diag_complex(eigenvalues,eigenvectors, & + H_matrix_all_dets_complex,size(H_matrix_all_dets,1),N_det) + ci_electronic_energy_complex(:) = 0.d0 + call u_0_S2_u_0_complex(ci_s2_complex,eigenvectors,N_det,psi_det,N_int,& + min(N_det,N_states_diag),size(eigenvectors,1)) + ! Select the "N_states_diag" states of lowest energy + do j=1,min(N_det,N_states_diag) + do i=1,N_det + ci_eigenvectors_complex(i,j) = eigenvectors(i,j) + enddo + ci_electronic_energy_complex(j) = eigenvalues(j) + enddo + endif + do k=1,N_states_diag + ci_electronic_energy_complex(k) = 0.d0 + do j=1,N_det + do i=1,N_det + ci_electronic_energy_complex(k) += & + ci_eigenvectors_complex(i,k) * ci_eigenvectors_complex(j,k) * & + H_matrix_all_dets_complex(i,j) + enddo + enddo + enddo + deallocate(eigenvectors,eigenvalues) + endif + END_PROVIDER subroutine diagonalize_CI @@ -214,6 +417,17 @@ subroutine diagonalize_CI ! eigenstates of the |CI| matrix. END_DOC integer :: i,j + if (is_complex) then + do j=1,N_states + do i=1,N_det + psi_coef_complex(i,j) = ci_eigenvectors_complex(i,j) + enddo + enddo + psi_energy(1:N_states) = CI_electronic_energy(1:N_states) + psi_s2(1:N_states) = CI_s2(1:N_states) + !todo: touch complex? + SOFT_TOUCH psi_coef_complex CI_electronic_energy ci_energy CI_eigenvectors_complex CI_s2 psi_energy psi_s2 + else do j=1,N_states do i=1,N_det psi_coef(i,j) = CI_eigenvectors(i,j) @@ -222,5 +436,7 @@ subroutine diagonalize_CI psi_energy(1:N_states) = CI_electronic_energy(1:N_states) psi_s2(1:N_states) = CI_s2(1:N_states) + !todo: touch real? SOFT_TOUCH psi_coef CI_electronic_energy CI_energy CI_eigenvectors CI_s2 psi_energy psi_s2 + endif end From 47d27186dc08b1653294a4114af8a60ce7c2093a Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 26 Feb 2020 13:35:51 -0600 Subject: [PATCH 120/256] minor changes in complex davidson --- src/davidson/davidson_parallel.irp.f | 3 +-- src/davidson/u0_h_u0.irp.f | 17 ++--------------- 2 files changed, 3 insertions(+), 17 deletions(-) diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index e898585f..583eb937 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -916,7 +916,7 @@ end subroutine subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) - !todo: implement for complex + !todo: maybe make separate zmq_put_psi_complex? print*,irp_here,' not implemented for complex' stop -1 use omp_lib @@ -1019,7 +1019,6 @@ subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag integer, external :: zmq_put_cdmatrix - !todo: size/2 for complex? if (size(u_t) < 8388608) then ni = size(u_t) nj = 1 diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 1f95b72b..383e70ea 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -719,9 +719,7 @@ END_TEMPLATE !==============================================================================! subroutine u_0_H_u_0_complex(e_0,s_0,u_0,n,keys_tmp,Nint,N_st,sze) - !todo: implement for complex - print*,irp_here,' not implemented for complex' - stop -1 + !todo: check normalization for complex use bitmasks implicit none BEGIN_DOC @@ -788,9 +786,6 @@ end subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) - !todo: implement for complex - print*,irp_here,' not implemented for complex' - stop -1 use bitmasks implicit none BEGIN_DOC @@ -812,7 +807,6 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) enddo v_t = (0.d0,0.d0) s_t = (0.d0,0.d0) - !todo: just transpose, no conjg? call cdtranspose( & u_0, & size(u_0, 1), & @@ -823,7 +817,6 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) call h_s2_u_0_nstates_openmp_work_complex(v_t,s_t,u_t,N_st,sze,1,N_det,0,1) deallocate(u_t) - !todo: just transpose, no conjg? call cdtranspose( & v_t, & size(v_t, 1), & @@ -846,9 +839,6 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) end subroutine h_s2_u_0_nstates_openmp_work_complex(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) - !todo: implement for complex - print*,irp_here,' not implemented for complex' - stop -1 use bitmasks implicit none BEGIN_DOC @@ -880,9 +870,6 @@ end BEGIN_TEMPLATE subroutine H_S2_u_0_nstates_openmp_work_complex_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep) - !todo: implement for complex - print*,irp_here,' not implemented for complex' - stop -1 use bitmasks implicit none BEGIN_DOC @@ -1128,7 +1115,7 @@ compute_singles=.True. tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) !todo: check arg order conjg/noconjg call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij) - call get_s2_complex(tmp_det,tmp_det2,$N_int,sij) + call get_s2(tmp_det,tmp_det2,$N_int,sij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st !todo: check arg order conjg/noconjg From 20d5bcd9d5f8731e5f4f21e6a0303c8e36f0ccbb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 26 Feb 2020 17:01:41 -0600 Subject: [PATCH 121/256] working on complex cipsi --- src/cipsi/energy.irp.f | 6 +++++- src/cipsi/pt2_stoch_routines.irp.f | 2 +- src/cipsi/stochastic_cipsi.irp.f | 16 +++++++++++----- src/fci/fci.irp.f | 6 +++++- src/selectors_full/selectors.irp.f | 28 ++++++++++++++++++++++++++-- src/selectors_utils/selectors.irp.f | 14 ++++++++++++++ 6 files changed, 62 insertions(+), 10 deletions(-) diff --git a/src/cipsi/energy.irp.f b/src/cipsi/energy.irp.f index 0ae5ad79..4a9dc2e8 100644 --- a/src/cipsi/energy.irp.f +++ b/src/cipsi/energy.irp.f @@ -17,7 +17,11 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) else if (h0_type == "HF") then do i=1,N_states - j = maxloc(abs(psi_coef(:,i)),1) + if (is_complex) then + j = maxloc(cdabs(psi_coef_complex(:,i)),1) + else + j = maxloc(abs(psi_coef(:,i)),1) + endif pt2_E0_denominator(i) = psi_det_hii(j) enddo else if (h0_type == "Barycentric") then diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 281b0c5d..78fcf568 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -140,7 +140,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) pt2=0.d0 variance=0.d0 norm=0.d0 - call ZMQ_selection(N_in, pt2, variance, norm) + call zmq_selection(N_in, pt2, variance, norm) error(:) = 0.d0 else diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index b8bf6a1d..854703b5 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -36,7 +36,7 @@ subroutine run_stochastic_cipsi if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_CI + call diagonalize_ci call save_wavefunction call ezfio_has_hartree_fock_energy(has) @@ -48,9 +48,15 @@ subroutine run_stochastic_cipsi if (N_det > N_det_max) then psi_det = psi_det_sorted - psi_coef = psi_coef_sorted - N_det = N_det_max - soft_touch N_det psi_det psi_coef + if (is_complex) then + psi_coef_complex = psi_coef_sorted_complex + N_det = N_det_max + soft_touch N_det psi_det psi_coef_complex + else + psi_coef = psi_coef_sorted + N_det = N_det_max + soft_touch N_det psi_det psi_coef + endif if (s2_eig) then call make_s2_eigenfunction endif @@ -78,7 +84,7 @@ subroutine run_stochastic_cipsi pt2 = 0.d0 variance = 0.d0 norm = 0.d0 - call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & + call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & norm, to_select) ! Stochastic PT2 and selection do k=1,N_states diff --git a/src/fci/fci.irp.f b/src/fci/fci.irp.f index 5c747081..b92257d4 100644 --- a/src/fci/fci.irp.f +++ b/src/fci/fci.irp.f @@ -37,7 +37,11 @@ program fci END_DOC if (.not.is_zmq_slave) then - PROVIDE psi_det psi_coef mo_two_e_integrals_in_map + if (is_complex) then + PROVIDE psi_det psi_coef_complex mo_two_e_integrals_in_map + else + PROVIDE psi_det psi_coef mo_two_e_integrals_in_map + endif if (do_pt2) then call run_stochastic_cipsi diff --git a/src/selectors_full/selectors.irp.f b/src/selectors_full/selectors.irp.f index 0531f731..20edb6b2 100644 --- a/src/selectors_full/selectors.irp.f +++ b/src/selectors_full/selectors.irp.f @@ -30,8 +30,7 @@ BEGIN_PROVIDER [ integer, N_det_selectors] call write_int(6,N_det_selectors,'Number of selectors') END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_selectors, (N_int,2,psi_selectors_size) ] -&BEGIN_PROVIDER [ double precision, psi_selectors_coef, (psi_selectors_size,N_states) ] +BEGIN_PROVIDER [ integer(bit_kind), psi_selectors, (N_int,2,psi_selectors_size) ] implicit none BEGIN_DOC ! Determinants on which we apply for perturbation. @@ -44,6 +43,16 @@ END_PROVIDER psi_selectors(k,2,i) = psi_det_sorted(k,2,i) enddo enddo + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, psi_selectors_coef, (psi_selectors_size,N_states) ] + implicit none + BEGIN_DOC + ! Determinants on which we apply for perturbation. + END_DOC + integer :: i,k + do k=1,N_states do i=1,N_det_selectors psi_selectors_coef(i,k) = psi_coef_sorted(i,k) @@ -52,4 +61,19 @@ END_PROVIDER END_PROVIDER +BEGIN_PROVIDER [ complex*16, psi_selectors_coef_complex, (psi_selectors_size,N_states) ] + implicit none + BEGIN_DOC + ! Determinants on which we apply for perturbation. + END_DOC + integer :: i,k + + do k=1,N_states + do i=1,N_det_selectors + psi_selectors_coef_complex(i,k) = psi_coef_sorted_complex(i,k) + enddo + enddo + +END_PROVIDER + diff --git a/src/selectors_utils/selectors.irp.f b/src/selectors_utils/selectors.irp.f index 92366d1d..4460979c 100644 --- a/src/selectors_utils/selectors.irp.f +++ b/src/selectors_utils/selectors.irp.f @@ -32,3 +32,17 @@ BEGIN_PROVIDER [ double precision, psi_selectors_diag_h_mat, (psi_selectors_size END_PROVIDER +BEGIN_PROVIDER [ complex*16, psi_selectors_coef_transp_complex, (N_states,psi_selectors_size) ] + implicit none + BEGIN_DOC + ! Transposed psi_selectors + END_DOC + integer :: i,k + + do i=1,N_det_selectors + do k=1,N_states + psi_selectors_coef_transp_complex(k,i) = psi_selectors_coef_complex(i,k) + enddo + enddo +END_PROVIDER + From 17b9b423a9ba8c8381ba75f9082af25e59de18b9 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 27 Feb 2020 18:46:22 -0600 Subject: [PATCH 122/256] working on complex cipsi --- src/cipsi/cipsi.irp.f | 45 ++++- src/cipsi/pt2_stoch_routines.irp.f | 245 ++++++++++++++++++++++++++ src/cipsi/run_selection_slave.irp.f | 6 +- src/cipsi/selection.irp.f | 3 + src/cipsi/zmq_selection.irp.f | 154 ++++++++++++++++ src/davidson/diagonalize_ci.irp.f | 34 ++-- src/davidson/print_e_components.irp.f | 27 ++- src/davidson/u0_h_u0.irp.f | 1 + src/utils_complex/qp2-pbc-diff.txt | 11 ++ 9 files changed, 494 insertions(+), 32 deletions(-) diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f index 66881b28..0e3c5958 100644 --- a/src/cipsi/cipsi.irp.f +++ b/src/cipsi/cipsi.irp.f @@ -33,7 +33,11 @@ subroutine run_cipsi if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_CI + if (is_complex) then + call diagonalize_CI_complex + else + call diagonalize_CI + endif call save_wavefunction call ezfio_has_hartree_fock_energy(has) @@ -57,7 +61,11 @@ subroutine run_cipsi if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_ci + if (is_complex) then + call diagonalize_CI_complex + else + call diagonalize_CI + endif call save_wavefunction endif @@ -86,8 +94,13 @@ subroutine run_cipsi norm = 0.d0 threshold_generators = 1.d0 SOFT_TOUCH threshold_generators - call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & - norm, 0) ! Stochastic PT2 + if (is_complex) then + call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & + norm, 0) ! Stochastic PT2 + else + call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & + norm, 0) ! Stochastic PT2 + endif threshold_generators = threshold_generators_save SOFT_TOUCH threshold_generators endif @@ -114,16 +127,21 @@ subroutine run_cipsi n_det_before = N_det to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor) to_select = max(N_states_diag, to_select) - call ZMQ_selection(to_select, pt2, variance, norm) if (is_complex) then + call zmq_selection_complex(to_select, pt2, variance, norm) PROVIDE psi_coef_complex else + call zmq_selection(to_select, pt2, variance, norm) PROVIDE psi_coef endif PROVIDE psi_det PROVIDE psi_det_sorted - call diagonalize_CI + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_CI + endif call save_wavefunction call save_energy(psi_energy_with_nucl_rep, zeros) if (qp_stop()) exit @@ -135,7 +153,11 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max) if (.not.qp_stop()) then if (N_det < N_det_max) then - call diagonalize_CI + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_CI + endif call save_wavefunction call save_energy(psi_energy_with_nucl_rep, zeros) endif @@ -146,8 +168,13 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max) norm(:) = 0.d0 threshold_generators = 1d0 SOFT_TOUCH threshold_generators - call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & - norm,0) ! Stochastic PT2 + if (is_complex) then + call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & + norm,0) ! Stochastic PT2 + else + call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & + norm,0) ! Stochastic PT2 + endif SOFT_TOUCH threshold_generators endif print *, 'N_det = ', N_det diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 78fcf568..a8d4f240 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -815,4 +815,249 @@ END_PROVIDER +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + + + + +subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in) + !todo: implement for complex + print*,irp_here + stop -1 + use f77_zmq + use selection_types + + implicit none + + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull + integer, intent(in) :: N_in + double precision, intent(in) :: relative_error, E(N_states) + double precision, intent(out) :: pt2(N_states),error(N_states) + double precision, intent(out) :: variance(N_states),norm(N_states) + + + integer :: i, N + + double precision :: state_average_weight_save(N_states), w(N_states,4) + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + type(selection_buffer) :: b + + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted + PROVIDE psi_det_hii selection_weight pseudo_sym + + if (h0_type == 'SOP') then + PROVIDE psi_occ_pattern_hii det_to_occ_pattern + endif + + if (N_det <= max(4,N_states)) then + pt2=0.d0 + variance=0.d0 + norm=0.d0 + call zmq_selection_complex(N_in, pt2, variance, norm) + error(:) = 0.d0 + else + + N = max(N_in,1) * N_states + state_average_weight_save(:) = state_average_weight(:) + if (int(N,8)*2_8 > huge(1)) then + print *, irp_here, ': integer too large' + stop -1 + endif + call create_selection_buffer(N, N*2, b) + ASSERT (associated(b%det)) + ASSERT (associated(b%val)) + + do pt2_stoch_istate=1,N_states + state_average_weight(:) = 0.d0 + state_average_weight(pt2_stoch_istate) = 1.d0 + TOUCH state_average_weight pt2_stoch_istate selection_weight + + PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w + PROVIDE psi_selectors pt2_u pt2_J pt2_R + call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') + + integer, external :: zmq_put_psi + integer, external :: zmq_put_N_det_generators + integer, external :: zmq_put_N_det_selectors + integer, external :: zmq_put_dvector + integer, external :: zmq_put_ivector + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_generators on ZMQ server' + endif + if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_selectors on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then + stop 'Unable to put state_average_weight on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then + stop 'Unable to put selection_weight on ZMQ server' + endif + if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then + stop 'Unable to put pt2_stoch_istate on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then + stop 'Unable to put threshold_generators on ZMQ server' + endif + + + integer, external :: add_task_to_taskserver + character(300000) :: task + + integer :: j,k,ipos,ifirst + ifirst=0 + + ipos=0 + do i=1,N_det_generators + if (pt2_F(i) > 1) then + ipos += 1 + endif + enddo + call write_int(6,sum(pt2_F),'Number of tasks') + call write_int(6,ipos,'Number of fragmented tasks') + + ipos=1 + do i= 1, N_det_generators + do j=1,pt2_F(pt2_J(i)) + write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in + ipos += 30 + if (ipos > 300000-30) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + ipos=1 + if (ifirst == 0) then + ifirst=1 + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + endif + endif + end do + enddo + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + endif + + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + + double precision :: mem_collector, mem, rss + + call resident_memory(rss) + + mem_collector = 8.d0 * & ! bytes + ( 1.d0*pt2_n_tasks_max & ! task_id, index + + 0.635d0*N_det_generators & ! f,d + + 3.d0*N_det_generators*N_states & ! eI, vI, nI + + 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task + + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 + + 1.d0*(N_int*2.d0*N + N) & ! selection buffer + + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer + ) / 1024.d0**3 + + integer :: nproc_target, ii + nproc_target = nthreads_pt2 + ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) + + do + mem = mem_collector + & ! + nproc_target * 8.d0 * & ! bytes + ( 0.5d0*pt2_n_tasks_max & ! task_id + + 64.d0*pt2_n_tasks_max & ! task + + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm + + 1.d0*pt2_n_tasks_max & ! i_generator, subset + + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer + + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer + + 2.0d0*(ii) & ! preinteresting, interesting, + ! prefullinteresting, fullinteresting + + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist + + 1.0d0*(N_states*mo_num*mo_num) & ! mat + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(mem,irp_here) + nproc_target = 1 + exit + endif + + if (mem+rss < qp_max_mem) then + exit + endif + + nproc_target = nproc_target - 1 + + enddo + call write_int(6,nproc_target,'Number of threads for PT2') + call write_double(6,mem,'Memory (Gb)') + + call omp_set_nested(.false.) + + + print '(A)', '========== ================= =========== =============== =============== =================' + print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' + print '(A)', '========== ================= =========== =============== =============== =================' + + PROVIDE global_selection_buffer + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & + !$OMP PRIVATE(i) + i = omp_get_thread_num() + if (i==0) then + + call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w(1,1), w(1,2), w(1,3), w(1,4), b, N) + pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1) + error(pt2_stoch_istate) = w(pt2_stoch_istate,2) + variance(pt2_stoch_istate) = w(pt2_stoch_istate,3) + norm(pt2_stoch_istate) = w(pt2_stoch_istate,4) + + else + call pt2_slave_inproc(i) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') + + print '(A)', '========== ================= =========== =============== =============== =================' + + enddo + FREE pt2_stoch_istate + + if (N_in > 0) then + b%cur = min(N_in,b%cur) + if (s2_eig) then + call make_selection_buffer_s2(b) + else + call remove_duplicates_in_selection_buffer(b) + endif + call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) + endif + call delete_selection_buffer(b) + + state_average_weight(:) = state_average_weight_save(:) + TOUCH state_average_weight + endif + do k=N_det+1,N_states + pt2(k) = 0.d0 + enddo + + call update_pt2_and_variance_weights(pt2, variance, norm, N_states) + +end subroutine diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index d9730d7f..150cc79f 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -26,7 +26,11 @@ subroutine run_selection_slave(thread,iproc,energy) PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym - PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection + if (is_complex) then + PROVIDE psi_selectors_coef_transp_complex psi_det_sorted weight_selection + else + PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection + endif zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index af63bbd8..73bf7d05 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -173,6 +173,7 @@ end subroutine subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset) + !todo: simplify for kpts use bitmasks use selection_types implicit none @@ -275,9 +276,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) double precision, allocatable :: coef_fullminilist_rev(:,:) + double precision, allocatable :: coef_fullminilist_rev_complex(:,:) double precision, allocatable :: mat(:,:,:) + double precision, allocatable :: mat_complex(:,:,:) logical :: monoAdo, monoBdo integer :: maskInd diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index 081d998f..d18b97fb 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -224,3 +224,157 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine + +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine ZMQ_selection_complex(N_in, pt2, variance, norm) + !todo: implement + print*,irp_here + stop -1 + use f77_zmq + use selection_types + + implicit none + + integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull + integer, intent(in) :: N_in + type(selection_buffer) :: b + integer :: i, N + integer, external :: omp_get_thread_num + double precision, intent(out) :: pt2(N_states) + double precision, intent(out) :: variance(N_states) + double precision, intent(out) :: norm(N_states) + +! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators + + N = max(N_in,1) + if (.True.) then + PROVIDE pt2_e0_denominator nproc + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym + + + call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') + + integer, external :: zmq_put_psi + integer, external :: zmq_put_N_det_generators + integer, external :: zmq_put_N_det_selectors + integer, external :: zmq_put_dvector + + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_generators on ZMQ server' + endif + if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_selectors on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then + stop 'Unable to put state_average_weight on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then + stop 'Unable to put selection_weight on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then + stop 'Unable to put threshold_generators on ZMQ server' + endif + call create_selection_buffer(N, N*2, b) + endif + + integer, external :: add_task_to_taskserver + character(len=100000) :: task + integer :: j,k,ipos + ipos=1 + task = ' ' + + do i= 1, N_det_generators + do j=1,pt2_F(i) + write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N + ipos += 30 + if (ipos > 100000-30) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + ipos=1 + endif + end do + enddo + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + endif + + + ASSERT (associated(b%det)) + ASSERT (associated(b%val)) + + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + integer :: nproc_target + if (N_det < 3*nproc) then + nproc_target = N_det/4 + else + nproc_target = nproc + endif + double precision :: mem + mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3) + call write_double(6,mem,'Estimated memory/thread (Gb)') + if (qp_max_mem > 0) then + nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem))) + nproc_target = min(nproc_target,nproc) + endif + + f(:) = 1.d0 + if (.not.do_pt2) then + double precision :: f(N_states), u_dot_u_complex + do k=1,min(N_det,N_states) + f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors) + enddo + endif + + !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) + i = omp_get_thread_num() + if (i==0) then + call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) + else + call selection_slave_inproc(i) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection') + do i=N_det+1,N_states + pt2(i) = 0.d0 + variance(i) = 0.d0 + norm(i) = 0.d0 + enddo + if (N_in > 0) then + if (s2_eig) then + call make_selection_buffer_s2(b) + endif + call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) + call copy_H_apply_buffer_to_wf() + call save_wavefunction + endif + call delete_selection_buffer(b) + do k=1,N_states + pt2(k) = pt2(k) * f(k) + variance(k) = variance(k) * f(k) + norm(k) = norm(k) * f(k) + enddo + + call update_pt2_and_variance_weights(pt2, variance, norm, N_states) + +end subroutine diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 156d8521..a2599461 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -410,6 +410,24 @@ END_PROVIDER END_PROVIDER +subroutine diagonalize_CI_complex + implicit none + BEGIN_DOC +! Replace the coefficients of the |CI| states by the coefficients of the +! eigenstates of the |CI| matrix. + END_DOC + integer :: i,j + do j=1,N_states + do i=1,N_det + psi_coef_complex(i,j) = ci_eigenvectors_complex(i,j) + enddo + enddo + psi_energy(1:N_states) = CI_electronic_energy(1:N_states) + psi_s2(1:N_states) = CI_s2(1:N_states) + !todo: touch ci_{sc,electronic_energy}? + SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2 +end + subroutine diagonalize_CI implicit none BEGIN_DOC @@ -417,17 +435,6 @@ subroutine diagonalize_CI ! eigenstates of the |CI| matrix. END_DOC integer :: i,j - if (is_complex) then - do j=1,N_states - do i=1,N_det - psi_coef_complex(i,j) = ci_eigenvectors_complex(i,j) - enddo - enddo - psi_energy(1:N_states) = CI_electronic_energy(1:N_states) - psi_s2(1:N_states) = CI_s2(1:N_states) - !todo: touch complex? - SOFT_TOUCH psi_coef_complex CI_electronic_energy ci_energy CI_eigenvectors_complex CI_s2 psi_energy psi_s2 - else do j=1,N_states do i=1,N_det psi_coef(i,j) = CI_eigenvectors(i,j) @@ -436,7 +443,6 @@ subroutine diagonalize_CI psi_energy(1:N_states) = CI_electronic_energy(1:N_states) psi_s2(1:N_states) = CI_s2(1:N_states) - !todo: touch real? - SOFT_TOUCH psi_coef CI_electronic_energy CI_energy CI_eigenvectors CI_s2 psi_energy psi_s2 - endif + !todo: touch ci_{sc,electronic_energy}? + SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2 end diff --git a/src/davidson/print_e_components.irp.f b/src/davidson/print_e_components.irp.f index ddf83474..920daa18 100644 --- a/src/davidson/print_e_components.irp.f +++ b/src/davidson/print_e_components.irp.f @@ -17,15 +17,26 @@ subroutine print_energy_components() Ven = 0.d0 Vecp = 0.d0 T = 0.d0 - - do j=1,mo_num - do i=1,mo_num - f = one_e_dm_mo_alpha(i,j,k) + one_e_dm_mo_beta(i,j,k) - Ven = Ven + f * mo_integrals_n_e(i,j) - Vecp = Vecp + f * mo_pseudo_integrals(i,j) - T = T + f * mo_kinetic_integrals(i,j) + + if (is_complex) then + do j=1,mo_num + do i=1,mo_num + f = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k) + Ven = Ven + dble(f * mo_integrals_n_e_complex(j,i)) + Vecp = Vecp + dble(f * mo_pseudo_integrals_complex(j,i)) + T = T + dble(f * mo_kinetic_integrals_complex(j,i)) + enddo enddo - enddo + else + do j=1,mo_num + do i=1,mo_num + f = one_e_dm_mo_alpha(i,j,k) + one_e_dm_mo_beta(i,j,k) + Ven = Ven + f * mo_integrals_n_e(i,j) + Vecp = Vecp + f * mo_pseudo_integrals(i,j) + T = T + f * mo_kinetic_integrals(i,j) + enddo + enddo + endif Vee = psi_energy(k) - Ven - Vecp - T if (ifirst == 0) then diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 383e70ea..576b3a65 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -5,6 +5,7 @@ ! psi_energy(i) = $\langle \Psi_i | H | \Psi_i \rangle$ ! ! psi_s2(i) = $\langle \Psi_i | S^2 | \Psi_i \rangle$ +! real and complex END_DOC if (is_complex) then call u_0_h_u_0_complex(psi_energy,psi_s2,psi_coef_complex,N_det,psi_det,N_int,N_states,psi_det_size) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 730a3970..11a83ac6 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,7 +1,18 @@ ------------------------------------------------------------------------------------- current: + fci + run_cipsi + zmq_pt2_complex + selection buffer? (val, mini)? + selection_slave_inproc + zmq_selection_complex + run_slave_cipsi + run_stochastic_cipsi +------------------------------------------------------------------------------------- + +old: irp_align for complex? zmq_put_psi_complex instead of branch inside zmq_put_psi? are there cases where we call this without already being on a complex branch of code? From 299243e2cefbe432cd85f273a45bd1dc28b570be Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 3 Mar 2020 17:48:46 -0600 Subject: [PATCH 123/256] working on complex cipsi --- src/cipsi/cipsi.irp.f | 29 +++++++------ src/cipsi/pt2_stoch_routines.irp.f | 66 +++++++++++++++++++++-------- src/cipsi/run_selection_slave.irp.f | 3 +- src/cipsi/selection.irp.f | 2 +- src/cipsi/slave_cipsi.irp.f | 27 +++++++++--- src/cipsi/stochastic_cipsi.irp.f | 50 +++++++++++++++++----- src/cipsi/zmq_selection.irp.f | 14 ++++-- src/utils_complex/qp2-pbc-diff.txt | 39 ++++++++++++++--- 8 files changed, 170 insertions(+), 60 deletions(-) diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f index 0e3c5958..e4089cfc 100644 --- a/src/cipsi/cipsi.irp.f +++ b/src/cipsi/cipsi.irp.f @@ -20,7 +20,7 @@ subroutine run_cipsi logical :: has double precision :: relative_error - PROVIDE H_apply_buffer_allocated + PROVIDE h_apply_buffer_allocated relative_error=PT2_relative_error @@ -34,7 +34,7 @@ subroutine run_cipsi call make_s2_eigenfunction endif if (is_complex) then - call diagonalize_CI_complex + call diagonalize_ci_complex else call diagonalize_CI endif @@ -94,13 +94,13 @@ subroutine run_cipsi norm = 0.d0 threshold_generators = 1.d0 SOFT_TOUCH threshold_generators - if (is_complex) then - call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & - norm, 0) ! Stochastic PT2 - else +! if (is_complex) then +! call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & +! norm, 0) ! Stochastic PT2 +! else call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & norm, 0) ! Stochastic PT2 - endif +! endif threshold_generators = threshold_generators_save SOFT_TOUCH threshold_generators endif @@ -127,11 +127,12 @@ subroutine run_cipsi n_det_before = N_det to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor) to_select = max(N_states_diag, to_select) + call zmq_selection(to_select, pt2, variance, norm) if (is_complex) then - call zmq_selection_complex(to_select, pt2, variance, norm) +! call zmq_selection_complex(to_select, pt2, variance, norm) PROVIDE psi_coef_complex else - call zmq_selection(to_select, pt2, variance, norm) +! call zmq_selection(to_select, pt2, variance, norm) PROVIDE psi_coef endif PROVIDE psi_det @@ -168,13 +169,13 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max) norm(:) = 0.d0 threshold_generators = 1d0 SOFT_TOUCH threshold_generators - if (is_complex) then - call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & - norm,0) ! Stochastic PT2 - else +! if (is_complex) then +! call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & +! norm,0) ! Stochastic PT2 +! else call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & norm,0) ! Stochastic PT2 - endif +! endif SOFT_TOUCH threshold_generators endif print *, 'N_det = ', N_det diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index a8d4f240..e487d39b 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -63,11 +63,19 @@ logical function testTeethBuilding(minF, N) norm = 0.d0 double precision :: norm - do i=N_det_generators,1,-1 - tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * & - psi_coef_sorted_gen(i,pt2_stoch_istate) - norm = norm + tilde_w(i) - enddo + if (is_complex) then + do i=N_det_generators,1,-1 + tilde_w(i) = cdabs(psi_coef_sorted_gen_complex(i,pt2_stoch_istate) * & + psi_coef_sorted_gen_complex(i,pt2_stoch_istate)) + norm = norm + tilde_w(i) + enddo + else + do i=N_det_generators,1,-1 + tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * & + psi_coef_sorted_gen(i,pt2_stoch_istate) + norm = norm + tilde_w(i) + enddo + endif f = 1.d0/norm tilde_w(:) = tilde_w(:) * f @@ -126,11 +134,19 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket type(selection_buffer) :: b - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted - PROVIDE psi_det_hii selection_weight pseudo_sym + if (is_complex) then + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted + PROVIDE psi_det_hii selection_weight pseudo_sym + else + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted + PROVIDE psi_det_hii selection_weight pseudo_sym + endif if (h0_type == 'SOP') then PROVIDE psi_occ_pattern_hii det_to_occ_pattern @@ -159,8 +175,15 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) state_average_weight(pt2_stoch_istate) = 1.d0 TOUCH state_average_weight pt2_stoch_istate selection_weight - PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w - PROVIDE psi_selectors pt2_u pt2_J pt2_R + if (is_complex) then + !todo: psi_selectors isn't linked to psi_selectors_coef anymore; should we provide both? + PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_complex pt2_w + PROVIDE psi_selectors pt2_u pt2_J pt2_R + else + PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w + PROVIDE psi_selectors pt2_u pt2_J pt2_R + endif + call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') integer, external :: zmq_put_psi @@ -242,6 +265,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) double precision :: mem_collector, mem, rss + !todo: check memory allocation for complex call resident_memory(rss) mem_collector = 8.d0 * & ! bytes @@ -751,10 +775,16 @@ END_PROVIDER allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) tilde_cW(0) = 0d0 - - do i=1,N_det_generators - tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 - enddo + + if (is_complex) then + do i=1,N_det_generators + tilde_w(i) = cdabs(psi_coef_sorted_gen_complex(i,pt2_stoch_istate))**2 !+ 1.d-20 + enddo + else + do i=1,N_det_generators + tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 + enddo + endif double precision :: norm norm = 0.d0 @@ -773,7 +803,7 @@ END_PROVIDER pt2_n_0(1) = 0 do pt2_u_0 = tilde_cW(pt2_n_0(1)) - r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth) + r = tilde_cW(pt2_n_0(1) + pt2_mindetinfirstteeth) pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth) if(pt2_W_T >= r - pt2_u_0) then exit @@ -799,7 +829,7 @@ END_PROVIDER endif ASSERT(tooth_width > 0.d0) do i=pt2_n_0(t)+1, pt2_n_0(t+1) - pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width + pt2_w(i) = tilde_w(i) * pt2_w_t / tooth_width end do end do diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index 150cc79f..e5d86202 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -21,7 +21,8 @@ subroutine run_selection_slave(thread,iproc,energy) double precision :: pt2(N_states) double precision :: variance(N_states) double precision :: norm(N_states) - + + !todo: check for providers that are now unlinked for real/complex PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 73bf7d05..e8afd311 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -758,7 +758,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d if (.not.is_a_1h1p(det)) cycle endif - Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) + Hii = diag_h_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) w = 0d0 diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index 1dc3e784..91edd66d 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -14,10 +14,17 @@ subroutine run_slave_cipsi end subroutine provide_everything - PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag - PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context - PROVIDE psi_det psi_coef threshold_generators state_average_weight - PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym + if (is_complex) then + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag + PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context + PROVIDE psi_det psi_coef_complex threshold_generators state_average_weight + PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym + else + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag + PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context + PROVIDE psi_det psi_coef threshold_generators state_average_weight + PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym + endif end subroutine run_slave_main @@ -51,9 +58,15 @@ subroutine run_slave_main zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master - PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator - PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank + if (is_complex) then + PROVIDE psi_det psi_coef_complex threshold_generators state_average_weight mpi_master + PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator + PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank + else + PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master + PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator + PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank + endif IRP_IF MPI call MPI_BARRIER(MPI_COMM_WORLD, ierr) diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 854703b5..5a5da8b6 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -36,7 +36,11 @@ subroutine run_stochastic_cipsi if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_ci + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_ci + endif call save_wavefunction call ezfio_has_hartree_fock_energy(has) @@ -60,7 +64,11 @@ subroutine run_stochastic_cipsi if (s2_eig) then call make_s2_eigenfunction endif - call diagonalize_CI + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_CI + endif call save_wavefunction endif @@ -84,8 +92,13 @@ subroutine run_stochastic_cipsi pt2 = 0.d0 variance = 0.d0 norm = 0.d0 - call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & - norm, to_select) ! Stochastic PT2 and selection + if (is_complex) then + call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & + norm, to_select) ! Stochastic PT2 and selection + else + call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & + norm, to_select) ! Stochastic PT2 and selection + endif do k=1,N_states rpt2(k) = pt2(k)/(1.d0 + norm(k)) @@ -107,14 +120,22 @@ subroutine run_stochastic_cipsi if (qp_stop()) exit ! Add selected determinants - call copy_H_apply_buffer_to_wf() + call copy_h_apply_buffer_to_wf() ! call save_wavefunction - PROVIDE psi_coef + if (is_complex) then + PROVIDE psi_coef_complex + else + PROVIDE psi_coef + endif PROVIDE psi_det PROVIDE psi_det_sorted - call diagonalize_CI + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_CI + endif call save_wavefunction call save_energy(psi_energy_with_nucl_rep, zeros) if (qp_stop()) exit @@ -122,7 +143,11 @@ subroutine run_stochastic_cipsi if (.not.qp_stop()) then if (N_det < N_det_max) then - call diagonalize_CI + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_CI + endif call save_wavefunction call save_energy(psi_energy_with_nucl_rep, zeros) endif @@ -130,8 +155,13 @@ subroutine run_stochastic_cipsi pt2(:) = 0.d0 variance(:) = 0.d0 norm(:) = 0.d0 - call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & - norm,0) ! Stochastic PT2 + if (is_complex) then + call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & + norm,0) ! Stochastic PT2 + else + call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & + norm,0) ! Stochastic PT2 + endif do k=1,N_states rpt2(k) = pt2(k)/(1.d0 + norm(k)) diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index d18b97fb..d87c68a0 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -17,6 +17,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm) N = max(N_in,1) if (.True.) then + !todo: some providers have becom unlinked for real/complex (det/coef); do these need to be provided? PROVIDE pt2_e0_denominator nproc PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order @@ -105,9 +106,16 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm) f(:) = 1.d0 if (.not.do_pt2) then double precision :: f(N_states), u_dot_u - do k=1,min(N_det,N_states) - f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors) - enddo + if (is_complex) then + double precision :: u_dot_u_complex + do k=1,min(N_det,N_states) + f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors) + enddo + else + do k=1,min(N_det,N_states) + f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors) + enddo + endif endif !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 11a83ac6..95febce1 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,14 +1,41 @@ ------------------------------------------------------------------------------------- current: + select_connected + select_singles_and_doubles (this should be separated real/complex) + spot_isinwf (same for real/complex) + splash_pq (separate real/complex) + get_d{0,1,2} (separate real/complex) + fill_buffer_double (separate real/complex) + fci - run_cipsi - zmq_pt2_complex - selection buffer? (val, mini)? - selection_slave_inproc - zmq_selection_complex + run_{,stochastic_}cipsi + everything okay except: + zmq_pt2{,_complex} (todo: combine real/complex) + selection buffer? (val, mini)? + selection_slave_inproc + run_selection_slave + select_connected + + pt2_slave_inproc + run_pt2_slave{,_large,_small} + select_connected + + zmq_selection_complex + selection_collector + pull_selection_results + add_to_selection_buffer + selection_slave_inproc + run_selection_slave (has split for complex?) + select_connected run_slave_cipsi - run_stochastic_cipsi + run_slave_main + change memory allocation for complex (first see how many arrays will need to change type) + run_pt2_slave (large/small?) + select_connected + selection_buffer: + if anything complex, need to change zmq calls + {push,pull}_pt2_results ------------------------------------------------------------------------------------- From 10fc3a6fc4390372cb4a08cd6f9cc883bd4175a2 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 3 Mar 2020 18:45:24 -0600 Subject: [PATCH 124/256] working on complex selection --- src/cipsi/selection.irp.f | 835 ++++++++++++++++++++++++++++- src/cipsi/slave_cipsi.irp.f | 1 + src/cipsi/stochastic_cipsi.irp.f | 20 +- src/utils_complex/qp2-pbc-diff.txt | 3 + 4 files changed, 843 insertions(+), 16 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index e8afd311..67c6d4fa 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -276,11 +276,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) double precision, allocatable :: coef_fullminilist_rev(:,:) - double precision, allocatable :: coef_fullminilist_rev_complex(:,:) + complex*16, allocatable :: coef_fullminilist_rev_complex(:,:) double precision, allocatable :: mat(:,:,:) - double precision, allocatable :: mat_complex(:,:,:) + complex*16, allocatable :: mat_complex(:,:,:) logical :: monoAdo, monoBdo integer :: maskInd @@ -288,7 +288,12 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp + PROVIDE psi_bilinear_matrix_transp_order + if (is_complex) then + PROVIDE psi_selectors_coef_transp_complex + else + PROVIDE psi_selectors_coef_transp + endif monoAdo = .true. monoBdo = .true. @@ -425,9 +430,18 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! !$OMP CRITICAL ! print *, 'Step1: ', i_generator, preinteresting(0) ! !$OMP END CRITICAL - + +!------------------------------------------------------------| +! | +! Real | +! | +!------------------------------------------------------------| allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2)) + if (is_complex) then + allocate (mat_complex(N_states, mo_num, mo_num)) + else allocate (mat(N_states, mo_num, mo_num)) + endif maskInd = -1 integer :: nb_count, maskInd_save @@ -636,7 +650,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! !$OMP CRITICAL ! print *, 'Step3: ', i_generator, h1, interesting(0) ! !$OMP END CRITICAL - + if (is_complex) then + call splash_pq_complex(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat_complex, interesting) + + if(.not.pert_2rdm)then + call fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat_complex, buf) + else + print*,irp_here,' not implemented for complex' + stop -1 + !call fill_buffer_double_rdm_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat_complex, buf,fullminilist, coef_fullminilist_rev_complex, fullinteresting(0)) + endif + else call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) if(.not.pert_2rdm)then @@ -644,6 +668,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d else call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0)) endif + endif!complex end if enddo if(s1 /= s2) monoBdo = .false. @@ -655,7 +680,12 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo enddo deallocate(preinteresting, prefullinteresting, interesting, fullinteresting) - deallocate(banned, bannedOrb,mat) + deallocate(banned, bannedOrb) + if (is_complex) then + deallocate(mat_complex) + else + deallocate(mat) + endif end subroutine @@ -1911,3 +1941,796 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, end +!==============================================================================! +! ! +! Complex ! +! ! +!==============================================================================! + +subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf) + !todo: check indices for complex? + use bitmasks + use selection_types + implicit none + + integer, intent(in) :: i_generator, sp, h1, h2 + complex*16, intent(in) :: mat(N_states, mo_num, mo_num) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num) + double precision, intent(in) :: fock_diag_tmp(mo_num) + double precision, intent(in) :: E0(N_states) + double precision, intent(inout) :: pt2(N_states) + double precision, intent(inout) :: variance(N_states) + double precision, intent(inout) :: norm(N_states) + type(selection_buffer), intent(inout) :: buf + logical :: ok + integer :: s1, s2, p1, p2, ib, j, istate + integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) + double precision :: e_pert, delta_E, val, Hii, w, tmp + complex*16 :: alpha_h_psi, coef, val_c + double precision, external :: diag_H_mat_elem_fock + double precision :: E_shift + +! logical, external :: detEq +! double precision, allocatable :: values(:) +! integer, allocatable :: keys(:,:) +! integer :: nkeys + + + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) + E_shift = 0.d0 + + if (h0_type == 'SOP') then + j = det_to_occ_pattern(i_generator) + E_shift = psi_det_Hii(i_generator) - psi_occ_pattern_Hii(j) + endif + + do p1=1,mo_num + if(bannedOrb(p1, s1)) cycle + ib = 1 + if(sp /= 3) ib = p1+1 + + do p2=ib,mo_num + +! ----- +! /!\ Generating only single excited determinants doesn't work because a +! determinant generated by a single excitation may be doubly excited wrt +! to a determinant of the future. In that case, the determinant will be +! detected as already generated when generating in the future with a +! double excitation. +! +! if (.not.do_singles) then +! if ((h1 == p1) .or. (h2 == p2)) then +! cycle +! endif +! endif +! +! if (.not.do_doubles) then +! if ((h1 /= p1).and.(h2 /= p2)) then +! cycle +! endif +! endif +! ----- + + if(bannedOrb(p2, s2)) cycle + if(banned(p1,p2)) cycle + + val = maxval(cdabs(mat(1:N_states, p1, p2))) + if( val == 0d0) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + + if (do_only_cas) then + integer, external :: number_of_holes, number_of_particles + if (number_of_particles(det)>0) then + cycle + endif + if (number_of_holes(det)>0) then + cycle + endif + endif + + if (do_ddci) then + logical, external :: is_a_two_holes_two_particles + if (is_a_two_holes_two_particles(det)) then + cycle + endif + endif + + if (do_only_1h1p) then + logical, external :: is_a_1h1p + if (.not.is_a_1h1p(det)) cycle + endif + + Hii = diag_h_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) + + w = 0d0 + +! integer(bit_kind) :: occ(N_int,2), n +! call occ_pattern_of_det(det,occ,N_int) +! call occ_pattern_to_dets_size(occ,n,elec_alpha_num,N_int) + + + do istate=1,N_states + delta_E = E0(istate) - Hii + E_shift + alpha_h_psi = mat(istate, p1, p2) + val_c = alpha_h_psi + alpha_h_psi + tmp = dsqrt(delta_E * delta_E + cdabs(val_c * val_c)) + if (delta_E < 0.d0) then + tmp = -tmp + endif + e_pert = 0.5d0 * (tmp - delta_E) + if (dabs(alpha_h_psi) > 1.d-4) then + coef = e_pert / alpha_h_psi + else + coef = alpha_h_psi / delta_E + endif + pt2(istate) = pt2(istate) + e_pert + variance(istate) = variance(istate) + cdabs(alpha_h_psi * alpha_h_psi) + norm(istate) = norm(istate) + cdabs(coef * coef) + +!!!DEBUG +! integer :: k +! double precision :: alpha_h_psi_2,hij +! alpha_h_psi_2 = 0.d0 +! do k = 1,N_det_selectors +! call i_H_j(det,psi_selectors(1,1,k),N_int,hij) +! alpha_h_psi_2 = alpha_h_psi_2 + psi_selectors_coef(k,istate) * hij +! enddo +! if(dabs(alpha_h_psi_2 - alpha_h_psi).gt.1.d-12)then +! call debug_det(psi_det_generators(1,1,i_generator),N_int) +! call debug_det(det,N_int) +! print*,'alpha_h_psi,alpha_h_psi_2 = ',alpha_h_psi,alpha_h_psi_2 +! stop +! endif +!!!DEBUG + + select case (weight_selection) + + case(5) + ! Variance selection + w = w - cdabs(alpha_h_psi * alpha_h_psi) * selection_weight(istate) + + case(6) + w = w - cdabs(coef * coef) * selection_weight(istate) + + case default + ! Energy selection + w = w + e_pert * selection_weight(istate) + + end select + end do + + + if(pseudo_sym)then + if(cdabs(mat(1, p1, p2)).lt.thresh_sym)then + w = 0.d0 + endif + endif + +! w = dble(n) * w + + if(w <= buf%mini) then + call add_to_selection_buffer(buf, det, w) + end if + end do + end do +end + +subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) + !todo: check indices for complex? + use bitmasks + implicit none + BEGIN_DOC +! Computes the contributions A(r,s) by +! comparing the external determinant to all the internal determinants det(i). +! an applying two particles (r,s) to the mask. + END_DOC + + integer, intent(in) :: sp, i_gen, N_sel + integer, intent(in) :: interesting(0:N_sel) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) + logical, intent(inout) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num, 2) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + + integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt + integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) + integer(bit_kind) :: phasemask(N_int,2) + + PROVIDE psi_selectors_coef_transp_complex psi_det_sorted + mat = 0d0 + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + do i=1, N_sel + if (interesting(i) < 0) then + stop 'prefetch interesting(i) and det(i)' + endif + + mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + + if(nt > 4) cycle + + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt > 4) cycle + + if (interesting(i) == i_gen) then + if(sp == 3) then + do k=1,mo_num + do j=1,mo_num + banned(j,k,2) = banned(k,j,1) + enddo + enddo + else + do k=1,mo_num + do l=k+1,mo_num + banned(l,k,1) = banned(k,l,1) + end do + end do + end if + end if + + if (interesting(i) >= i_gen) then + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + + perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) + perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) + do j=2,N_int + perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) + perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) + end do + + call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) + call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) + + call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask,N_int) + if(nt == 4) then +! call get_d2_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + call get_d2_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else if(nt == 3) then +! call get_d1_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + call get_d1_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else +! call get_d0_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + call get_d0_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + end if + else if(nt == 4) then + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + call past_d2(banned, p, sp) + else if(nt == 3) then + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + call past_d1(bannedOrb, p) + end if + end do + +end + + +subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: check all indices for complex; check coef conjg for complex + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + + integer :: i, j, k, tip, ma, mi, puti, putj + integer :: h1, h2, p1, p2, i1, i2 + double precision :: phase + complex*16 :: hij + + integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/)) + integer, parameter :: turn2(2) = (/2, 1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + bant = 1 + + tip = p(0,1) * p(0,2) + + ma = sp + if(p(0,1) > p(0,2)) ma = 1 + if(p(0,1) < p(0,2)) ma = 2 + mi = mod(ma, 2) + 1 + + if(sp == 3) then + if(ma == 2) bant = 2 + + if(tip == 3) then + puti = p(1, mi) + if(bannedOrb(puti, mi)) return + h1 = h(1, ma) + h2 = h(2, ma) + + do i = 1, 3 + putj = p(i, ma) + if(banned(putj,puti,bant)) cycle + i1 = turn3(1,i) + i2 = turn3(2,i) + p1 = p(i1, ma) + p2 = p(i2, ma) + + hij = mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2, p1, h1, h2) + if (hij == (0.d0,0.d0)) cycle + + hij = hij * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) + + if(ma == 1) then + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, putj, puti) = mat(k, putj, puti) + coefs(k) * hij + enddo + else + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + end if + end do + else + h1 = h(1,1) + h2 = h(1,2) + do j = 1,2 + putj = p(j, 2) + if(bannedOrb(putj, 2)) cycle + p2 = p(turn2(j), 2) + do i = 1,2 + puti = p(i, 1) + + if(banned(puti,putj,bant) .or. bannedOrb(puti,1)) cycle + p1 = p(turn2(i), 1) + + hij = mo_two_e_integral_complex(p1, p2, h1, h2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + endif + end do + end do + end if + + else + if(tip == 0) then + h1 = h(1, ma) + h2 = h(2, ma) + do i=1,3 + puti = p(i, ma) + if(bannedOrb(puti,ma)) cycle + do j=i+1,4 + putj = p(j, ma) + if(bannedOrb(putj,ma)) cycle + if(banned(puti,putj,1)) cycle + + i1 = turn2d(1, i, j) + i2 = turn2d(2, i, j) + p1 = p(i1, ma) + p2 = p(i2, ma) + hij = mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2,p1, h1, h2) + if (hij == (0.d0,0.d0)) cycle + + hij = hij * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) +coefs(k) * hij + enddo + end do + end do + else if(tip == 3) then + h1 = h(1, mi) + h2 = h(1, ma) + p1 = p(1, mi) + do i=1,3 + puti = p(turn3(1,i), ma) + if(bannedOrb(puti,ma)) cycle + putj = p(turn3(2,i), ma) + if(bannedOrb(putj,ma)) cycle + if(banned(puti,putj,1)) cycle + p2 = p(i, ma) + + hij = mo_two_e_integral_complex(p1, p2, h1, h2) + if (hij == (0.d0,0.d0)) cycle + + hij = hij * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2, N_int) + if (puti < putj) then + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + else + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, putj, puti) = mat(k, putj, puti) + coefs(k) * hij + enddo + endif + end do + else ! tip == 4 + puti = p(1, sp) + putj = p(2, sp) + if(.not. banned(puti,putj,1)) then + p1 = p(1, mi) + p2 = p(2, mi) + h1 = h(1, mi) + h2 = h(2, mi) + hij = (mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2,p1, h1, h2)) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + end if + end if + end if + end if +end + + +subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: check all indices for complex; check coef conjg for complex + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + complex*16, allocatable :: hij_cache(:,:) + complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) + PROVIDE mo_integrals_map N_int + + allocate (lbanned(mo_num, 2)) + allocate (hij_cache(mo_num,2)) + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) + if(.not. bannedOrb(puti, mi)) then + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map) + tmp_row = (0.d0,0.d0) + do putj=1, hfix-1 + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + do putj=hfix+1, mo_num + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + + if(ma == 1) then + mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + enddo + enddo + end if + end if + + !MOVE MI + pfix = p(1,mi) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map) + putj = p1 + do puti=1,mo_num !HOT + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + + if(mi == 1) then + mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) + mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) + mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + enddo + enddo + end if + + else ! sp /= 3 + + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map) + tmp_row = (0.d0,0.d0) + do putj=1,hfix-1 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + do putj=hfix+1,mo_num + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + + mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1) + do l=puti,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l) + enddo + enddo + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map) + putj = p2 + do puti=1,mo_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1) + do l=p2,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p2,l) = mat(k,p2,l) + tmp_row(k,l) + enddo + enddo + mat(:,:p1-1,p1) = mat(:,:p1-1,p1) + tmp_row2(:,:p1-1) + do l=p1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row2(k,l) + enddo + enddo + end if + end if + deallocate(lbanned,hij_cache) + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + call i_h_j_complex(gen, det, N_int, hij) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij + enddo + end do + end do +end + + + + +subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: check all indices for complex; check coef conjg for complex + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + integer :: i, j, k, s, h1, h2, p1, p2, puti, putj + double precision :: phase + complex*16 :: hij + double precision, external :: get_phase_bi + double precision, external :: mo_two_e_integral_complex + logical :: ok + + integer, parameter :: bant=1 + complex*16, allocatable :: hij_cache1(:), hij_cache2(:) + allocate (hij_cache1(mo_num),hij_cache2(mo_num)) + + + if(sp == 3) then ! AB + h1 = p(1,1) + h2 = p(1,2) + do p1=1, mo_num + if(bannedOrb(p1, 1)) cycle + call get_mo_two_e_integrals_complex(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map) + do p2=1, mo_num + if(bannedOrb(p2,2)) cycle + if(banned(p1, p2, bant)) cycle ! rentable? + if(p1 == h1 .or. p2 == h2) then + call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) + call i_h_j_complex(gen, det, N_int, hij) + else + phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) + hij = hij_cache1(p2) * phase + end if + if (hij == 0.d0) cycle + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT + enddo + end do + end do + + else ! AA BB + p1 = p(1,sp) + p2 = p(2,sp) + do puti=1, mo_num + if(bannedOrb(puti, sp)) cycle + call get_mo_two_e_integrals_complex(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map) + call get_mo_two_e_integrals_complex(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map) + do putj=puti+1, mo_num + if(bannedOrb(putj, sp)) cycle + if(banned(puti, putj, bant)) cycle ! rentable? + if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then + call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) + call i_h_j_complex(gen, det, N_int, hij) + if (hij == 0.d0) cycle + else + hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj)) + if (hij == 0.d0) cycle + hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) + end if + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + end do + end do + end if + + deallocate(hij_cache1,hij_cache2) +end + diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index 91edd66d..2d12359a 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -267,6 +267,7 @@ subroutine run_slave_main nproc_target = nthreads_pt2 ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) + !todo: change memory estimate for complex do mem = rss + & ! nproc_target * 8.d0 * & ! bytes diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 5a5da8b6..7a07577a 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -92,13 +92,13 @@ subroutine run_stochastic_cipsi pt2 = 0.d0 variance = 0.d0 norm = 0.d0 - if (is_complex) then - call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & - norm, to_select) ! Stochastic PT2 and selection - else +! if (is_complex) then +! call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & +! norm, to_select) ! Stochastic PT2 and selection +! else call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & norm, to_select) ! Stochastic PT2 and selection - endif +! endif do k=1,N_states rpt2(k) = pt2(k)/(1.d0 + norm(k)) @@ -155,13 +155,13 @@ subroutine run_stochastic_cipsi pt2(:) = 0.d0 variance(:) = 0.d0 norm(:) = 0.d0 - if (is_complex) then - call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & - norm,0) ! Stochastic PT2 - else + ! if (is_complex) then + ! call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & + ! norm,0) ! Stochastic PT2 + ! else call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & norm,0) ! Stochastic PT2 - endif + ! endif do k=1,N_states rpt2(k) = pt2(k)/(1.d0 + norm(k)) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 95febce1..6d0c5a0a 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -7,6 +7,9 @@ current: splash_pq (separate real/complex) get_d{0,1,2} (separate real/complex) fill_buffer_double (separate real/complex) + started splash_pq, get_d{0,1,2}, fill_buffer_double for complex + need to check hole particle index ordering (also in select_singles_and_doubles) + need to check for coef dconjg fci run_{,stochastic_}cipsi From 5b214ac3c1cd2d2c039b3f8e01896cbb680f9af6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 4 Mar 2020 18:00:54 -0600 Subject: [PATCH 125/256] finished complex selection --- src/cipsi/selection.irp.f | 275 ++++++++++++++++++++++++++------------ 1 file changed, 193 insertions(+), 82 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 67c6d4fa..b5d9cce9 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -193,6 +193,9 @@ subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset) call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) + ! possible holes and particles for this generator + ! hole_mask: occupied in this generator .AND. occupied in generators_bitmask_hole + ! part_mask: unoccupied in this generator .AND. occupied in generators_bitmask_part do k=1,N_int hole_mask(k,1) = iand(generators_bitmask(k,1,s_hole), psi_det_generators(k,1,i_generator)) hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole), psi_det_generators(k,2,i_generator)) @@ -298,7 +301,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d monoAdo = .true. monoBdo = .true. - + !todo: this is already done in select_connected? why repeat? do k=1,N_int hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) hole (k,2) = iand(psi_det_generators(k,2,i_generator), hole_mask(k,2)) @@ -319,19 +322,39 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate (indices(N_det), & exc_degree(max(N_det_alpha_unique,N_det_beta_unique))) + + ! S_s = selectors + ! S_0 = {|D_G>} (i_generator determinant) + ! S_j = {|D_k> : |D_k> \in T_j|D_G> } (i.e. S_2 is all dets connected to |D_G> by a double excitation) + ! S_2b = S_2 \intersection {|D_k> : a_{h1}|D_k> != 0} (in S_2 and h1 is occupied) + ! S_2' = S_2 \ {|D_k> : a_{h1}|D_k> != 0} (in S_2 and h1 is not occupied) + ! S_4b = S_4 \intersection {|D_k> : a_{h1}|D_k> != 0} (in S_4 and h1 is occupied) + ! S_4' = S_4 \ {|D_k> : a_{h1}|D_k> != 0} (in S_4 and h1 is not occupied) + + ! construct the following sets of determinants: + ! preinteresting: S_pi = (U_{j=0..4} S_j) \intersection S_s + ! prefullinteresting: S_pfi = (U_{j=0..2} S_j) \ S_s + ! interesting: S_i = S_pi \ S_4b = ( (U_{j=0..3} S_j) U S_4' ) \intersection S_s + ! fullinteresting: S_fi = S_i U (S_pfi \ S_2b) = (S_0 U S_1 U S_2') + ! (in order, first elements are in S_s, later elements are not in S_s) + + + ! get indices of all unique dets for which total excitation degree (relative to i_generator) is <= 4 k=1 + ! get exc_degree(i) for each unique alpha det(i) from i_generator(alpha) do i=1,N_det_alpha_unique call get_excitation_degree_spin(psi_det_alpha_unique(1,i), & psi_det_generators(1,1,i_generator), exc_degree(i), N_int) enddo + ! get exc_degree (= nt) for each unique beta det(j) from i_generator(beta) do j=1,N_det_beta_unique call get_excitation_degree_spin(psi_det_beta_unique(1,j), & psi_det_generators(1,2,i_generator), nt, N_int) - if (nt > 2) cycle + if (nt > 2) cycle ! don't keep anything more than double beta exc do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1 i = psi_bilinear_matrix_rows(l_a) - if (nt + exc_degree(i) <= 4) then + if (nt + exc_degree(i) <= 4) then ! don't keep anything more than 4-fold total exc idx = psi_det_sorted_order(psi_bilinear_matrix_order(l_a)) if (psi_average_norm_contrib_sorted(idx) > 1.d-12) then indices(k) = idx @@ -341,6 +364,23 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo enddo + + ! indices now contains det indices (in psi_det_sorted) of dets which differ from generator by: + ! (exc_alpha,exc_beta) in + ! (4,0) + ! (3,0), (3,1) + ! (2,0), (2,1), (2,2) + ! (1,0), (1,1), (1,2) + ! (0,0), (0,1), (0,2) + ! + ! (4,0) + ! (3,0), (3,1) + ! (2,0), (2,1), (2,2) + ! (1,0), (1,1), (1,2) + ! (0,0), (0,1), (0,2) + ! + ! below, add (0,3), (0,4), (1,3) + do i=1,N_det_beta_unique call get_excitation_degree_spin(psi_det_beta_unique(1,i), & psi_det_generators(1,2,i_generator), exc_degree(i), N_int) @@ -374,6 +414,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo call isort(indices,iorder,nmax) deallocate(iorder) + ! sort indices by location in psi_det_sorted ! Start with 32 elements. Size will double along with the filtering. allocate(preinteresting(0:32), prefullinteresting(0:32), & @@ -388,6 +429,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d do k=1,nmax i = indices(k) + ! mobMask in psi_det(i) but not in i_generator + ! nt = popcnt(mobMask) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) @@ -397,6 +440,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) end do + ! preinteresting: within a 4-fold excitation from i_generator; in selectors + ! prefullinteresting: within a double excitation from i_generator; not in selectors + if(nt <= 4) then if(i <= N_det_selectors) then sze = preinteresting(0) @@ -431,11 +477,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! print *, 'Step1: ', i_generator, preinteresting(0) ! !$OMP END CRITICAL -!------------------------------------------------------------| -! | -! Real | -! | -!------------------------------------------------------------| allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2)) if (is_complex) then allocate (mat_complex(N_states, mo_num, mo_num)) @@ -470,10 +511,13 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d maskInd = maskInd_save h1 = hole_list(i1,s1) +!todo kpt1 = (h1-1)/mo_num_per_kpt + 1 + ! pmask is i_generator det with bit at h1 set to zero call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) negMask = not(pmask) + ! see set definitions above interesting(0) = 0 fullinteresting(0) = 0 @@ -533,6 +577,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d end do end select + ! nt = ( orbs occupied in preinteresting(ii) and not occupied in i_gen(after removing elec from h1) ) if(nt <= 4) then sze = interesting(0) if (sze+1 == size(interesting)) then @@ -594,12 +639,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate (fullminilist (N_int, 2, fullinteresting(0)), & minilist (N_int, 2, interesting(0)) ) if(pert_2rdm)then - allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) - do i=1,fullinteresting(0) - do j = 1, N_states - coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j) + if (is_complex) then + print*,irp_here,' not implemented for complex: pert_2rdm' + stop -1 + else + allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) + do i=1,fullinteresting(0) + do j = 1, N_states + coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j) + enddo enddo - enddo + endif endif do i=1,fullinteresting(0) @@ -621,23 +671,54 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d do i2=N_holes(s2),ib,-1 ! Generate low excitations first h2 = hole_list(i2,s2) - call apply_hole(pmask, s2,h2, mask, ok, N_int) - banned = .false. + if (is_complex) then +!============================================================= +!!todo use this once kpts are implemented +! kpt2 = (h2-1)/mo_num_per_kpt + 1 +! kpt12 = kconserv(kpt1,kpt2,1) +! ! mask is gen_i with (h1,s1),(h2,s2) removed +! call apply_hole(pmask, s2,h2, mask, ok, N_int) +! banned = .true. +! ! only allow excitations that conserve momentum +! do kk1=1,kpt_num +! ! equivalent to kk2 = kconserv(kpt1,kpt2,kk1) +! kk2 = kconserv(kpt12,1,kk1) +! ik01 = (kk1-1) * mo_num_per_kpt + 1 !first mo in kk1 +! ik02 = (kk2-1) * mo_num_per_kpt + 1 !first mo in kk2 +! do ik1 = ik01, ik01 + mo_num_per_kpt - 1 !loop over mos in kk1 +! do ik2 = ik02, ik02 + mo_num_per_kpt - 1 !loop over mos in kk2 +! ! depending on sp, might not need both of these? +! ! sp=1 (a,a) or sp=2 (b,b): only use banned(:,:,1) +! ! sp=3 (a,b): banned(alpha,beta,1) is transpose of banned(beta,alpha,2) +! banned(ik1,ik2,1) = .false. +! banned(ik1,ik2,2) = .false. +! enddo +! enddo +! enddo +!============================================================= + ! mask is gen_i with (h1,s1),(h2,s2) removed + call apply_hole(pmask, s2,h2, mask, ok, N_int) + banned = .false. +!============================================================= + else + call apply_hole(pmask, s2,h2, mask, ok, N_int) + banned = .false. + endif do j=1,mo_num bannedOrb(j, 1) = .true. bannedOrb(j, 2) = .true. enddo do s3=1,2 do i=1,N_particles(s3) - bannedOrb(particle_list(i,s3), s3) = .false. + bannedOrb(particle_list(i,s3), s3) = .false. ! allow excitation into orbitals in particle_list enddo enddo if(s1 /= s2) then if(monoBdo) then - bannedOrb(h1,s1) = .false. + bannedOrb(h1,s1) = .false. ! allow alpha elec to go back into alpha hole end if if(monoAdo) then - bannedOrb(h2,s2) = .false. + bannedOrb(h2,s2) = .false. ! allow beta elec to go back into beta hole monoAdo = .false. end if end if @@ -656,7 +737,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d if(.not.pert_2rdm)then call fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat_complex, buf) else - print*,irp_here,' not implemented for complex' + print*,irp_here,' not implemented for complex (fill_buffer_double_rdm_complex)' stop -1 !call fill_buffer_double_rdm_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat_complex, buf,fullminilist, coef_fullminilist_rev_complex, fullinteresting(0)) endif @@ -670,15 +751,20 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d endif endif!complex end if - enddo + enddo !i2 if(s1 /= s2) monoBdo = .false. - enddo + enddo !s2 deallocate(fullminilist,minilist) if(pert_2rdm)then - deallocate(coef_fullminilist_rev) + if (is_complex) then + print*,irp_here,' not implemented for complex: pert_2rdm' + stop -1 + else + deallocate(coef_fullminilist_rev) + endif endif - enddo - enddo + enddo ! i1 + enddo ! s1 deallocate(preinteresting, prefullinteresting, interesting, fullinteresting) deallocate(banned, bannedOrb) if (is_complex) then @@ -1536,7 +1622,7 @@ subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting) genl : do i=1, N ! If det(i) can't be generated by the mask, cycle - do j=1, N_int + do j=1, N_int ! if all occupied orbs in mask are not also occupied in det(i), go to next det if(iand(det(j,1,i), mask(j,1)) /= mask(j, 1)) cycle genl if(iand(det(j,2,i), mask(j,2)) /= mask(j, 2)) cycle genl end do @@ -1548,11 +1634,14 @@ subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting) end if ! Identify the particles - do j=1, N_int + do j=1, N_int ! if electrons are excited into the orbs given by myMask, resulting determinant will be det(i) myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1)) myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2)) end do + ! don't allow excitations into this pair of orbitals? + ! should 'banned' have dimensions (mo_num,mo_num,2)? + ! is it always true that popcnt(myMask) = 2 ? (sum over N_int and alpha/beta spins) call bitstring_to_list_in_selection(myMask(1,1), list(1), na, N_int) call bitstring_to_list_in_selection(myMask(1,2), list(na+1), nb, N_int) banned(list(1), list(2)) = .true. @@ -2065,7 +2154,7 @@ subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned tmp = -tmp endif e_pert = 0.5d0 * (tmp - delta_E) - if (dabs(alpha_h_psi) > 1.d-4) then + if (cdabs(alpha_h_psi) > 1.d-4) then coef = e_pert / alpha_h_psi else coef = alpha_h_psi / delta_E @@ -2136,6 +2225,7 @@ subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat integer, intent(in) :: interesting(0:N_sel) integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) logical, intent(inout) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num, 2) + ! mat should be out, not inout? (if only called from select_singles_and_doubles) complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt @@ -2185,7 +2275,8 @@ subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat end if end if - if (interesting(i) >= i_gen) then + ! p contains orbs in det that are not in the doubly ionized generator + if (interesting(i) >= i_gen) then ! det past i_gen call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) @@ -2196,25 +2287,23 @@ subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) end do + ! h contains orbs in the doubly ionized generator that are not in det call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask,N_int) - if(nt == 4) then -! call get_d2_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - call get_d2_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else if(nt == 3) then -! call get_d1_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - call get_d1_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else -! call get_d0_reference(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - call get_d0_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + if(nt == 4) then ! differ by 6 (2,4) + call get_d2_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) + else if(nt == 3) then ! differ by 4 (1,3) + call get_d1_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) + else ! differ by 2 (0,2) + call get_d0_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) end if - else if(nt == 4) then + else if(nt == 4) then ! differ by 6 (2,4); i_gen past det call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) call past_d2(banned, p, sp) - else if(nt == 3) then + else if(nt == 3) then ! differ by 4 (1,3); i_gen past det call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) call past_d1(bannedOrb, p) @@ -2225,7 +2314,7 @@ end subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) - !todo: check all indices for complex; check coef conjg for complex + !todo: indices/conjg should be correct for complex use bitmasks implicit none @@ -2251,51 +2340,63 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp integer :: bant bant = 1 - tip = p(0,1) * p(0,2) + tip = p(0,1) * p(0,2) ! number of alpha particles times number of beta particles - ma = sp - if(p(0,1) > p(0,2)) ma = 1 - if(p(0,1) < p(0,2)) ma = 2 + ma = sp !1:(alpha,alpha); 2:(b,b); 3:(a,b) + if(p(0,1) > p(0,2)) ma = 1 ! more alpha particles than beta particles + if(p(0,1) < p(0,2)) ma = 2 ! fewer alpha particles than beta particles mi = mod(ma, 2) + 1 - if(sp == 3) then - if(ma == 2) bant = 2 + if(sp == 3) then ! if one alpha and one beta xhole + !(where xholes refer to the ionizations from the generator, not the holes occupied in the ionized generator) + if(ma == 2) bant = 2 ! if more beta particles than alpha particles - if(tip == 3) then + if(tip == 3) then ! if 3 of one particle spin and 1 of the other particle spin puti = p(1, mi) if(bannedOrb(puti, mi)) return h1 = h(1, ma) h2 = h(2, ma) - do i = 1, 3 + do i = 1, 3 ! loop over all 3 combinations of 2 particles with spin ma putj = p(i, ma) if(banned(putj,puti,bant)) cycle i1 = turn3(1,i) i2 = turn3(2,i) p1 = p(i1, ma) p2 = p(i2, ma) - + + ! |G> = |psi_{gen,i}> + ! |G'> = a_{x1} a_{x2} |G> + ! |alpha> = a_{puti}^{\dagger} a_{putj}^{\dagger} |G'> + ! |alpha> = t_{x1,x2}^{puti,putj} |G> + ! hij = + ! |alpha> = t_{p1,p2}^{h1,h2}|psi_{selectors,i}> + !todo: = ( - ) * phase + ! += dconjg(c_i) * + ! = ( - ) * phase + ! += * c_i hij = mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2, p1, h1, h2) if (hij == (0.d0,0.d0)) cycle - hij = hij * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) + ! take conjugate to get contribution to instead of + hij = dconjg(hij) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) - if(ma == 1) then + if(ma == 1) then ! if particle spins are (alpha,alpha,alpha,beta), then puti is beta and putj is alpha !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, putj, puti) = mat(k, putj, puti) + coefs(k) * hij enddo - else + else ! if particle spins are (beta,beta,beta,alpha), then puti is alpha and putj is beta !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij enddo end if end do - else + else ! if 2 alpha and 2 beta particles h1 = h(1,1) h2 = h(1,2) - do j = 1,2 + do j = 1,2 ! loop over all 4 combinations of one alpha and one beta particle putj = p(j, 2) if(bannedOrb(putj, 2)) cycle p2 = p(turn2(j), 2) @@ -2305,9 +2406,11 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp if(banned(puti,putj,bant) .or. bannedOrb(puti,1)) cycle p1 = p(turn2(i), 1) + ! hij = hij = mo_two_e_integral_complex(p1, p2, h1, h2) if (hij /= (0.d0,0.d0)) then - hij = hij * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) + ! take conjugate to get contribution to instead of + hij = dconjg(hij) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij @@ -2317,8 +2420,8 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp end do end if - else - if(tip == 0) then + else ! if holes are (a,a) or (b,b) + if(tip == 0) then ! if particles are (a,a,a,a) or (b,b,b,b) h1 = h(1, ma) h2 = h(2, ma) do i=1,3 @@ -2336,14 +2439,15 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp hij = mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2,p1, h1, h2) if (hij == (0.d0,0.d0)) cycle - hij = hij * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) + ! take conjugate to get contribution to instead of + hij = dconjg(hij) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, puti, putj) = mat(k, puti, putj) +coefs(k) * hij enddo end do end do - else if(tip == 3) then + else if(tip == 3) then ! if particles are (a,a,a,b) (ma=1,mi=2) or (a,b,b,b) (ma=2,mi=1) h1 = h(1, mi) h2 = h(1, ma) p1 = p(1, mi) @@ -2358,7 +2462,8 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp hij = mo_two_e_integral_complex(p1, p2, h1, h2) if (hij == (0.d0,0.d0)) cycle - hij = hij * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2, N_int) + ! take conjugate to get contribution to instead of + hij = dconjg(hij) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2, N_int) if (puti < putj) then !DIR$ LOOP COUNT AVG(4) do k=1,N_states @@ -2371,7 +2476,7 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp enddo endif end do - else ! tip == 4 + else ! tip == 4 (a,a,b,b) puti = p(1, sp) putj = p(2, sp) if(.not. banned(puti,putj,1)) then @@ -2381,7 +2486,8 @@ subroutine get_d2_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp h2 = h(2, mi) hij = (mo_two_e_integral_complex(p1, p2, h1, h2) - mo_two_e_integral_complex(p2,p1, h1, h2)) if (hij /= (0.d0,0.d0)) then - hij = hij * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2, N_int) + ! take conjugate to get contribution to instead of + hij = dconjg(hij) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2, N_int) !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij @@ -2394,7 +2500,7 @@ end subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) - !todo: check all indices for complex; check coef conjg for complex + !todo: indices should be okay for complex? use bitmasks implicit none @@ -2446,8 +2552,8 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp p1 = p(1,ma) p2 = p(2,ma) if(.not. bannedOrb(puti, mi)) then - call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map) - call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) tmp_row = (0.d0,0.d0) do putj=1, hfix-1 if(lbanned(putj, ma)) cycle @@ -2490,8 +2596,8 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp pfix = p(1,mi) tmp_row = (0.d0,0.d0) tmp_row2 = (0.d0,0.d0) - call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map) - call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) putj = p1 do puti=1,mo_num !HOT if(lbanned(puti,mi)) cycle @@ -2543,8 +2649,8 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp puti = p(i, ma) p1 = p(turn3(1,i), ma) p2 = p(turn3(2,i), ma) - call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map) - call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) tmp_row = (0.d0,0.d0) do putj=1,hfix-1 if(banned(putj,puti,1)) cycle @@ -2580,8 +2686,8 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp p2 = p(2,ma) tmp_row = (0.d0,0.d0) tmp_row2 = (0.d0,0.d0) - call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map) - call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map) + call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) putj = p2 do puti=1,mo_num if(lbanned(puti,ma)) cycle @@ -2643,10 +2749,13 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp p2 = p(i2,s2) if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + ! gen is a selector; mask is ionized generator; det is alpha + ! hij is contribution to call i_h_j_complex(gen, det, N_int, hij) !DIR$ LOOP COUNT AVG(4) do k=1,N_states - mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij + ! take conjugate to get contribution to instead of + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * dconjg(hij) enddo end do end do @@ -2656,7 +2765,7 @@ end subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) - !todo: check all indices for complex; check coef conjg for complex + !todo: indices/conjg should be okay for complex use bitmasks implicit none @@ -2672,7 +2781,7 @@ subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp double precision :: phase complex*16 :: hij double precision, external :: get_phase_bi - double precision, external :: mo_two_e_integral_complex + complex*16, external :: mo_two_e_integral_complex logical :: ok integer, parameter :: bant=1 @@ -2691,12 +2800,13 @@ subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp if(banned(p1, p2, bant)) cycle ! rentable? if(p1 == h1 .or. p2 == h2) then call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) - call i_h_j_complex(gen, det, N_int, hij) + ! call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this + call i_h_j_complex(det, gen, N_int, hij) else phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) hij = hij_cache1(p2) * phase end if - if (hij == 0.d0) cycle + if (hij == (0.d0,0.d0)) cycle !DIR$ LOOP COUNT AVG(4) do k=1,N_states mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT @@ -2709,19 +2819,20 @@ subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp p2 = p(2,sp) do puti=1, mo_num if(bannedOrb(puti, sp)) cycle - call get_mo_two_e_integrals_complex(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map) - call get_mo_two_e_integrals_complex(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map) + call get_mo_two_e_integrals_complex(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map,mo_integrals_map_2) do putj=puti+1, mo_num if(bannedOrb(putj, sp)) cycle if(banned(puti, putj, bant)) cycle ! rentable? if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) - call i_h_j_complex(gen, det, N_int, hij) - if (hij == 0.d0) cycle + !call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this + call i_h_j_complex(det, gen, N_int, hij) + if (hij == (0.d0,0.d0)) cycle else hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj)) - if (hij == 0.d0) cycle - hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) + if (hij == (0.d0,0.d0)) cycle + hij = dconjg(hij) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) end if !DIR$ LOOP COUNT AVG(4) do k=1,N_states From d6fb0f63fe120389ff9b59c9d820a0b70243e298 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 4 Mar 2020 18:20:03 -0600 Subject: [PATCH 126/256] complex cleanup --- src/cipsi/pt2_stoch_routines.irp.f | 472 +++++++++++++-------------- src/cipsi/selection.irp.f | 3 +- src/cipsi/zmq_selection.irp.f | 296 ++++++++--------- src/davidson/davidson_parallel.irp.f | 40 +-- src/davidson/diagonalize_ci.irp.f | 4 +- src/davidson/u0_h_u0.irp.f | 19 +- 6 files changed, 409 insertions(+), 425 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index e487d39b..94ed962b 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -854,240 +854,240 @@ END_PROVIDER -subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in) - !todo: implement for complex - print*,irp_here - stop -1 - use f77_zmq - use selection_types - - implicit none - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull - integer, intent(in) :: N_in - double precision, intent(in) :: relative_error, E(N_states) - double precision, intent(out) :: pt2(N_states),error(N_states) - double precision, intent(out) :: variance(N_states),norm(N_states) - - - integer :: i, N - - double precision :: state_average_weight_save(N_states), w(N_states,4) - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - type(selection_buffer) :: b - - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted - PROVIDE psi_det_hii selection_weight pseudo_sym - - if (h0_type == 'SOP') then - PROVIDE psi_occ_pattern_hii det_to_occ_pattern - endif - - if (N_det <= max(4,N_states)) then - pt2=0.d0 - variance=0.d0 - norm=0.d0 - call zmq_selection_complex(N_in, pt2, variance, norm) - error(:) = 0.d0 - else - - N = max(N_in,1) * N_states - state_average_weight_save(:) = state_average_weight(:) - if (int(N,8)*2_8 > huge(1)) then - print *, irp_here, ': integer too large' - stop -1 - endif - call create_selection_buffer(N, N*2, b) - ASSERT (associated(b%det)) - ASSERT (associated(b%val)) - - do pt2_stoch_istate=1,N_states - state_average_weight(:) = 0.d0 - state_average_weight(pt2_stoch_istate) = 1.d0 - TOUCH state_average_weight pt2_stoch_istate selection_weight - - PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w - PROVIDE psi_selectors pt2_u pt2_J pt2_R - call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - integer, external :: zmq_put_ivector - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then - stop 'Unable to put state_average_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then - stop 'Unable to put selection_weight on ZMQ server' - endif - if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then - stop 'Unable to put pt2_stoch_istate on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then - stop 'Unable to put threshold_generators on ZMQ server' - endif - - - integer, external :: add_task_to_taskserver - character(300000) :: task - - integer :: j,k,ipos,ifirst - ifirst=0 - - ipos=0 - do i=1,N_det_generators - if (pt2_F(i) > 1) then - ipos += 1 - endif - enddo - call write_int(6,sum(pt2_F),'Number of tasks') - call write_int(6,ipos,'Number of fragmented tasks') - - ipos=1 - do i= 1, N_det_generators - do j=1,pt2_F(pt2_J(i)) - write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in - ipos += 30 - if (ipos > 300000-30) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - ipos=1 - if (ifirst == 0) then - ifirst=1 - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - endif - endif - end do - enddo - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - - double precision :: mem_collector, mem, rss - - call resident_memory(rss) - - mem_collector = 8.d0 * & ! bytes - ( 1.d0*pt2_n_tasks_max & ! task_id, index - + 0.635d0*N_det_generators & ! f,d - + 3.d0*N_det_generators*N_states & ! eI, vI, nI - + 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task - + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 - + 1.d0*(N_int*2.d0*N + N) & ! selection buffer - + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer - ) / 1024.d0**3 - - integer :: nproc_target, ii - nproc_target = nthreads_pt2 - ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) - - do - mem = mem_collector + & ! - nproc_target * 8.d0 * & ! bytes - ( 0.5d0*pt2_n_tasks_max & ! task_id - + 64.d0*pt2_n_tasks_max & ! task - + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm - + 1.d0*pt2_n_tasks_max & ! i_generator, subset - + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer - + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer - + 2.0d0*(ii) & ! preinteresting, interesting, - ! prefullinteresting, fullinteresting - + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist - + 1.0d0*(N_states*mo_num*mo_num) & ! mat - ) / 1024.d0**3 - - if (nproc_target == 0) then - call check_mem(mem,irp_here) - nproc_target = 1 - exit - endif - - if (mem+rss < qp_max_mem) then - exit - endif - - nproc_target = nproc_target - 1 - - enddo - call write_int(6,nproc_target,'Number of threads for PT2') - call write_double(6,mem,'Memory (Gb)') - - call omp_set_nested(.false.) - - - print '(A)', '========== ================= =========== =============== =============== =================' - print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' - print '(A)', '========== ================= =========== =============== =============== =================' - - PROVIDE global_selection_buffer - !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & - !$OMP PRIVATE(i) - i = omp_get_thread_num() - if (i==0) then - - call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w(1,1), w(1,2), w(1,3), w(1,4), b, N) - pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1) - error(pt2_stoch_istate) = w(pt2_stoch_istate,2) - variance(pt2_stoch_istate) = w(pt2_stoch_istate,3) - norm(pt2_stoch_istate) = w(pt2_stoch_istate,4) - - else - call pt2_slave_inproc(i) - endif - !$OMP END PARALLEL - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - - print '(A)', '========== ================= =========== =============== =============== =================' - - enddo - FREE pt2_stoch_istate - - if (N_in > 0) then - b%cur = min(N_in,b%cur) - if (s2_eig) then - call make_selection_buffer_s2(b) - else - call remove_duplicates_in_selection_buffer(b) - endif - call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) - endif - call delete_selection_buffer(b) - - state_average_weight(:) = state_average_weight_save(:) - TOUCH state_average_weight - endif - do k=N_det+1,N_states - pt2(k) = 0.d0 - enddo - - call update_pt2_and_variance_weights(pt2, variance, norm, N_states) - -end subroutine +!subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in) +! !todo: implement for complex +! print*,irp_here +! stop -1 +! use f77_zmq +! use selection_types +! +! implicit none +! +! integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull +! integer, intent(in) :: N_in +! double precision, intent(in) :: relative_error, E(N_states) +! double precision, intent(out) :: pt2(N_states),error(N_states) +! double precision, intent(out) :: variance(N_states),norm(N_states) +! +! +! integer :: i, N +! +! double precision :: state_average_weight_save(N_states), w(N_states,4) +! integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket +! type(selection_buffer) :: b +! +! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique +! PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order +! PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns +! PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted +! PROVIDE psi_det_hii selection_weight pseudo_sym +! +! if (h0_type == 'SOP') then +! PROVIDE psi_occ_pattern_hii det_to_occ_pattern +! endif +! +! if (N_det <= max(4,N_states)) then +! pt2=0.d0 +! variance=0.d0 +! norm=0.d0 +! call zmq_selection_complex(N_in, pt2, variance, norm) +! error(:) = 0.d0 +! else +! +! N = max(N_in,1) * N_states +! state_average_weight_save(:) = state_average_weight(:) +! if (int(N,8)*2_8 > huge(1)) then +! print *, irp_here, ': integer too large' +! stop -1 +! endif +! call create_selection_buffer(N, N*2, b) +! ASSERT (associated(b%det)) +! ASSERT (associated(b%val)) +! +! do pt2_stoch_istate=1,N_states +! state_average_weight(:) = 0.d0 +! state_average_weight(pt2_stoch_istate) = 1.d0 +! TOUCH state_average_weight pt2_stoch_istate selection_weight +! +! PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w +! PROVIDE psi_selectors pt2_u pt2_J pt2_R +! call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') +! +! integer, external :: zmq_put_psi +! integer, external :: zmq_put_N_det_generators +! integer, external :: zmq_put_N_det_selectors +! integer, external :: zmq_put_dvector +! integer, external :: zmq_put_ivector +! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then +! stop 'Unable to put psi on ZMQ server' +! endif +! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then +! stop 'Unable to put N_det_generators on ZMQ server' +! endif +! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then +! stop 'Unable to put N_det_selectors on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then +! stop 'Unable to put energy on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then +! stop 'Unable to put state_average_weight on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then +! stop 'Unable to put selection_weight on ZMQ server' +! endif +! if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then +! stop 'Unable to put pt2_stoch_istate on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then +! stop 'Unable to put threshold_generators on ZMQ server' +! endif +! +! +! integer, external :: add_task_to_taskserver +! character(300000) :: task +! +! integer :: j,k,ipos,ifirst +! ifirst=0 +! +! ipos=0 +! do i=1,N_det_generators +! if (pt2_F(i) > 1) then +! ipos += 1 +! endif +! enddo +! call write_int(6,sum(pt2_F),'Number of tasks') +! call write_int(6,ipos,'Number of fragmented tasks') +! +! ipos=1 +! do i= 1, N_det_generators +! do j=1,pt2_F(pt2_J(i)) +! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in +! ipos += 30 +! if (ipos > 300000-30) then +! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then +! stop 'Unable to add task to task server' +! endif +! ipos=1 +! if (ifirst == 0) then +! ifirst=1 +! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then +! print *, irp_here, ': Failed in zmq_set_running' +! endif +! endif +! endif +! end do +! enddo +! if (ipos > 1) then +! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then +! stop 'Unable to add task to task server' +! endif +! endif +! +! integer, external :: zmq_set_running +! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then +! print *, irp_here, ': Failed in zmq_set_running' +! endif +! +! +! double precision :: mem_collector, mem, rss +! +! call resident_memory(rss) +! +! mem_collector = 8.d0 * & ! bytes +! ( 1.d0*pt2_n_tasks_max & ! task_id, index +! + 0.635d0*N_det_generators & ! f,d +! + 3.d0*N_det_generators*N_states & ! eI, vI, nI +! + 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task +! + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 +! + 1.d0*(N_int*2.d0*N + N) & ! selection buffer +! + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer +! ) / 1024.d0**3 +! +! integer :: nproc_target, ii +! nproc_target = nthreads_pt2 +! ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) +! +! do +! mem = mem_collector + & ! +! nproc_target * 8.d0 * & ! bytes +! ( 0.5d0*pt2_n_tasks_max & ! task_id +! + 64.d0*pt2_n_tasks_max & ! task +! + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm +! + 1.d0*pt2_n_tasks_max & ! i_generator, subset +! + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer +! + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer +! + 2.0d0*(ii) & ! preinteresting, interesting, +! ! prefullinteresting, fullinteresting +! + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist +! + 1.0d0*(N_states*mo_num*mo_num) & ! mat +! ) / 1024.d0**3 +! +! if (nproc_target == 0) then +! call check_mem(mem,irp_here) +! nproc_target = 1 +! exit +! endif +! +! if (mem+rss < qp_max_mem) then +! exit +! endif +! +! nproc_target = nproc_target - 1 +! +! enddo +! call write_int(6,nproc_target,'Number of threads for PT2') +! call write_double(6,mem,'Memory (Gb)') +! +! call omp_set_nested(.false.) +! +! +! print '(A)', '========== ================= =========== =============== =============== =================' +! print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' +! print '(A)', '========== ================= =========== =============== =============== =================' +! +! PROVIDE global_selection_buffer +! !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & +! !$OMP PRIVATE(i) +! i = omp_get_thread_num() +! if (i==0) then +! +! call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w(1,1), w(1,2), w(1,3), w(1,4), b, N) +! pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1) +! error(pt2_stoch_istate) = w(pt2_stoch_istate,2) +! variance(pt2_stoch_istate) = w(pt2_stoch_istate,3) +! norm(pt2_stoch_istate) = w(pt2_stoch_istate,4) +! +! else +! call pt2_slave_inproc(i) +! endif +! !$OMP END PARALLEL +! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') +! +! print '(A)', '========== ================= =========== =============== =============== =================' +! +! enddo +! FREE pt2_stoch_istate +! +! if (N_in > 0) then +! b%cur = min(N_in,b%cur) +! if (s2_eig) then +! call make_selection_buffer_s2(b) +! else +! call remove_duplicates_in_selection_buffer(b) +! endif +! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) +! endif +! call delete_selection_buffer(b) +! +! state_average_weight(:) = state_average_weight_save(:) +! TOUCH state_average_weight +! endif +! do k=N_det+1,N_states +! pt2(k) = 0.d0 +! enddo +! +! call update_pt2_and_variance_weights(pt2, variance, norm, N_states) +! +!end subroutine diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index b5d9cce9..29cbc2d9 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2037,7 +2037,7 @@ end !==============================================================================! subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf) - !todo: check indices for complex? + !todo: should be okay for complex use bitmasks use selection_types implicit none @@ -2212,7 +2212,6 @@ subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned end subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) - !todo: check indices for complex? use bitmasks implicit none BEGIN_DOC diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index d87c68a0..059166fa 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -17,7 +17,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm) N = max(N_in,1) if (.True.) then - !todo: some providers have becom unlinked for real/complex (det/coef); do these need to be provided? + !todo: some providers have become unlinked for real/complex (det/coef); do these need to be provided? PROVIDE pt2_e0_denominator nproc PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order @@ -239,150 +239,150 @@ end subroutine ! ! !==============================================================================! -subroutine ZMQ_selection_complex(N_in, pt2, variance, norm) - !todo: implement - print*,irp_here - stop -1 - use f77_zmq - use selection_types - - implicit none - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull - integer, intent(in) :: N_in - type(selection_buffer) :: b - integer :: i, N - integer, external :: omp_get_thread_num - double precision, intent(out) :: pt2(N_states) - double precision, intent(out) :: variance(N_states) - double precision, intent(out) :: norm(N_states) - -! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators - - N = max(N_in,1) - if (.True.) then - PROVIDE pt2_e0_denominator nproc - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym - - - call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then - stop 'Unable to put state_average_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then - stop 'Unable to put selection_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then - stop 'Unable to put threshold_generators on ZMQ server' - endif - call create_selection_buffer(N, N*2, b) - endif - - integer, external :: add_task_to_taskserver - character(len=100000) :: task - integer :: j,k,ipos - ipos=1 - task = ' ' - - do i= 1, N_det_generators - do j=1,pt2_F(i) - write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N - ipos += 30 - if (ipos > 100000-30) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - ipos=1 - endif - end do - enddo - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - - - ASSERT (associated(b%det)) - ASSERT (associated(b%val)) - - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - integer :: nproc_target - if (N_det < 3*nproc) then - nproc_target = N_det/4 - else - nproc_target = nproc - endif - double precision :: mem - mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3) - call write_double(6,mem,'Estimated memory/thread (Gb)') - if (qp_max_mem > 0) then - nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem))) - nproc_target = min(nproc_target,nproc) - endif - - f(:) = 1.d0 - if (.not.do_pt2) then - double precision :: f(N_states), u_dot_u_complex - do k=1,min(N_det,N_states) - f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors) - enddo - endif - - !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) - i = omp_get_thread_num() - if (i==0) then - call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) - else - call selection_slave_inproc(i) - endif - !$OMP END PARALLEL - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection') - do i=N_det+1,N_states - pt2(i) = 0.d0 - variance(i) = 0.d0 - norm(i) = 0.d0 - enddo - if (N_in > 0) then - if (s2_eig) then - call make_selection_buffer_s2(b) - endif - call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) - call copy_H_apply_buffer_to_wf() - call save_wavefunction - endif - call delete_selection_buffer(b) - do k=1,N_states - pt2(k) = pt2(k) * f(k) - variance(k) = variance(k) * f(k) - norm(k) = norm(k) * f(k) - enddo - - call update_pt2_and_variance_weights(pt2, variance, norm, N_states) - -end subroutine +!subroutine ZMQ_selection_complex(N_in, pt2, variance, norm) +! !todo: implement +! print*,irp_here +! stop -1 +! use f77_zmq +! use selection_types +! +! implicit none +! +! integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull +! integer, intent(in) :: N_in +! type(selection_buffer) :: b +! integer :: i, N +! integer, external :: omp_get_thread_num +! double precision, intent(out) :: pt2(N_states) +! double precision, intent(out) :: variance(N_states) +! double precision, intent(out) :: norm(N_states) +! +!! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators +! +! N = max(N_in,1) +! if (.True.) then +! PROVIDE pt2_e0_denominator nproc +! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique +! PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order +! PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns +! PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym +! +! +! call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') +! +! integer, external :: zmq_put_psi +! integer, external :: zmq_put_N_det_generators +! integer, external :: zmq_put_N_det_selectors +! integer, external :: zmq_put_dvector +! +! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then +! stop 'Unable to put psi on ZMQ server' +! endif +! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then +! stop 'Unable to put N_det_generators on ZMQ server' +! endif +! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then +! stop 'Unable to put N_det_selectors on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then +! stop 'Unable to put energy on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then +! stop 'Unable to put state_average_weight on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then +! stop 'Unable to put selection_weight on ZMQ server' +! endif +! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then +! stop 'Unable to put threshold_generators on ZMQ server' +! endif +! call create_selection_buffer(N, N*2, b) +! endif +! +! integer, external :: add_task_to_taskserver +! character(len=100000) :: task +! integer :: j,k,ipos +! ipos=1 +! task = ' ' +! +! do i= 1, N_det_generators +! do j=1,pt2_F(i) +! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N +! ipos += 30 +! if (ipos > 100000-30) then +! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then +! stop 'Unable to add task to task server' +! endif +! ipos=1 +! endif +! end do +! enddo +! if (ipos > 1) then +! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then +! stop 'Unable to add task to task server' +! endif +! endif +! +! +! ASSERT (associated(b%det)) +! ASSERT (associated(b%val)) +! +! integer, external :: zmq_set_running +! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then +! print *, irp_here, ': Failed in zmq_set_running' +! endif +! +! integer :: nproc_target +! if (N_det < 3*nproc) then +! nproc_target = N_det/4 +! else +! nproc_target = nproc +! endif +! double precision :: mem +! mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3) +! call write_double(6,mem,'Estimated memory/thread (Gb)') +! if (qp_max_mem > 0) then +! nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem))) +! nproc_target = min(nproc_target,nproc) +! endif +! +! f(:) = 1.d0 +! if (.not.do_pt2) then +! double precision :: f(N_states), u_dot_u_complex +! do k=1,min(N_det,N_states) +! f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors) +! enddo +! endif +! +! !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) +! i = omp_get_thread_num() +! if (i==0) then +! call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) +! else +! call selection_slave_inproc(i) +! endif +! !$OMP END PARALLEL +! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection') +! do i=N_det+1,N_states +! pt2(i) = 0.d0 +! variance(i) = 0.d0 +! norm(i) = 0.d0 +! enddo +! if (N_in > 0) then +! if (s2_eig) then +! call make_selection_buffer_s2(b) +! endif +! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) +! call copy_H_apply_buffer_to_wf() +! call save_wavefunction +! endif +! call delete_selection_buffer(b) +! do k=1,N_states +! pt2(k) = pt2(k) * f(k) +! variance(k) = variance(k) * f(k) +! norm(k) = norm(k) * f(k) +! enddo +! +! call update_pt2_and_variance_weights(pt2, variance, norm, N_states) +! +!end subroutine diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index 583eb937..128f3156 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -122,7 +122,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, allocate(u_tc(N_st,N_det)) - !todo: resize for complex? + !todo: resize for complex? (should be okay) ! Warning : dimensions are modified for efficiency, It is OK since we get the ! full matrix if (size(u_tc,kind=8) < 8388608_8) then @@ -718,9 +718,6 @@ end !==============================================================================! subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id) - !todo: implement for complex; check double sz - print*,irp_here,' not implemented for complex' - stop -1 use f77_zmq implicit none BEGIN_DOC @@ -745,12 +742,12 @@ subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) if(rc /= 4) stop 'davidson_push_results failed to push imax' - !todo: double sz for complex? - rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE) + !todo: double sz for complex? (done) + rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE) if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' - !todo: double sz for complex? - rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0) + !todo: double sz for complex? (done) + rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0) if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' ! Activate is zmq_socket_push is a REQ @@ -767,9 +764,6 @@ IRP_ENDIF end subroutine subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending) - !todo: implement for complex; check double sz - print*,irp_here,' not implemented for complex' - stop -1 use f77_zmq implicit none BEGIN_DOC @@ -801,21 +795,18 @@ subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, i rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) if(rc /= 4) stop 'davidson_push_results failed to push imax' - !todo: double sz for complex? - rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE) + !todo: double sz for complex? (done) + rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE) if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' - !todo: double sz for complex? - rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0) + !todo: double sz for complex? (done) + rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0) if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' end subroutine subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id) - !todo: implement for complex; check double sz - print*,irp_here,' not implemented for complex' - stop -1 use f77_zmq implicit none BEGIN_DOC @@ -841,12 +832,12 @@ subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, sz = (imax-imin+1)*N_states_diag - !todo: double sz for complex? - rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0) + !todo: double sz for complex? (done) + rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz*2, 0) if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t' - !todo: double sz for complex? - rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0) + !todo: double sz for complex? (done) + rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz*2, 0) if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t' ! Activate if zmq_socket_pull is a REP @@ -863,9 +854,6 @@ end subroutine subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze, N_st) - !todo: implement for complex; check conjg v_t s_t - print*,irp_here,' not implemented for complex' - stop -1 use f77_zmq implicit none BEGIN_DOC @@ -899,8 +887,6 @@ subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, endif do j=1,N_st do i=imin,imax - !todo: conjg or no? - print*,irp_here,' not implemented for complex (conjg?)' v0(i,j) = v0(i,j) + v_t(j,i) s0(i,j) = s0(i,j) + s_t(j,i) enddo diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index a2599461..13152fdd 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -424,7 +424,7 @@ subroutine diagonalize_CI_complex enddo psi_energy(1:N_states) = CI_electronic_energy(1:N_states) psi_s2(1:N_states) = CI_s2(1:N_states) - !todo: touch ci_{sc,electronic_energy}? + !todo: touch ci_{s2,electronic_energy}? SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2 end @@ -443,6 +443,6 @@ subroutine diagonalize_CI psi_energy(1:N_states) = CI_electronic_energy(1:N_states) psi_s2(1:N_states) = CI_s2(1:N_states) - !todo: touch ci_{sc,electronic_energy}? + !todo: touch ci_{s2,electronic_energy}? SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2 end diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 576b3a65..ac98c362 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -1114,12 +1114,12 @@ compute_singles=.True. ASSERT (lrow <= N_det_alpha_unique) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij) call get_s2(tmp_det,tmp_det2,$N_int,sij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) s_t(l,k_a) = s_t(l,k_a) + sij * utl(l,kk+1) enddo @@ -1205,12 +1205,12 @@ compute_singles=.True. ASSERT (lrow <= N_det_alpha_unique) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! single => sij = 0 enddo @@ -1240,11 +1240,11 @@ compute_singles=.True. lrow = psi_bilinear_matrix_rows(l_a) ASSERT (lrow <= N_det_alpha_unique) - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! same spin => sij = 0 enddo @@ -1324,7 +1324,7 @@ compute_singles=.True. call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! single => sij = 0 enddo @@ -1355,12 +1355,12 @@ compute_singles=.True. lcol = psi_bilinear_matrix_transp_columns(l_b) ASSERT (lcol <= N_det_beta_unique) - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg + !todo: check arg order conjg/noconjg (should be okay) v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1) ! same spin => sij = 0 enddo @@ -1390,7 +1390,6 @@ compute_singles=.True. sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0) !DIR$ LOOP COUNT AVG(4) do l=1,N_st - !todo: check arg order conjg/noconjg v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a) s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a) enddo From d19aee172cae70c1226bbe6b2ff62b731c8186e2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Mar 2020 09:00:14 +0100 Subject: [PATCH 127/256] Renamed variables with too long names --- REPLACE | 6 ++++ ...ho_canonical.irp.f => ao_ortho_cano.irp.f} | 4 +-- ...complex.irp.f => ao_ortho_cano_cplx.irp.f} | 4 +-- src/determinants/single_excitations.irp.f | 34 +++++++++---------- src/mo_basis/mos.irp.f | 6 ++-- src/mo_basis/mos_complex.irp.f | 8 ++--- src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f | 8 ++--- src/utils_complex/qp2-pbc-diff.txt | 6 ++-- 8 files changed, 41 insertions(+), 35 deletions(-) rename src/ao_one_e_ints/{ao_ortho_canonical.irp.f => ao_ortho_cano.irp.f} (96%) rename src/ao_one_e_ints/{ao_ortho_canonical_complex.irp.f => ao_ortho_cano_cplx.irp.f} (95%) diff --git a/REPLACE b/REPLACE index 89a62125..f59c99b3 100755 --- a/REPLACE +++ b/REPLACE @@ -239,3 +239,9 @@ qp_name write_ao_integrals --rename=write_ao_two_e_integrals qp_name write_mo_integrals_erf -r write_mo_two_e_integrals_erf qp_name write_mo_integrals --rename="write_mo_two_e_integrals" qp_name write_mo_integrals --rename=write_mo_two_e_integrals +qp_name ao_ortho_canonical_coef_inv_complex -r ao_ortho_cano_coef_inv_cplx +qp_name fock_operator_closed_shell_ref_bitmask -r fock_op_cshell_ref_bitmask +qp_name fock_operator_closed_shell_ref_bitmask_complex -r fock_op_cshell_ref_bitmask_cplx +qp_name ao_ortho_canonical_coef_inv -r ao_ortho_cano_coef_inv +qp_name ao_ortho_cano_to_ao_complex -r ao_ortho_cano_to_ao_cplx +qp_name ao_ortho_lowdin_nucl_elec_integrals_complex -r ao_ortho_lowdin_n_e_ints_cplx diff --git a/src/ao_one_e_ints/ao_ortho_canonical.irp.f b/src/ao_one_e_ints/ao_ortho_cano.irp.f similarity index 96% rename from src/ao_one_e_ints/ao_ortho_canonical.irp.f rename to src/ao_one_e_ints/ao_ortho_cano.irp.f index 21deed41..6d35f2cd 100644 --- a/src/ao_one_e_ints/ao_ortho_canonical.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano.irp.f @@ -84,13 +84,13 @@ END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef_inv, (ao_num,ao_num)] +BEGIN_PROVIDER [ double precision, ao_ortho_cano_coef_inv, (ao_num,ao_num)] implicit none BEGIN_DOC ! ao_ortho_canonical_coef^(-1) END_DOC call get_inverse(ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),& - ao_num, ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1)) + ao_num, ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1)) END_PROVIDER BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num,ao_num)] diff --git a/src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f similarity index 95% rename from src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f rename to src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f index 1ff6cba8..c84fe6a7 100644 --- a/src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f @@ -34,13 +34,13 @@ END_PROVIDER -BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_inv_complex, (ao_num,ao_num)] +BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_cplx, (ao_num,ao_num)] implicit none BEGIN_DOC ! ao_ortho_canonical_coef_complex^(-1) END_DOC call get_inverse_complex(ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1),& - ao_num, ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1)) + ao_num, ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1)) END_PROVIDER BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_complex, (ao_num,ao_num)] diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index 65c8ac7f..eb56f19e 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -19,7 +19,7 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)] END_PROVIDER -BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_num, mo_num) ] +BEGIN_PROVIDER [double precision, fock_op_cshell_ref_bitmask, (mo_num, mo_num) ] implicit none integer :: i0,j0,i,j,k0,k integer :: n_occ_ab(2) @@ -52,8 +52,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask(i,j) = accu + mo_one_e_integrals(i,j) - fock_operator_closed_shell_ref_bitmask(j,i) = accu + mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(i,j) = accu + mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(j,i) = accu + mo_one_e_integrals(i,j) enddo enddo @@ -69,8 +69,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j) - fock_operator_closed_shell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j) enddo enddo @@ -86,8 +86,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j) - fock_operator_closed_shell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j) + fock_op_cshell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j) enddo enddo deallocate(array_coulomb,array_exchange) @@ -123,7 +123,7 @@ subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij) enddo call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij = fock_operator_closed_shell_ref_bitmask(h,p) + hij = fock_op_cshell_ref_bitmask(h,p) ! holes :: direct terms do i0 = 1, n_occ_ab_hole(1) i = occ_hole(i0,1) @@ -161,7 +161,7 @@ end -BEGIN_PROVIDER [complex*16, fock_operator_closed_shell_ref_bitmask_complex, (mo_num, mo_num) ] +BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_cplx, (mo_num, mo_num) ] implicit none integer :: i0,j0,i,j,k0,k integer :: n_occ_ab(2) @@ -196,9 +196,9 @@ BEGIN_PROVIDER [complex*16, fock_operator_closed_shell_ref_bitmask_complex, (mo_ k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu + mo_one_e_integrals_complex(i,j) - !fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) - fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(fock_operator_closed_shell_ref_bitmask_complex(i,j)) + fock_op_cshell_ref_bitmask_cplx(i,j) = accu + mo_one_e_integrals_complex(i,j) + !fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(fock_op_cshell_ref_bitmask_cplx(i,j)) enddo enddo @@ -214,8 +214,8 @@ BEGIN_PROVIDER [complex*16, fock_operator_closed_shell_ref_bitmask_complex, (mo_ k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu+ mo_one_e_integrals_complex(i,j) - fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) enddo enddo @@ -231,8 +231,8 @@ BEGIN_PROVIDER [complex*16, fock_operator_closed_shell_ref_bitmask_complex, (mo_ k = occ(k0,1) accu += 2.d0 * array_coulomb(k) - array_exchange(k) enddo - fock_operator_closed_shell_ref_bitmask_complex(i,j) = accu+ mo_one_e_integrals_complex(i,j) - fock_operator_closed_shell_ref_bitmask_complex(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) enddo enddo deallocate(array_coulomb,array_exchange) @@ -268,7 +268,7 @@ subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hi enddo call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij = fock_operator_closed_shell_ref_bitmask_complex(h,p) + hij = fock_op_cshell_ref_bitmask_cplx(h,p) ! holes :: direct terms do i0 = 1, n_occ_ab_hole(1) i = occ_hole(i0,1) diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 50ae3952..d8ff9cde 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -101,7 +101,7 @@ BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num, mo_num) ] ! $C^{-1}.C_{mo}$ END_DOC call dgemm('N','N',ao_num,mo_num,ao_num,1.d0, & - ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1),& + ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1),& mo_coef, size(mo_coef,1), 0.d0, & mo_coef_in_ao_ortho_basis, size(mo_coef_in_ao_ortho_basis,1)) @@ -295,13 +295,13 @@ subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA) call dgemm('T','N', ao_num, ao_num, ao_num, & 1.d0, & - ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1),& + ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1),& A_ao,size(A_ao,1), & 0.d0, T, size(T,1)) call dgemm('N','N', ao_num, ao_num, ao_num, 1.d0, & T, size(T,1), & - ao_ortho_canonical_coef_inv,size(ao_ortho_canonical_coef_inv,1),& + ao_ortho_cano_coef_inv,size(ao_ortho_cano_coef_inv,1),& 0.d0, A, size(A,1)) deallocate(T) diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_complex.irp.f index e8c543ec..a4f3f9ed 100644 --- a/src/mo_basis/mos_complex.irp.f +++ b/src/mo_basis/mos_complex.irp.f @@ -66,7 +66,7 @@ BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ! $C^{-1}.C_{mo}$ END_DOC call zgemm('N','N',ao_num,mo_num,ao_num,(1.d0,0.d0), & - ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1),& + ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1),& mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & mo_coef_in_ao_ortho_basis_complex, size(mo_coef_in_ao_ortho_basis_complex,1)) @@ -170,7 +170,7 @@ subroutine ao_to_mo_noconjg_complex(A_ao,LDA_ao,A_mo,LDA_mo) end -subroutine ao_ortho_cano_to_ao_complex(A_ao,LDA_ao,A,LDA) +subroutine ao_ortho_cano_to_ao_cplx(A_ao,LDA_ao,A,LDA) implicit none BEGIN_DOC ! Transform A from the |AO| basis to the orthogonal |AO| basis @@ -186,13 +186,13 @@ subroutine ao_ortho_cano_to_ao_complex(A_ao,LDA_ao,A,LDA) call zgemm('C','N', ao_num, ao_num, ao_num, & (1.d0,0.d0), & - ao_ortho_canonical_coef_inv_complex, size(ao_ortho_canonical_coef_inv_complex,1),& + ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1),& A_ao,size(A_ao,1), & (0.d0,0.d0), T, size(T,1)) call zgemm('N','N', ao_num, ao_num, ao_num, (1.d0,0.d0), & T, size(T,1), & - ao_ortho_canonical_coef_inv_complex,size(ao_ortho_canonical_coef_inv_complex,1),& + ao_ortho_cano_coef_inv_cplx,size(ao_ortho_cano_coef_inv_cplx,1),& (0.d0,0.d0), A, size(A,1)) deallocate(T) diff --git a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f index 7ec94296..3196c1ad 100644 --- a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f @@ -23,7 +23,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_nucl_elec_integrals, (mo_num,m !$OMP END PARALLEL DO END_PROVIDER -BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_n_e_ints_cplx, (mo_num,mo_num)] implicit none integer :: i1,j1,i,j complex*16 :: c_i1,c_j1 @@ -32,15 +32,15 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num !$OMP PARALLEL DO DEFAULT(none) & !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & !$OMP SHARED(mo_num,ao_num,ao_ortho_lowdin_coef_complex, & - !$OMP ao_ortho_lowdin_nucl_elec_integrals_complex, ao_integrals_n_e_complex) + !$OMP ao_ortho_lowdin_n_e_ints_cplx, ao_integrals_n_e_complex) do i = 1, mo_num do j = 1, mo_num do i1 = 1,ao_num c_i1 = ao_ortho_lowdin_coef_complex(i1,i) do j1 = 1,ao_num c_j1 = c_i1*dconjg(ao_ortho_lowdin_coef_complex(j1,j)) - ao_ortho_lowdin_nucl_elec_integrals_complex(j,i) = & - ao_ortho_lowdin_nucl_elec_integrals_complex(j,i) + & + ao_ortho_lowdin_n_e_ints_cplx(j,i) = & + ao_ortho_lowdin_n_e_ints_cplx(j,i) + & c_j1 * ao_integrals_n_e_complex(j1,i1) enddo enddo diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 6d0c5a0a..06fe21ed 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -322,7 +322,7 @@ src/ao_one_e_ints/ao_ortho_canonical_complex.irp.f depends on ao_cart_to_sphe_coef_complex ao_cart_to_sphe_overlap_complex similar to real version, but uses ao_overlap_complex instead of ao_overlap - ao_ortho_canonical_coef_inv_complex + ao_ortho_cano_coef_inv_cplx self-explanatory ao_ortho_canonical_coef_complex ao_ortho_canonical_num_complex @@ -413,7 +413,7 @@ src/mo_basis/mos_complex.irp.f might cause confusion having both of these? maybe should add _noconjg to name of _transp so it's clear that it's just the transpose, and not the adjoint subroutine ao_to_mo_complex - subroutine ao_ortho_cano_to_ao_complex + subroutine ao_ortho_cano_to_ao_cplx src/mo_basis/utils.irp.f not modified: @@ -448,7 +448,7 @@ src/mo_guess/mo_ortho_lowdin_complex.irp.f src/mo_guess/pot_mo_ortho_canonical_ints.irp.f [complex*16, ao_ortho_canonical_nucl_elec_integrals_complex, (mo_num,mo_num)] src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f - [complex*16, ao_ortho_lowdin_nucl_elec_integrals_complex, (mo_num,mo_num)] + [complex*16, ao_ortho_lowdin_n_e_ints_cplx, (mo_num,mo_num)] ####################### From 717b35cf38f183a08cbb95f85c1c9545b098dca3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Mar 2020 09:06:29 +0100 Subject: [PATCH 128/256] Renaming complex -> cplx --- REPLACE | 2 ++ .../{aos_complex.irp.f => aos_cplx.irp.f} | 0 ..._complex.irp.f => map_integrals_cplx.irp.f} | 0 ...complex.irp.f => density_matrix_cplx.irp.f} | 0 ...s_complex.irp.f => determinants_cplx.irp.f} | 0 ...si_cas_complex.irp.f => psi_cas_cplx.irp.f} | 0 .../{s2_complex.irp.f => s2_cplx.irp.f} | 0 ...complex.irp.f => fock_matrix_hf_cplx.irp.f} | 0 .../{mos_complex.irp.f => mos_cplx.irp.f} | 0 .../{utils_complex.irp.f => utils_cplx.irp.f} | 0 ...omplex.irp.f => mo_ortho_lowdin_cplx.irp.f} | 0 ...ints.irp.f => pot_mo_ortho_cano_ints.irp.f} | 18 +++++++++--------- ...to_mo_complex.irp.f => ao_to_mo_cplx.irp.f} | 0 ...ts_complex.irp.f => kin_mo_ints_cplx.irp.f} | 0 ..._complex.irp.f => mo_one_e_ints_cplx.irp.f} | 0 ...ts_complex.irp.f => pot_mo_ints_cplx.irp.f} | 0 ...lex.irp.f => pot_mo_pseudo_ints_cplx.irp.f} | 0 ...omplex.irp.f => four_idx_novvvv_cplx.irp.f} | 0 ..._complex.irp.f => map_integrals_cplx.irp.f} | 0 ...omplex.irp.f => mo_bi_integrals_cplx.irp.f} | 0 ...nserv_complex.irp.f => kconserv_cplx.irp.f} | 0 ...mplex.irp.f => diagonalize_fock_cplx.irp.f} | 0 .../{diis_complex.irp.f => diis_cplx.irp.f} | 0 ...ix_complex.irp.f => fock_matrix_cplx.irp.f} | 0 ...{huckel_complex.irp.f => huckel_cplx.irp.f} | 0 ...omplex.irp.f => print_debug_scf_cplx.irp.f} | 0 ...plex.irp.f => roothaan_hall_scf_cplx.irp.f} | 0 ....irp.f => scf_density_matrix_ao_cplx.irp.f} | 0 ..._1e_complex.irp.f => dump_ao_1e_cplx.irp.f} | 0 ..._2e_complex.irp.f => dump_ao_2e_cplx.irp.f} | 0 ..._2e_complex.irp.f => dump_mo_2e_cplx.irp.f} | 0 ...ex.irp.f => export_integrals_ao_cplx.irp.f} | 0 ...e_complex.irp.f => import_ao_2e_cplx.irp.f} | 0 ...ex.irp.f => import_integrals_ao_cplx.irp.f} | 0 ...complex.irp.f => import_mo_coef_cplx.irp.f} | 0 src/utils_complex/qp2-pbc-diff.txt | 2 +- 36 files changed, 12 insertions(+), 10 deletions(-) rename src/ao_basis/{aos_complex.irp.f => aos_cplx.irp.f} (100%) rename src/ao_two_e_ints/{map_integrals_complex.irp.f => map_integrals_cplx.irp.f} (100%) rename src/determinants/{density_matrix_complex.irp.f => density_matrix_cplx.irp.f} (100%) rename src/determinants/{determinants_complex.irp.f => determinants_cplx.irp.f} (100%) rename src/determinants/{psi_cas_complex.irp.f => psi_cas_cplx.irp.f} (100%) rename src/determinants/{s2_complex.irp.f => s2_cplx.irp.f} (100%) rename src/hartree_fock/{fock_matrix_hf_complex.irp.f => fock_matrix_hf_cplx.irp.f} (100%) rename src/mo_basis/{mos_complex.irp.f => mos_cplx.irp.f} (100%) rename src/mo_basis/{utils_complex.irp.f => utils_cplx.irp.f} (100%) rename src/mo_guess/{mo_ortho_lowdin_complex.irp.f => mo_ortho_lowdin_cplx.irp.f} (100%) rename src/mo_guess/{pot_mo_ortho_canonical_ints.irp.f => pot_mo_ortho_cano_ints.irp.f} (60%) rename src/mo_one_e_ints/{ao_to_mo_complex.irp.f => ao_to_mo_cplx.irp.f} (100%) rename src/mo_one_e_ints/{kin_mo_ints_complex.irp.f => kin_mo_ints_cplx.irp.f} (100%) rename src/mo_one_e_ints/{mo_one_e_ints_complex.irp.f => mo_one_e_ints_cplx.irp.f} (100%) rename src/mo_one_e_ints/{pot_mo_ints_complex.irp.f => pot_mo_ints_cplx.irp.f} (100%) rename src/mo_one_e_ints/{pot_mo_pseudo_ints_complex.irp.f => pot_mo_pseudo_ints_cplx.irp.f} (100%) rename src/mo_two_e_ints/{four_idx_novvvv_complex.irp.f => four_idx_novvvv_cplx.irp.f} (100%) rename src/mo_two_e_ints/{map_integrals_complex.irp.f => map_integrals_cplx.irp.f} (100%) rename src/mo_two_e_ints/{mo_bi_integrals_complex.irp.f => mo_bi_integrals_cplx.irp.f} (100%) rename src/nuclei/{kconserv_complex.irp.f => kconserv_cplx.irp.f} (100%) rename src/scf_utils/{diagonalize_fock_complex.irp.f => diagonalize_fock_cplx.irp.f} (100%) rename src/scf_utils/{diis_complex.irp.f => diis_cplx.irp.f} (100%) rename src/scf_utils/{fock_matrix_complex.irp.f => fock_matrix_cplx.irp.f} (100%) rename src/scf_utils/{huckel_complex.irp.f => huckel_cplx.irp.f} (100%) rename src/scf_utils/{print_debug_scf_complex.irp.f => print_debug_scf_cplx.irp.f} (100%) rename src/scf_utils/{roothaan_hall_scf_complex.irp.f => roothaan_hall_scf_cplx.irp.f} (100%) rename src/scf_utils/{scf_density_matrix_ao_complex.irp.f => scf_density_matrix_ao_cplx.irp.f} (100%) rename src/utils_complex/{dump_ao_1e_complex.irp.f => dump_ao_1e_cplx.irp.f} (100%) rename src/utils_complex/{dump_ao_2e_complex.irp.f => dump_ao_2e_cplx.irp.f} (100%) rename src/utils_complex/{dump_mo_2e_complex.irp.f => dump_mo_2e_cplx.irp.f} (100%) rename src/utils_complex/{export_integrals_ao_complex.irp.f => export_integrals_ao_cplx.irp.f} (100%) rename src/utils_complex/{import_ao_2e_complex.irp.f => import_ao_2e_cplx.irp.f} (100%) rename src/utils_complex/{import_integrals_ao_complex.irp.f => import_integrals_ao_cplx.irp.f} (100%) rename src/utils_complex/{import_mo_coef_complex.irp.f => import_mo_coef_cplx.irp.f} (100%) diff --git a/REPLACE b/REPLACE index f59c99b3..ba027024 100755 --- a/REPLACE +++ b/REPLACE @@ -245,3 +245,5 @@ qp_name fock_operator_closed_shell_ref_bitmask_complex -r fock_op_cshell_ref_bit qp_name ao_ortho_canonical_coef_inv -r ao_ortho_cano_coef_inv qp_name ao_ortho_cano_to_ao_complex -r ao_ortho_cano_to_ao_cplx qp_name ao_ortho_lowdin_nucl_elec_integrals_complex -r ao_ortho_lowdin_n_e_ints_cplx +qp_name ao_ortho_canonical_nucl_elec_integrals_complex -r ao_ortho_cano_n_e_ints_cplx +qp_name ao_ortho_canonical_nucl_elec_integrals -r ao_ortho_cano_n_e_ints diff --git a/src/ao_basis/aos_complex.irp.f b/src/ao_basis/aos_cplx.irp.f similarity index 100% rename from src/ao_basis/aos_complex.irp.f rename to src/ao_basis/aos_cplx.irp.f diff --git a/src/ao_two_e_ints/map_integrals_complex.irp.f b/src/ao_two_e_ints/map_integrals_cplx.irp.f similarity index 100% rename from src/ao_two_e_ints/map_integrals_complex.irp.f rename to src/ao_two_e_ints/map_integrals_cplx.irp.f diff --git a/src/determinants/density_matrix_complex.irp.f b/src/determinants/density_matrix_cplx.irp.f similarity index 100% rename from src/determinants/density_matrix_complex.irp.f rename to src/determinants/density_matrix_cplx.irp.f diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_cplx.irp.f similarity index 100% rename from src/determinants/determinants_complex.irp.f rename to src/determinants/determinants_cplx.irp.f diff --git a/src/determinants/psi_cas_complex.irp.f b/src/determinants/psi_cas_cplx.irp.f similarity index 100% rename from src/determinants/psi_cas_complex.irp.f rename to src/determinants/psi_cas_cplx.irp.f diff --git a/src/determinants/s2_complex.irp.f b/src/determinants/s2_cplx.irp.f similarity index 100% rename from src/determinants/s2_complex.irp.f rename to src/determinants/s2_cplx.irp.f diff --git a/src/hartree_fock/fock_matrix_hf_complex.irp.f b/src/hartree_fock/fock_matrix_hf_cplx.irp.f similarity index 100% rename from src/hartree_fock/fock_matrix_hf_complex.irp.f rename to src/hartree_fock/fock_matrix_hf_cplx.irp.f diff --git a/src/mo_basis/mos_complex.irp.f b/src/mo_basis/mos_cplx.irp.f similarity index 100% rename from src/mo_basis/mos_complex.irp.f rename to src/mo_basis/mos_cplx.irp.f diff --git a/src/mo_basis/utils_complex.irp.f b/src/mo_basis/utils_cplx.irp.f similarity index 100% rename from src/mo_basis/utils_complex.irp.f rename to src/mo_basis/utils_cplx.irp.f diff --git a/src/mo_guess/mo_ortho_lowdin_complex.irp.f b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f similarity index 100% rename from src/mo_guess/mo_ortho_lowdin_complex.irp.f rename to src/mo_guess/mo_ortho_lowdin_cplx.irp.f diff --git a/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f b/src/mo_guess/pot_mo_ortho_cano_ints.irp.f similarity index 60% rename from src/mo_guess/pot_mo_ortho_canonical_ints.irp.f rename to src/mo_guess/pot_mo_ortho_cano_ints.irp.f index 10363a00..afbf96ff 100644 --- a/src/mo_guess/pot_mo_ortho_canonical_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_cano_ints.irp.f @@ -1,20 +1,20 @@ -BEGIN_PROVIDER [double precision, ao_ortho_canonical_nucl_elec_integrals, (mo_num,mo_num)] +BEGIN_PROVIDER [double precision, ao_ortho_cano_n_e_ints, (mo_num,mo_num)] implicit none integer :: i1,j1,i,j double precision :: c_i1,c_j1 - ao_ortho_canonical_nucl_elec_integrals = 0.d0 + ao_ortho_cano_n_e_ints = 0.d0 !$OMP PARALLEL DO DEFAULT(none) & !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & !$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef, & - !$OMP ao_ortho_canonical_nucl_elec_integrals, ao_integrals_n_e) + !$OMP ao_ortho_cano_n_e_ints, ao_integrals_n_e) do i = 1, mo_num do j = 1, mo_num do i1 = 1,ao_num c_i1 = ao_ortho_canonical_coef(i1,i) do j1 = 1,ao_num c_j1 = c_i1*ao_ortho_canonical_coef(j1,j) - ao_ortho_canonical_nucl_elec_integrals(j,i) = ao_ortho_canonical_nucl_elec_integrals(j,i) + & + ao_ortho_cano_n_e_ints(j,i) = ao_ortho_cano_n_e_ints(j,i) + & c_j1 * ao_integrals_n_e(j1,i1) enddo enddo @@ -23,24 +23,24 @@ BEGIN_PROVIDER [double precision, ao_ortho_canonical_nucl_elec_integrals, (mo_nu !$OMP END PARALLEL DO END_PROVIDER -BEGIN_PROVIDER [complex*16, ao_ortho_canonical_nucl_elec_integrals_complex, (mo_num,mo_num)] +BEGIN_PROVIDER [complex*16, ao_ortho_cano_n_e_ints_cplx, (mo_num,mo_num)] implicit none integer :: i1,j1,i,j complex*16 :: c_i1,c_j1 - ao_ortho_canonical_nucl_elec_integrals_complex = (0.d0,0.d0) + ao_ortho_cano_n_e_ints_cplx = (0.d0,0.d0) !$OMP PARALLEL DO DEFAULT(none) & !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & !$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef_complex, & - !$OMP ao_ortho_canonical_nucl_elec_integrals_complex, ao_integrals_n_e_complex) + !$OMP ao_ortho_cano_n_e_ints_cplx, ao_integrals_n_e_complex) do i = 1, mo_num do j = 1, mo_num do i1 = 1,ao_num c_i1 = ao_ortho_canonical_coef_complex(i1,i) do j1 = 1,ao_num c_j1 = c_i1*dconjg(ao_ortho_canonical_coef_complex(j1,j)) - ao_ortho_canonical_nucl_elec_integrals_complex(j,i) = & - ao_ortho_canonical_nucl_elec_integrals_complex(j,i) + & + ao_ortho_cano_n_e_ints_cplx(j,i) = & + ao_ortho_cano_n_e_ints_cplx(j,i) + & c_j1 * ao_integrals_n_e_complex(j1,i1) enddo enddo diff --git a/src/mo_one_e_ints/ao_to_mo_complex.irp.f b/src/mo_one_e_ints/ao_to_mo_cplx.irp.f similarity index 100% rename from src/mo_one_e_ints/ao_to_mo_complex.irp.f rename to src/mo_one_e_ints/ao_to_mo_cplx.irp.f diff --git a/src/mo_one_e_ints/kin_mo_ints_complex.irp.f b/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f similarity index 100% rename from src/mo_one_e_ints/kin_mo_ints_complex.irp.f rename to src/mo_one_e_ints/kin_mo_ints_cplx.irp.f diff --git a/src/mo_one_e_ints/mo_one_e_ints_complex.irp.f b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f similarity index 100% rename from src/mo_one_e_ints/mo_one_e_ints_complex.irp.f rename to src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f diff --git a/src/mo_one_e_ints/pot_mo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f similarity index 100% rename from src/mo_one_e_ints/pot_mo_ints_complex.irp.f rename to src/mo_one_e_ints/pot_mo_ints_cplx.irp.f diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f similarity index 100% rename from src/mo_one_e_ints/pot_mo_pseudo_ints_complex.irp.f rename to src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f diff --git a/src/mo_two_e_ints/four_idx_novvvv_complex.irp.f b/src/mo_two_e_ints/four_idx_novvvv_cplx.irp.f similarity index 100% rename from src/mo_two_e_ints/four_idx_novvvv_complex.irp.f rename to src/mo_two_e_ints/four_idx_novvvv_cplx.irp.f diff --git a/src/mo_two_e_ints/map_integrals_complex.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f similarity index 100% rename from src/mo_two_e_ints/map_integrals_complex.irp.f rename to src/mo_two_e_ints/map_integrals_cplx.irp.f diff --git a/src/mo_two_e_ints/mo_bi_integrals_complex.irp.f b/src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f similarity index 100% rename from src/mo_two_e_ints/mo_bi_integrals_complex.irp.f rename to src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f diff --git a/src/nuclei/kconserv_complex.irp.f b/src/nuclei/kconserv_cplx.irp.f similarity index 100% rename from src/nuclei/kconserv_complex.irp.f rename to src/nuclei/kconserv_cplx.irp.f diff --git a/src/scf_utils/diagonalize_fock_complex.irp.f b/src/scf_utils/diagonalize_fock_cplx.irp.f similarity index 100% rename from src/scf_utils/diagonalize_fock_complex.irp.f rename to src/scf_utils/diagonalize_fock_cplx.irp.f diff --git a/src/scf_utils/diis_complex.irp.f b/src/scf_utils/diis_cplx.irp.f similarity index 100% rename from src/scf_utils/diis_complex.irp.f rename to src/scf_utils/diis_cplx.irp.f diff --git a/src/scf_utils/fock_matrix_complex.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f similarity index 100% rename from src/scf_utils/fock_matrix_complex.irp.f rename to src/scf_utils/fock_matrix_cplx.irp.f diff --git a/src/scf_utils/huckel_complex.irp.f b/src/scf_utils/huckel_cplx.irp.f similarity index 100% rename from src/scf_utils/huckel_complex.irp.f rename to src/scf_utils/huckel_cplx.irp.f diff --git a/src/scf_utils/print_debug_scf_complex.irp.f b/src/scf_utils/print_debug_scf_cplx.irp.f similarity index 100% rename from src/scf_utils/print_debug_scf_complex.irp.f rename to src/scf_utils/print_debug_scf_cplx.irp.f diff --git a/src/scf_utils/roothaan_hall_scf_complex.irp.f b/src/scf_utils/roothaan_hall_scf_cplx.irp.f similarity index 100% rename from src/scf_utils/roothaan_hall_scf_complex.irp.f rename to src/scf_utils/roothaan_hall_scf_cplx.irp.f diff --git a/src/scf_utils/scf_density_matrix_ao_complex.irp.f b/src/scf_utils/scf_density_matrix_ao_cplx.irp.f similarity index 100% rename from src/scf_utils/scf_density_matrix_ao_complex.irp.f rename to src/scf_utils/scf_density_matrix_ao_cplx.irp.f diff --git a/src/utils_complex/dump_ao_1e_complex.irp.f b/src/utils_complex/dump_ao_1e_cplx.irp.f similarity index 100% rename from src/utils_complex/dump_ao_1e_complex.irp.f rename to src/utils_complex/dump_ao_1e_cplx.irp.f diff --git a/src/utils_complex/dump_ao_2e_complex.irp.f b/src/utils_complex/dump_ao_2e_cplx.irp.f similarity index 100% rename from src/utils_complex/dump_ao_2e_complex.irp.f rename to src/utils_complex/dump_ao_2e_cplx.irp.f diff --git a/src/utils_complex/dump_mo_2e_complex.irp.f b/src/utils_complex/dump_mo_2e_cplx.irp.f similarity index 100% rename from src/utils_complex/dump_mo_2e_complex.irp.f rename to src/utils_complex/dump_mo_2e_cplx.irp.f diff --git a/src/utils_complex/export_integrals_ao_complex.irp.f b/src/utils_complex/export_integrals_ao_cplx.irp.f similarity index 100% rename from src/utils_complex/export_integrals_ao_complex.irp.f rename to src/utils_complex/export_integrals_ao_cplx.irp.f diff --git a/src/utils_complex/import_ao_2e_complex.irp.f b/src/utils_complex/import_ao_2e_cplx.irp.f similarity index 100% rename from src/utils_complex/import_ao_2e_complex.irp.f rename to src/utils_complex/import_ao_2e_cplx.irp.f diff --git a/src/utils_complex/import_integrals_ao_complex.irp.f b/src/utils_complex/import_integrals_ao_cplx.irp.f similarity index 100% rename from src/utils_complex/import_integrals_ao_complex.irp.f rename to src/utils_complex/import_integrals_ao_cplx.irp.f diff --git a/src/utils_complex/import_mo_coef_complex.irp.f b/src/utils_complex/import_mo_coef_cplx.irp.f similarity index 100% rename from src/utils_complex/import_mo_coef_complex.irp.f rename to src/utils_complex/import_mo_coef_cplx.irp.f diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 06fe21ed..ac0769fa 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -446,7 +446,7 @@ src/mo_guess/mo_ortho_lowdin_complex.irp.f [complex*16, ao_ortho_lowdin_overlap_complex, (ao_num,ao_num)] src/mo_guess/pot_mo_ortho_canonical_ints.irp.f - [complex*16, ao_ortho_canonical_nucl_elec_integrals_complex, (mo_num,mo_num)] + [complex*16, ao_ortho_cano_n_e_ints_cplx, (mo_num,mo_num)] src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f [complex*16, ao_ortho_lowdin_n_e_ints_cplx, (mo_num,mo_num)] From df4c9431d086c27f219d34ad4a542bfb8b0d6c01 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Mar 2020 15:53:45 +0100 Subject: [PATCH 129/256] Fixed compilation problems --- src/generators_cas/generators.irp.f | 36 ++++ src/hartree_fock/fock_matrix_hf_cplx.irp.f | 213 --------------------- src/scf_utils/fock_matrix_cplx.irp.f | 213 +++++++++++++++++++++ src/single_ref_method/generators.irp.f | 22 +++ 4 files changed, 271 insertions(+), 213 deletions(-) delete mode 100644 src/hartree_fock/fock_matrix_hf_cplx.irp.f diff --git a/src/generators_cas/generators.irp.f b/src/generators_cas/generators.irp.f index b2f58202..cc87a0af 100644 --- a/src/generators_cas/generators.irp.f +++ b/src/generators_cas/generators.irp.f @@ -82,3 +82,39 @@ BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ] select_max = huge(1.d0) END_PROVIDER + + BEGIN_PROVIDER [ complex*16, psi_coef_generators_complex, (psi_det_size,N_states) ] +&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_gen_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! For Single reference wave functions, the generator is the + ! Hartree-Fock determinant + END_DOC + integer :: i, k, l, m + logical :: good + integer, external :: number_of_holes,number_of_particles + integer, allocatable :: nongen(:) + integer :: inongen + + allocate(nongen(N_det)) + + inongen = 0 + m=0 + do i=1,N_det + good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 ) + if (good) then + m = m+1 + psi_coef_generators_complex(m,:) = psi_coef_sorted_complex(i,:) + else + inongen += 1 + nongen(inongen) = i + endif + enddo + ASSERT (m == N_det_generators) + + psi_coef_sorted_gen_complex(:N_det_generators, :) = psi_coef_generators_complex(:N_det_generators, :) + do i=1,inongen + psi_coef_sorted_gen_complex(N_det_generators+i, :) = psi_coef_sorted_complex(nongen(i),:) + end do +END_PROVIDER + diff --git a/src/hartree_fock/fock_matrix_hf_cplx.irp.f b/src/hartree_fock/fock_matrix_hf_cplx.irp.f deleted file mode 100644 index 3dea06fe..00000000 --- a/src/hartree_fock/fock_matrix_hf_cplx.irp.f +++ /dev/null @@ -1,213 +0,0 @@ - - BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_complex, (ao_num, ao_num) ] -&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_complex , (ao_num, ao_num) ] - use map_module - implicit none - BEGIN_DOC - ! Alpha and Beta Fock matrices in AO basis set - END_DOC - !TODO: finish implementing this: see complex qp1 (different mapping) - - integer :: i,j,k,l,k1,r,s - integer :: i0,j0,k0,l0 - integer*8 :: p,q - complex*16 :: integral, c0 - complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:) - complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:) - - ao_two_e_integral_alpha_complex = (0.d0,0.d0) - ao_two_e_integral_beta_complex = (0.d0,0.d0) - PROVIDE ao_two_e_integrals_in_map - - integer(omp_lock_kind) :: lck(ao_num) - integer(map_size_kind) :: i8 - integer :: ii(4), jj(4), kk(4), ll(4), k2 - integer(cache_map_size_kind) :: n_elements_max, n_elements - integer(key_kind), allocatable :: keys(:) - double precision, allocatable :: values(:) - complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) - integer(key_kind) :: key1 - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & - !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & - !$OMP c0,key1)& - !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex, & - !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) - - call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) - allocate(keys(n_elements_max), values(n_elements_max)) - allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & - ao_two_e_integral_beta_tmp(ao_num,ao_num)) - ao_two_e_integral_alpha_tmp = (0.d0,0.d0) - ao_two_e_integral_beta_tmp = (0.d0,0.d0) - - !$OMP DO SCHEDULE(static,1) - do i8=0_8,ao_integrals_map%map_size - n_elements = n_elements_max - call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) - do k1=1,n_elements - ! get original key - ! reverse of 2*key (imag part) and 2*key-1 (real part) - key1 = shiftr(keys(k1)+1,1) - - call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) - ! i<=k, j<=l, ik<=jl - ! ijkl, jilk, klij*, lkji* - - if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) - do k2=1,4 - if (ii(k2)==0) then - cycle - endif - i = ii(k2) - j = jj(k2) - k = kk(k2) - l = ll(k2) - integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate - - !G_a(i,k) += D_{ab}(l,j)*() - !G_b(i,k) += D_{ab}(l,j)*() - !G_a(i,l) -= D_a (k,j)*() - !G_b(i,l) -= D_b (k,j)*() - - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral - - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral - enddo - else ! real part - do k2=1,4 - if (ii(k2)==0) then - cycle - endif - i = ii(k2) - j = jj(k2) - k = kk(k2) - l = ll(k2) - integral = values(k1) - - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral - - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral - enddo - endif - enddo - enddo - !$OMP END DO NOWAIT - !$OMP CRITICAL - ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp - ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp - !$OMP END CRITICAL - deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) - !$OMP END PARALLEL - - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & - !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & - !$OMP c0,key1)& - !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex, & - !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) - - call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) - allocate(keys(n_elements_max), values(n_elements_max)) - allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & - ao_two_e_integral_beta_tmp(ao_num,ao_num)) - ao_two_e_integral_alpha_tmp = (0.d0,0.d0) - ao_two_e_integral_beta_tmp = (0.d0,0.d0) - - !$OMP DO SCHEDULE(static,1) - do i8=0_8,ao_integrals_map_2%map_size - n_elements = n_elements_max - call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) - do k1=1,n_elements - ! get original key - ! reverse of 2*key (imag part) and 2*key-1 (real part) - key1 = shiftr(keys(k1)+1,1) - - call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) - ! i>=k, j<=l, ik<=jl - ! ijkl, jilk, klij*, lkji* - if (shiftl(key1,1)==keys(k1)) then !imaginary part - do k2=1,4 - if (ii(k2)==0) then - cycle - endif - i = ii(k2) - j = jj(k2) - k = kk(k2) - l = ll(k2) - integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate - - !G_a(i,k) += D_{ab}(l,j)*() - !G_b(i,k) += D_{ab}(l,j)*() - !G_a(i,l) -= D_a (k,j)*() - !G_b(i,l) -= D_b (k,j)*() - - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral - - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral - enddo - else ! real part - do k2=1,4 - if (ii(k2)==0) then - cycle - endif - i = ii(k2) - j = jj(k2) - k = kk(k2) - l = ll(k2) - integral = values(k1) - - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral - - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral - enddo - endif - enddo - enddo - !$OMP END DO NOWAIT - !$OMP CRITICAL - ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp - ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp - !$OMP END CRITICAL - deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) - !$OMP END PARALLEL - - -END_PROVIDER - - BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_complex, (ao_num, ao_num) ] -&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_complex, (ao_num, ao_num) ] - implicit none - BEGIN_DOC - ! Alpha Fock matrix in AO basis set - END_DOC - - integer :: i,j - do j=1,ao_num - do i=1,ao_num - Fock_matrix_ao_alpha_complex(i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_alpha_complex(i,j) - Fock_matrix_ao_beta_complex (i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_beta_complex (i,j) - enddo - enddo - -END_PROVIDER diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index 290f9b9d..577fe5c2 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -146,3 +146,216 @@ BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] endif END_PROVIDER + + BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_complex , (ao_num, ao_num) ] + use map_module + implicit none + BEGIN_DOC + ! Alpha and Beta Fock matrices in AO basis set + END_DOC + !TODO: finish implementing this: see complex qp1 (different mapping) + + integer :: i,j,k,l,k1,r,s + integer :: i0,j0,k0,l0 + integer*8 :: p,q + complex*16 :: integral, c0 + complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:) + complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:) + + ao_two_e_integral_alpha_complex = (0.d0,0.d0) + ao_two_e_integral_beta_complex = (0.d0,0.d0) + PROVIDE ao_two_e_integrals_in_map + + integer(omp_lock_kind) :: lck(ao_num) + integer(map_size_kind) :: i8 + integer :: ii(4), jj(4), kk(4), ll(4), k2 + integer(cache_map_size_kind) :: n_elements_max, n_elements + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) + integer(key_kind) :: key1 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex, & + !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + + call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) + ! i<=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + + if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex, & + !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + + call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map_2%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) + ! i>=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + if (shiftl(key1,1)==keys(k1)) then !imaginary part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Alpha Fock matrix in AO basis set + END_DOC + + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_alpha_complex(i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_alpha_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_beta_complex (i,j) + enddo + enddo + +END_PROVIDER diff --git a/src/single_ref_method/generators.irp.f b/src/single_ref_method/generators.irp.f index ce71f996..860f357a 100644 --- a/src/single_ref_method/generators.irp.f +++ b/src/single_ref_method/generators.irp.f @@ -25,6 +25,7 @@ END_PROVIDER psi_det_generators(i,2,1) = HF_bitmask(i,2) enddo + ! Search for HF determinant do j=1,N_det call get_excitation_degree(HF_bitmask,psi_det(1,1,j),degree,N_int) if (degree == 0) then @@ -55,4 +56,25 @@ BEGIN_PROVIDER [ integer, size_select_max ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, psi_coef_generators_complex, (psi_det_size,N_states) ] + implicit none + BEGIN_DOC + ! Complex variant of psi_coef_generators + END_DOC + + integer :: i,j,k + integer :: degree + + ! Search for HF determinant + do j=1,N_det + call get_excitation_degree(HF_bitmask,psi_det(1,1,j),degree,N_int) + if (degree == 0) then + k = j + exit + endif + end do + + psi_coef_generators_complex(1,:) = psi_coef_generators_complex(j,:) + +END_PROVIDER From bc04139a543371b18bfa3421ff602cd492753867 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Mar 2020 16:19:20 +0100 Subject: [PATCH 130/256] Started working on OCaml. Need to go further for qp_edit --- ocaml/Input_determinants_by_hand.ml | 100 ++++++++++++++++++---------- ocaml/Input_mo_basis.ml | 14 ++-- 2 files changed, 71 insertions(+), 43 deletions(-) diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index dee338e3..3ed6429d 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -37,7 +37,9 @@ end = struct } [@@deriving sexp] ;; - let get_default = Qpackage.get_ezfio_default "determinants";; + let get_default = Qpackage.get_ezfio_default "determinants" + + let is_complex = lazy (Ezfio.get_nuclei_is_complex () ) let read_n_int () = if not (Ezfio.has_determinants_n_int()) then @@ -48,12 +50,12 @@ end = struct ; Ezfio.get_determinants_n_int () |> N_int_number.of_int - ;; + let write_n_int n = N_int_number.to_int n |> Ezfio.set_determinants_n_int - ;; + let read_bit_kind () = @@ -64,12 +66,12 @@ end = struct ; Ezfio.get_determinants_bit_kind () |> Bit_kind.of_int - ;; + let write_bit_kind b = Bit_kind.to_int b |> Ezfio.set_determinants_bit_kind - ;; + let read_n_det () = if not (Ezfio.has_determinants_n_det ()) then @@ -77,7 +79,7 @@ end = struct ; Ezfio.get_determinants_n_det () |> Det_number.of_int - ;; + let read_n_det_qp_edit () = if not (Ezfio.has_determinants_n_det_qp_edit ()) then @@ -87,18 +89,18 @@ end = struct end; Ezfio.get_determinants_n_det_qp_edit () |> Det_number.of_int - ;; + let write_n_det n = Det_number.to_int n |> Ezfio.set_determinants_n_det - ;; + let write_n_det_qp_edit n = let n_det = read_n_det () |> Det_number.to_int in min n_det (Det_number.to_int n) |> Ezfio.set_determinants_n_det_qp_edit - ;; + let read_n_states () = if not (Ezfio.has_determinants_n_states ()) then @@ -106,7 +108,7 @@ end = struct ; Ezfio.get_determinants_n_states () |> States_number.of_int - ;; + let write_n_states n = let n_states = @@ -130,7 +132,7 @@ end = struct Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data |> Ezfio.set_determinants_state_average_weight end - ;; + let write_state_average_weight data = let n_states = @@ -143,7 +145,7 @@ end = struct in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data |> Ezfio.set_determinants_state_average_weight - ;; + let read_state_average_weight () = let n_states = @@ -171,7 +173,7 @@ end = struct |> Array.map Positive_float.of_float in (write_state_average_weight data; data) - ;; + let read_expected_s2 () = if not (Ezfio.has_determinants_expected_s2 ()) then @@ -186,12 +188,12 @@ end = struct ; Ezfio.get_determinants_expected_s2 () |> Positive_float.of_float - ;; + let write_expected_s2 s2 = Positive_float.to_float s2 |> Ezfio.set_determinants_expected_s2 - ;; + let read_psi_coef ~read_only () = if not (Ezfio.has_determinants_psi_coef ()) then @@ -200,19 +202,36 @@ end = struct read_n_states () |> States_number.to_int in - Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |] - ~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. )) + ( + if Lazy.force is_complex then + Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |] + ~data:(List.init (2*n_states) (fun i -> if (i=0) then 1. else 0. )) |> Ezfio.set_determinants_psi_coef + else + Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; 1 ; n_states |] + ~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. )) + |> Ezfio.set_determinants_psi_coef_complex + ) end; begin if read_only then - Ezfio.get_determinants_psi_coef_qp_edit () + begin + if Lazy.force is_complex then + Ezfio.get_determinants_psi_coef_complex_qp_edit () + else + Ezfio.get_determinants_psi_coef_qp_edit () + end else - Ezfio.get_determinants_psi_coef () + begin + if Lazy.force is_complex then + Ezfio.get_determinants_psi_coef_complex () + else + Ezfio.get_determinants_psi_coef () + end end |> Ezfio.flattened_ezfio |> Array.map Det_coef.of_float - ;; + let write_psi_coef ~n_det ~n_states c = let n_det = Det_number.to_int n_det @@ -222,12 +241,23 @@ end = struct and n_states = States_number.to_int n_states in - let r = - Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c - in - Ezfio.set_determinants_psi_coef r; - Ezfio.set_determinants_psi_coef_qp_edit r - ;; + if Lazy.force is_complex then + begin + let r = + Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; n_det ; n_states |] ~data:c + in + Ezfio.set_determinants_psi_coef_complex r; + Ezfio.set_determinants_psi_coef_complex_qp_edit r + end + else + begin + let r = + Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c + in + Ezfio.set_determinants_psi_coef r; + Ezfio.set_determinants_psi_coef_qp_edit r + end + let read_psi_det ~read_only () = @@ -276,7 +306,7 @@ end = struct |> Array.map (Determinant.of_int64_array ~n_int:(N_int_number.of_int n_int) ~alpha:n_alpha ~beta:n_beta ) - ;; + let write_psi_det ~n_int ~n_det d = let data = Array.to_list d @@ -288,7 +318,7 @@ end = struct in Ezfio.set_determinants_psi_det r; Ezfio.set_determinants_psi_det_qp_edit r - ;; + let read ?(full=true) () = @@ -316,7 +346,7 @@ end = struct else (* No molecular orbitals, so no determinants *) None - ;; + let write ?(force=false) { n_int ; @@ -341,7 +371,7 @@ end = struct write_psi_det ~n_int:n_int ~n_det:n_det psi_det end; write_state_average_weight state_average_weight - ;; + let to_rst b = @@ -557,10 +587,8 @@ psi_det = %s in - - Generic_input_of_rst.evaluate_sexp t_of_sexp s - ;; + let update_ndet n_det_new = Printf.printf "Reducing n_det to %d\n" (Det_number.to_int n_det_new); @@ -596,7 +624,7 @@ psi_det = %s { det with n_det = (Det_number.of_int n_det_new) } in write ~force:true new_det - ;; + let extract_state istate = Printf.printf "Extracting state %d\n" (States_number.to_int istate); @@ -628,7 +656,7 @@ psi_det = %s { det with n_states = (States_number.of_int 1) } in write ~force:true new_det - ;; + let extract_states range = Printf.printf "Extracting states %s\n" (Range.to_string range); @@ -673,7 +701,7 @@ psi_det = %s { det with n_states = (States_number.of_int @@ List.length sorted_list) } in write ~force:true new_det - ;; + end diff --git a/ocaml/Input_mo_basis.ml b/ocaml/Input_mo_basis.ml index 46f8240e..e39aeb14 100644 --- a/ocaml/Input_mo_basis.ml +++ b/ocaml/Input_mo_basis.ml @@ -43,7 +43,7 @@ end = struct mo_coef = Array.map (fun mo -> Array.init (Array.length mo) (fun i -> mo.(ordering.(i))) - ) b.mo_coef + ) b.mo_coef } let read_ao_md5 () = @@ -73,7 +73,7 @@ end = struct let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num () in - let result = + let result = Ezfio.get_mo_basis_mo_num () in if result < elec_alpha_num then @@ -116,7 +116,7 @@ end = struct let read_mo_coef () = - let a = + let a = ( if Lazy.force is_complex then Ezfio.get_mo_basis_mo_coef_complex () @@ -129,7 +129,7 @@ end = struct let mo_num = read_mo_num () |> MO_number.to_int in let ao_num = (Array.length a)/mo_num in Array.init mo_num (fun j -> - Array.sub a (j*ao_num) (ao_num) + Array.sub a (j*ao_num) (ao_num) ) @@ -247,7 +247,7 @@ mo_coef = %s (b.mo_occ |> Array.to_list |> List.map (MO_occ.to_string) |> String.concat ", " ) (b.mo_coef |> Array.map - (fun x-> Array.map MO_coef.to_string x |> + (fun x-> Array.map MO_coef.to_string x |> Array.to_list |> String.concat "," ) |> Array.to_list |> String.concat "\n" ) @@ -285,7 +285,7 @@ mo_coef = %s let write_mo_coef a = let mo_num = Array.length a in - let ao_num = + let ao_num = let x = Array.length a.(0) in if Lazy.force is_complex then x/2 else x in @@ -303,7 +303,7 @@ mo_coef = %s |> Ezfio.set_mo_basis_mo_coef ) - let write + let write { mo_num : MO_number.t ; mo_label : MO_label.t; mo_class : MO_class.t array; From 046c71feca1c829eeb287826721e0324bcdb8895 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 5 Mar 2020 14:26:15 -0600 Subject: [PATCH 131/256] complex davidson --- .../diagonalization_hs2_dressed.irp.f | 1176 +++++++++-------- 1 file changed, 604 insertions(+), 572 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 2c4888cc..e938d50c 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -801,282 +801,310 @@ end subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag_in,Nint,dressing_state,converged) print*,irp_here,' not implemented for complex' stop -1 -! use bitmasks -! use mmap_module -! implicit none -! BEGIN_DOC -! ! Davidson diagonalization with specific diagonal elements of the H matrix -! ! -! ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson -! ! -! ! S2_out : Output : s^2 -! ! -! ! dets_in : bitmasks corresponding to determinants -! ! -! ! u_in : guess coefficients on the various states. Overwritten -! ! on exit -! ! -! ! dim_in : leftmost dimension of u_in -! ! -! ! sze : Number of determinants -! ! -! ! N_st : Number of eigenstates -! ! -! ! N_st_diag_in : Number of states in which H is diagonalized. Assumed > sze -! ! -! ! Initial guess vectors are not necessarily orthonormal -! END_DOC -! integer, intent(in) :: dim_in, sze, N_st, N_st_diag_in, Nint -! integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) -! double precision, intent(in) :: H_jj(sze) -! integer, intent(in) :: dressing_state -! double precision, intent(inout) :: s2_out(N_st_diag_in) -! complex*16, intent(inout) :: u_in(dim_in,N_st_diag_in) -! double precision, intent(out) :: energies(N_st_diag_in) -! -! integer :: iter, N_st_diag -! integer :: i,j,k,l,m -! logical, intent(inout) :: converged -! -! double precision, external :: u_dot_u_complex -! complex*16, external :: u_dot_v_complex -! -! integer :: k_pairs, kl -! -! integer :: iter2, itertot -! double precision, allocatable :: y(:,:), h(:,:), h_p(:,:), lambda(:), s2(:) -! real, allocatable :: y_s(:,:) -! double precision, allocatable :: s_(:,:), s_tmp(:,:) -! double precision :: diag_h_mat_elem -! double precision, allocatable :: residual_norm(:) -! character*(16384) :: write_buffer -! double precision :: to_print(3,N_st) -! double precision :: cpu, wall -! integer :: shift, shift2, itermax, istate -! double precision :: r1, r2, alpha -! logical :: state_ok(N_st_diag_in*davidson_sze_max) -! integer :: nproc_target -! integer :: order(N_st_diag_in) -! double precision :: cmax -! double precision, allocatable :: U(:,:), overlap(:,:), S_d(:,:) -! double precision, pointer :: W(:,:) -! real, pointer :: S(:,:) -! logical :: disk_based -! double precision :: energy_shift(N_st_diag_in*davidson_sze_max) -! -! include 'constants.include.F' -! -! N_st_diag = N_st_diag_in -! !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, y_s, S_d, h, lambda -! if (N_st_diag*3 > sze) then -! print *, 'error in Davidson :' -! print *, 'Increase n_det_max_full to ', N_st_diag*3 -! stop -1 -! endif -! -! itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1 -! itertot = 0 -! -! if (state_following) then -! allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) -! else -! allocate(overlap(1,1)) ! avoid 'if' for deallocate -! endif -! overlap = 0.d0 -! -! PROVIDE nuclear_repulsion expected_s2 psi_bilinear_matrix_order psi_bilinear_matrix_order_reverse threshold_davidson_pt2 -! -! call write_time(6) -! write(6,'(A)') '' -! write(6,'(A)') 'Davidson Diagonalization' -! write(6,'(A)') '------------------------' -! write(6,'(A)') '' -! -! ! Find max number of cores to fit in memory -! ! ----------------------------------------- -! -! nproc_target = nproc -! double precision :: rss -! integer :: maxab -! maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 -! -! m=1 -! disk_based = .False. -! call resident_memory(rss) -! do -! r1 = 8.d0 * &! bytes -! ( dble(sze)*(N_st_diag*itermax) &! U -! + 1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S -! + 1.d0*dble(sze)*(N_st_diag) &! S_d -! + 4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp -! + 2.d0*(N_st_diag*itermax) &! s2,lambda -! + 1.d0*(N_st_diag) &! residual_norm -! ! In H_S2_u_0_nstates_zmq -! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector -! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave -! + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_* -! + nproc_target * &! In OMP section -! ( 1.d0*(N_int*maxab) &! buffer -! + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx -! ) / 1024.d0**3 -! -! if (nproc_target == 0) then -! call check_mem(r1,irp_here) -! nproc_target = 1 -! exit -! endif -! -! if (r1+rss < qp_max_mem) then -! exit -! endif -! -! if (itermax > 4) then -! itermax = itermax - 1 -! else if (m==1.and.disk_based_davidson) then -! m=0 -! disk_based = .True. -! itermax = 6 -! else -! nproc_target = nproc_target - 1 -! endif -! -! enddo -! nthreads_davidson = nproc_target -! TOUCH nthreads_davidson -! call write_int(6,N_st,'Number of states') -! call write_int(6,N_st_diag,'Number of states in diagonalization') -! call write_int(6,sze,'Number of determinants') -! call write_int(6,nproc_target,'Number of threads for diagonalization') -! call write_double(6, r1, 'Memory(Gb)') -! if (disk_based) then -! print *, 'Using swap space to reduce RAM' -! endif -! -! !--------------- -! -! write(6,'(A)') '' -! write_buffer = '=====' -! do i=1,N_st -! write_buffer = trim(write_buffer)//' ================ =========== ===========' -! enddo -! write(6,'(A)') write_buffer(1:6+41*N_st) -! write_buffer = 'Iter' -! do i=1,N_st -! write_buffer = trim(write_buffer)//' Energy S^2 Residual ' -! enddo -! write(6,'(A)') write_buffer(1:6+41*N_st) -! write_buffer = '=====' -! do i=1,N_st -! write_buffer = trim(write_buffer)//' ================ =========== ===========' -! enddo -! write(6,'(A)') write_buffer(1:6+41*N_st) -! -! -! if (disk_based) then -! ! Create memory-mapped files for W and S -! type(c_ptr) :: ptr_w, ptr_s -! integer :: fd_s, fd_w -! call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),& -! 8, fd_w, .False., ptr_w) -! call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),& -! 4, fd_s, .False., ptr_s) -! call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) -! call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) -! else -! allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) -! endif -! -! allocate( & -! ! Large -! U(sze,N_st_diag*itermax), & -! S_d(sze,N_st_diag), & -! -! ! Small -! h(N_st_diag*itermax,N_st_diag*itermax), & -! h_p(N_st_diag*itermax,N_st_diag*itermax), & -! y(N_st_diag*itermax,N_st_diag*itermax), & -! s_(N_st_diag*itermax,N_st_diag*itermax), & -! s_tmp(N_st_diag*itermax,N_st_diag*itermax), & -! residual_norm(N_st_diag), & -! s2(N_st_diag*itermax), & -! y_s(N_st_diag*itermax,N_st_diag*itermax), & -! lambda(N_st_diag*itermax)) -! -! h = 0.d0 -! U = 0.d0 -! y = 0.d0 -! s_ = 0.d0 -! s_tmp = 0.d0 -! -! -! ASSERT (N_st > 0) -! ASSERT (N_st_diag >= N_st) -! ASSERT (sze > 0) -! ASSERT (Nint > 0) -! ASSERT (Nint == N_int) -! -! ! Davidson iterations -! ! =================== -! -! converged = .False. -! -! do k=N_st+1,N_st_diag -! u_in(k,k) = 10.d0 -! do i=1,sze -! call random_number(r1) -! call random_number(r2) -! r1 = dsqrt(-2.d0*dlog(r1)) -! r2 = dtwo_pi*r2 -! !u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) -! u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) -! enddo -! enddo -! do k=1,N_st_diag -! call normalize_complex(u_in(1,k),sze) -! enddo -! -! do k=1,N_st_diag -! do i=1,sze -! U(i,k) = u_in(i,k) -! enddo -! enddo -! -! -! do while (.not.converged) -! itertot = itertot+1 -! if (itertot == 8) then -! exit -! endif -! -! do iter=1,itermax-1 -! -! shift = N_st_diag*(iter-1) -! shift2 = N_st_diag*iter -! -! if ((iter > 1).or.(itertot == 1)) then -! ! Compute |W_k> = \sum_i |i> -! ! ----------------------------------- -! -! if (disk_based) then -! call ortho_qr_unblocked(U,size(U,1),sze,shift2) -! call ortho_qr_unblocked(U,size(U,1),sze,shift2) -! else -! call ortho_qr(U,size(U,1),sze,shift2) -! call ortho_qr(U,size(U,1),sze,shift2) -! endif -! -! if ((sze > 100000).and.distributed_davidson) then -! call H_S2_u_0_nstates_zmq (W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) -! else -! call H_S2_u_0_nstates_openmp(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) -! endif -! S(1:sze,shift+1:shift+N_st_diag) = real(S_d(1:sze,1:N_st_diag)) -! else -! ! Already computed in update below -! continue -! endif -! -! if (dressing_state > 0) then + use bitmasks + use mmap_module + implicit none + BEGIN_DOC + ! Davidson diagonalization with specific diagonal elements of the H matrix + ! + ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson + ! + ! S2_out : Output : s^2 + ! + ! dets_in : bitmasks corresponding to determinants + ! + ! u_in : guess coefficients on the various states. Overwritten + ! on exit + ! + ! dim_in : leftmost dimension of u_in + ! + ! sze : Number of determinants + ! + ! N_st : Number of eigenstates + ! + ! N_st_diag_in : Number of states in which H is diagonalized. Assumed > sze + ! + ! Initial guess vectors are not necessarily orthonormal + END_DOC + integer, intent(in) :: dim_in, sze, N_st, N_st_diag_in, Nint + integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) + double precision, intent(in) :: H_jj(sze) + integer, intent(in) :: dressing_state + double precision, intent(inout) :: s2_out(N_st_diag_in) + complex*16, intent(inout) :: u_in(dim_in,N_st_diag_in) + double precision, intent(out) :: energies(N_st_diag_in) + + integer :: iter, N_st_diag + integer :: i,j,k,l,m + logical, intent(inout) :: converged + + double precision, external :: u_dot_u_complex + complex*16, external :: u_dot_v_complex + + integer :: k_pairs, kl + + integer :: iter2, itertot + double precision, allocatable :: lambda(:), s2(:) + complex*16, allocatable :: y(:,:), h(:,:), h_p(:,:) + complex*8, allocatable :: y_s(:,:) + complex*16, allocatable :: s_(:,:), s_tmp(:,:) + double precision :: diag_h_mat_elem + double precision, allocatable :: residual_norm(:) + character*(16384) :: write_buffer + double precision :: to_print(3,N_st) + double precision :: cpu, wall + integer :: shift, shift2, itermax, istate + double precision :: r1, r2, alpha + logical :: state_ok(N_st_diag_in*davidson_sze_max) + integer :: nproc_target + integer :: order(N_st_diag_in) + double precision :: cmax + double precision, allocatable :: overlap(:,:) + complex*16, allocatable :: y_tmp(:,:) + complex*16, allocatable :: S_d(:,:) + complex*16, allocatable :: U(:,:) + complex*16, pointer :: W(:,:) + complex*8, pointer :: S(:,:) + logical :: disk_based + double precision :: energy_shift(N_st_diag_in*davidson_sze_max) + + include 'constants.include.F' + + N_st_diag = N_st_diag_in + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, y_s, S_d, h, lambda + if (N_st_diag*3 > sze) then + print *, 'error in Davidson :' + print *, 'Increase n_det_max_full to ', N_st_diag*3 + stop -1 + endif + + itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1 + itertot = 0 + + if (state_following) then + allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), & + y_tmp(N_st_diag*itermax, N_st_diag*itermax)) + else + allocate(overlap(1,1),y_tmp(1,1)) ! avoid 'if' for deallocate + endif + overlap = 0.d0 + y_tmp = (0.d0,0.d0) + + !todo: provide psi_bilinear_matrix_values? (unlinked now) + PROVIDE nuclear_repulsion expected_s2 psi_bilinear_matrix_order psi_bilinear_matrix_order_reverse threshold_davidson_pt2 + + call write_time(6) + write(6,'(A)') '' + write(6,'(A)') 'Davidson Diagonalization' + write(6,'(A)') '------------------------' + write(6,'(A)') '' + + ! Find max number of cores to fit in memory + ! ----------------------------------------- + + nproc_target = nproc + double precision :: rss + integer :: maxab + maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + + m=1 + disk_based = .False. + call resident_memory(rss) + do + !r1 = 8.d0 * &! bytes + ! ( dble(sze)*(N_st_diag*itermax) &! U + ! + 1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S + ! + 1.d0*dble(sze)*(N_st_diag) &! S_d + ! + 4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp + ! + 2.d0*(N_st_diag*itermax) &! s2,lambda + ! + 1.d0*(N_st_diag) &! residual_norm + ! ! In H_S2_u_0_nstates_zmq + ! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector + ! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave + ! + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_* + ! + nproc_target * &! In OMP section + ! ( 1.d0*(N_int*maxab) &! buffer + ! + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx + ! ) / 1024.d0**3 + r1 = 8.d0 * &! bytes + ( 2*dble(sze)*(N_st_diag*itermax) &! U + + 2*1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S + + 2*1.d0*dble(sze)*(N_st_diag) &! S_d + + 2*4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp + + 2.d0*(N_st_diag*itermax) &! s2,lambda + + 1.d0*(N_st_diag) &! residual_norm + ! In H_S2_u_0_nstates_zmq + + 2*3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector + + 2*3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave + + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_* + + nproc_target * &! In OMP section + ( 1.d0*(N_int*maxab) &! buffer + + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(r1,irp_here) + nproc_target = 1 + exit + endif + + if (r1+rss < qp_max_mem) then + exit + endif + + if (itermax > 4) then + itermax = itermax - 1 + else if (m==1.and.disk_based_davidson) then + m=0 + disk_based = .True. + itermax = 6 + else + nproc_target = nproc_target - 1 + endif + + enddo + nthreads_davidson = nproc_target + TOUCH nthreads_davidson + call write_int(6,N_st,'Number of states') + call write_int(6,N_st_diag,'Number of states in diagonalization') + call write_int(6,sze,'Number of determinants') + call write_int(6,nproc_target,'Number of threads for diagonalization') + call write_double(6, r1, 'Memory(Gb)') + if (disk_based) then + print *, 'Using swap space to reduce RAM' + endif + + !--------------- + + write(6,'(A)') '' + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ =========== ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = 'Iter' + do i=1,N_st + write_buffer = trim(write_buffer)//' Energy S^2 Residual ' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ =========== ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + + !todo: already resized, but do we need to change c_f_pointer for complex? + if (disk_based) then + ! Create memory-mapped files for W and S + type(c_ptr) :: ptr_w, ptr_s + integer :: fd_s, fd_w + call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),& + 8*2, fd_w, .False., ptr_w) + call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),& + 4*2, fd_s, .False., ptr_s) + call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) + call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) + else + allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) + endif + + allocate( & + ! Large + U(sze,N_st_diag*itermax), & + S_d(sze,N_st_diag), & + + ! Small + h(N_st_diag*itermax,N_st_diag*itermax), & + h_p(N_st_diag*itermax,N_st_diag*itermax), & + y(N_st_diag*itermax,N_st_diag*itermax), & + s_(N_st_diag*itermax,N_st_diag*itermax), & + s_tmp(N_st_diag*itermax,N_st_diag*itermax), & + residual_norm(N_st_diag), & + s2(N_st_diag*itermax), & + y_s(N_st_diag*itermax,N_st_diag*itermax), & + lambda(N_st_diag*itermax)) + + !todo: complex types + h = (0.d0,0.d0) + U = (0.d0,0.d0) + y = (0.d0,0.d0) + s_ = (0.d0,0.d0) + s_tmp = (0.d0,0.d0) + + + ASSERT (N_st > 0) + ASSERT (N_st_diag >= N_st) + ASSERT (sze > 0) + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + + ! Davidson iterations + ! =================== + + converged = .False. + + do k=N_st+1,N_st_diag + u_in(k,k) = (10.d0,0.d0) + do i=1,sze + call random_number(r1) + call random_number(r2) + r1 = dsqrt(-2.d0*dlog(r1)) + r2 = dtwo_pi*r2 + !todo: real or complex? rescale for complex? sqrt(2)? + u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) + !u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) + enddo + enddo + do k=1,N_st_diag + call normalize_complex(u_in(1,k),sze) + enddo + + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + + do while (.not.converged) + itertot = itertot+1 + if (itertot == 8) then + exit + endif + + do iter=1,itermax-1 + + shift = N_st_diag*(iter-1) + shift2 = N_st_diag*iter + + if ((iter > 1).or.(itertot == 1)) then + ! Compute |W_k> = \sum_i |i> + ! ----------------------------------- + + if (disk_based) then + call ortho_qr_unblocked_complex(U,size(U,1),sze,shift2) + call ortho_qr_unblocked_complex(U,size(U,1),sze,shift2) + else + call ortho_qr_complex(U,size(U,1),sze,shift2) + call ortho_qr_complex(U,size(U,1),sze,shift2) + endif + + ! |W> = H|U> + ! |S_d> = S^2|U> + if ((sze > 100000).and.distributed_davidson) then + call h_s2_u_0_nstates_zmq_complex(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) + else + call h_s2_u_0_nstates_openmp_complex(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) + endif + S(1:sze,shift+1:shift+N_st_diag) = cmplx(S_d(1:sze,1:N_st_diag),kind(1.e0)) + else + ! Already computed in update below + continue + endif + + if (dressing_state > 0) then + print*,irp_here,' not implemented for complex (dressed)' + stop -1 ! ! if (N_st == 1) then ! @@ -1125,302 +1153,306 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i ! 1.d0, S_d, size(S_d,1)) ! ! endif -! endif -! -! ! Compute s_kl = = -! ! ------------------------------------------- -! -! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k) COLLAPSE(2) -! do j=1,shift2 -! do i=1,shift2 -! s_(i,j) = 0.d0 -! do k=1,sze -! s_(i,j) = s_(i,j) + U(k,i) * dble(S(k,j)) -! enddo -! enddo -! enddo -! !$OMP END PARALLEL DO -! -! ! Compute h_kl = = -! ! ------------------------------------------- -! -! call dgemm('T','N', shift2, shift2, sze, & -! 1.d0, U, size(U,1), W, size(W,1), & -! 0.d0, h, size(h_p,1)) -! -! ! Penalty method -! ! -------------- -! -! if (s2_eig) then -! h_p = s_ -! do k=1,shift2 -! h_p(k,k) = h_p(k,k) + S_z2_Sz - expected_s2 -! enddo -! if (only_expected_s2) then -! alpha = 0.1d0 -! h_p = h + alpha*h_p -! else -! alpha = 0.0001d0 -! h_p = h + alpha*h_p -! endif -! else -! h_p = h -! alpha = 0.d0 -! endif -! -! ! Diagonalize h_p -! ! --------------- -! -! call lapack_diag(lambda,y,h_p,size(h_p,1),shift2) -! -! ! Compute Energy for each eigenvector -! ! ----------------------------------- -! -! call dgemm('N','N',shift2,shift2,shift2, & -! 1.d0, h, size(h,1), y, size(y,1), & -! 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('T','N',shift2,shift2,shift2, & -! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & -! 0.d0, h, size(h,1)) -! -! do k=1,shift2 -! lambda(k) = h(k,k) -! enddo -! -! ! Compute S2 for each eigenvector -! ! ------------------------------- -! -! call dgemm('N','N',shift2,shift2,shift2, & -! 1.d0, s_, size(s_,1), y, size(y,1), & -! 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('T','N',shift2,shift2,shift2, & -! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & -! 0.d0, s_, size(s_,1)) -! -! do k=1,shift2 -! s2(k) = s_(k,k) + S_z2_Sz -! enddo -! -! if (only_expected_s2) then -! do k=1,shift2 -! state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) -! enddo -! else -! do k=1,size(state_ok) -! state_ok(k) = .True. -! enddo -! endif -! -! do k=1,shift2 -! if (.not. state_ok(k)) then -! do l=k+1,shift2 -! if (state_ok(l)) then -! call dswap(shift2, y(1,k), 1, y(1,l), 1) -! call dswap(1, s2(k), 1, s2(l), 1) -! call dswap(1, lambda(k), 1, lambda(l), 1) -! state_ok(k) = .True. -! state_ok(l) = .False. -! exit -! endif -! enddo -! endif -! enddo -! -! if (state_following) then -! -! overlap = -1.d0 -! do k=1,shift2 -! do i=1,shift2 -! overlap(k,i) = dabs(y(k,i)) -! enddo -! enddo -! do k=1,N_st -! cmax = -1.d0 -! do i=1,N_st -! if (overlap(i,k) > cmax) then -! cmax = overlap(i,k) -! order(k) = i -! endif -! enddo -! do i=1,N_st_diag -! overlap(order(k),i) = -1.d0 -! enddo -! enddo -! overlap = y -! do k=1,N_st -! l = order(k) -! if (k /= l) then -! y(1:shift2,k) = overlap(1:shift2,l) -! endif -! enddo -! do k=1,N_st -! overlap(k,1) = lambda(k) -! overlap(k,2) = s2(k) -! enddo -! do k=1,N_st -! l = order(k) -! if (k /= l) then -! lambda(k) = overlap(l,1) -! s2(k) = overlap(l,2) -! endif -! enddo -! -! endif -! -! -! ! Express eigenvectors of h in the determinant basis -! ! -------------------------------------------------- -! -! call dgemm('N','N', sze, N_st_diag, shift2, & -! 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) -! call dgemm('N','N', sze, N_st_diag, shift2, & -! 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) -! -! y_s(:,:) = real(y(:,:)) -! call sgemm('N','N', sze, N_st_diag, shift2, & -! 1., S, size(S,1), y_s, size(y_s,1), 0., S(1,shift2+1), size(S,1)) -! -! ! Compute residual vector and davidson step -! ! ----------------------------------------- -! -! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) -! do k=1,N_st_diag -! do i=1,sze -! U(i,shift2+k) = & -! (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & -! /max(H_jj(i) - lambda (k),1.d-2) -! enddo -! -! if (k <= N_st) then -! residual_norm(k) = u_dot_u_complex(U(1,shift2+k),sze) -! to_print(1,k) = lambda(k) + nuclear_repulsion -! to_print(2,k) = s2(k) -! to_print(3,k) = residual_norm(k) -! endif -! enddo -! !$OMP END PARALLEL DO -! -! -! if ((itertot>1).and.(iter == 1)) then -! !don't print -! continue -! else -! write(*,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter-1, to_print(1:3,1:N_st) -! endif -! -! ! Check convergence -! if (iter > 1) then -! converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson_pt2 -! endif -! -! -! do k=1,N_st -! if (residual_norm(k) > 1.e8) then -! print *, 'Davidson failed' -! stop -1 -! endif -! enddo -! if (converged) then -! exit -! endif -! -! logical, external :: qp_stop -! if (qp_stop()) then -! converged = .True. -! exit -! endif -! -! -! enddo -! -! ! Re-contract U and update S and W -! ! -------------------------------- -! -! call sgemm('N','N', sze, N_st_diag, shift2, 1., & -! S, size(S,1), y_s, size(y_s,1), 0., S(1,shift2+1), size(S,1)) -! do k=1,N_st_diag -! do i=1,sze -! S(i,k) = S(i,shift2+k) -! enddo -! enddo -! -! call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & -! W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) -! do k=1,N_st_diag -! do i=1,sze -! W(i,k) = u_in(i,k) -! enddo -! enddo -! -! call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & -! U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) -! do k=1,N_st_diag -! do i=1,sze -! U(i,k) = u_in(i,k) -! enddo -! enddo -! if (disk_based) then -! call ortho_qr_unblocked(U,size(U,1),sze,N_st_diag) -! call ortho_qr_unblocked(U,size(U,1),sze,N_st_diag) -! else -! call ortho_qr(U,size(U,1),sze,N_st_diag) -! call ortho_qr(U,size(U,1),sze,N_st_diag) -! endif -! do j=1,N_st_diag -! k=1 -! do while ((k = + ! ------------------------------------------- + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k) COLLAPSE(2) + do j=1,shift2 + do i=1,shift2 + s_(i,j) = (0.d0,0.d0) + do k=1,sze + s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j),kind(1.d0)) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + ! Compute h_kl = = + ! ------------------------------------------- + + !todo: why not size(h,1)? + call zgemm('C','N', shift2, shift2, sze, & + (1.d0,0.d0), U, size(U,1), W, size(W,1), & + (0.d0,0.d0), h, size(h_p,1)) + + ! Penalty method + ! -------------- + + if (s2_eig) then + h_p = s_ + do k=1,shift2 + h_p(k,k) = h_p(k,k) + (S_z2_Sz - expected_s2) + enddo + if (only_expected_s2) then + alpha = 0.1d0 + h_p = h + alpha*h_p + else + alpha = 0.0001d0 + h_p = h + alpha*h_p + endif + else + h_p = h + alpha = 0.d0 + endif + + ! Diagonalize h_p + ! --------------- + + call lapack_diag_complex(lambda,y,h_p,size(h_p,1),shift2) + + ! Compute Energy for each eigenvector + ! ----------------------------------- + + call zgemm('N','N',shift2,shift2,shift2, & + (1.d0,0.d0), h, size(h,1), y, size(y,1), & + (0.d0,0.d0), s_tmp, size(s_tmp,1)) + + call zgemm('C','N',shift2,shift2,shift2, & + (1.d0,0.d0), y, size(y,1), s_tmp, size(s_tmp,1), & + (0.d0,0.d0), h, size(h,1)) + + do k=1,shift2 + lambda(k) = dble(h(k,k)) + enddo + + ! Compute S2 for each eigenvector + ! ------------------------------- + + call zgemm('N','N',shift2,shift2,shift2, & + (1.d0,0.d0), s_, size(s_,1), y, size(y,1), & + (0.d0,0.d0), s_tmp, size(s_tmp,1)) + + call zgemm('C','N',shift2,shift2,shift2, & + (1.d0,0.d0), y, size(y,1), s_tmp, size(s_tmp,1), & + (0.d0,0.d0), s_, size(s_,1)) + + do k=1,shift2 + s2(k) = dble(s_(k,k)) + S_z2_Sz + enddo + + if (only_expected_s2) then + do k=1,shift2 + state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) + enddo + else + do k=1,size(state_ok) + state_ok(k) = .True. + enddo + endif + + do k=1,shift2 + if (.not. state_ok(k)) then + do l=k+1,shift2 + if (state_ok(l)) then + call zswap(shift2, y(1,k), 1, y(1,l), 1) + call dswap(1, s2(k), 1, s2(l), 1) + call dswap(1, lambda(k), 1, lambda(l), 1) + state_ok(k) = .True. + state_ok(l) = .False. + exit + endif + enddo + endif + enddo + + if (state_following) then + + overlap = -1.d0 + do k=1,shift2 + do i=1,shift2 + overlap(k,i) = cdabs(y(k,i)) + enddo + enddo + do k=1,N_st + cmax = -1.d0 + do i=1,N_st + if (overlap(i,k) > cmax) then + cmax = overlap(i,k) + order(k) = i + endif + enddo + do i=1,N_st_diag + overlap(order(k),i) = -1.d0 + enddo + enddo + y_tmp = y + do k=1,N_st + l = order(k) + if (k /= l) then + y(1:shift2,k) = y_tmp(1:shift2,l) + endif + enddo + do k=1,N_st + overlap(k,1) = lambda(k) + overlap(k,2) = s2(k) + enddo + do k=1,N_st + l = order(k) + if (k /= l) then + lambda(k) = overlap(l,1) + s2(k) = overlap(l,2) + endif + enddo + + endif + + + ! Express eigenvectors of h in the determinant basis + ! -------------------------------------------------- + !todo: check for complex + call zgemm('N','N', sze, N_st_diag, shift2, & + (1.d0,0.d0), U, size(U,1), y, size(y,1), (0.d0,0.d0), U(1,shift2+1), size(U,1)) + call zgemm('N','N', sze, N_st_diag, shift2, & + (1.d0,0.d0), W, size(W,1), y, size(y,1), (0.d0,0.d0), W(1,shift2+1), size(W,1)) + + y_s(:,:) = cmplx(y(:,:),kind(1.e0)) + call cgemm('N','N', sze, N_st_diag, shift2, & + (1.e0,0.e0), S, size(S,1), y_s, size(y_s,1), (0.e0,0.e0), S(1,shift2+1), size(S,1)) + + ! Compute residual vector and davidson step + ! ----------------------------------------- + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) + do k=1,N_st_diag + do i=1,sze + U(i,shift2+k) = & + (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & + /max(H_jj(i) - lambda (k),1.d-2) + enddo + + if (k <= N_st) then + residual_norm(k) = u_dot_u_complex(U(1,shift2+k),sze) + to_print(1,k) = lambda(k) + nuclear_repulsion + to_print(2,k) = s2(k) + to_print(3,k) = residual_norm(k) + endif + enddo + !$OMP END PARALLEL DO + + + if ((itertot>1).and.(iter == 1)) then + !don't print + continue + else + write(*,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter-1, to_print(1:3,1:N_st) + endif + + ! Check convergence + if (iter > 1) then + converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson_pt2 + endif + + + do k=1,N_st + if (residual_norm(k) > 1.e8) then + print *, 'Davidson failed' + stop -1 + endif + enddo + if (converged) then + exit + endif + + logical, external :: qp_stop + if (qp_stop()) then + converged = .True. + exit + endif + + + enddo + + ! Re-contract U and update S and W + ! -------------------------------- + + call cgemm('N','N', sze, N_st_diag, shift2, (1.e0,0.e0), & + S, size(S,1), y_s, size(y_s,1), (0.e0,0.e0), S(1,shift2+1), size(S,1)) + do k=1,N_st_diag + do i=1,sze + S(i,k) = S(i,shift2+k) + enddo + enddo + + call zgemm('N','N', sze, N_st_diag, shift2, (1.d0,0.d0), & + W, size(W,1), y, size(y,1), (0.d0,0.d0), u_in, size(u_in,1)) + do k=1,N_st_diag + do i=1,sze + W(i,k) = u_in(i,k) + enddo + enddo + + call zgemm('N','N', sze, N_st_diag, shift2, (1.d0,0.d0), & + U, size(U,1), y, size(y,1), (0.d0,0.d0), u_in, size(u_in,1)) + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + if (disk_based) then + call ortho_qr_unblocked_complex(U,size(U,1),sze,N_st_diag) + call ortho_qr_unblocked_complex(U,size(U,1),sze,N_st_diag) + else + call ortho_qr_complex(U,size(U,1),sze,N_st_diag) + call ortho_qr_complex(U,size(U,1),sze,N_st_diag) + endif + do j=1,N_st_diag + k=1 + do while ((k Date: Thu, 5 Mar 2020 15:57:40 -0600 Subject: [PATCH 132/256] cleanup --- src/cipsi/pt2_stoch_routines.irp.f | 253 +----------------- src/cipsi/slave_cipsi.irp.f | 5 +- src/cipsi/zmq_selection.irp.f | 153 ----------- .../diagonalization_hs2_dressed.irp.f | 23 +- src/determinants/zmq.irp.f | 1 - src/mo_basis/utils_cplx.irp.f | 6 +- src/mo_guess/h_core_guess_routine.irp.f | 1 - 7 files changed, 22 insertions(+), 420 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 94ed962b..635353c5 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -265,7 +265,6 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) double precision :: mem_collector, mem, rss - !todo: check memory allocation for complex call resident_memory(rss) mem_collector = 8.d0 * & ! bytes @@ -296,6 +295,10 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist + 1.0d0*(N_states*mo_num*mo_num) & ! mat ) / 1024.d0**3 + if (is_complex) then + ! mat is complex + mem = mem + (nproc_target*8.d0*(N_states*mo_num* mo_num)) / 1024.d0**3 + endif if (nproc_target == 0) then call check_mem(mem,irp_here) @@ -843,251 +846,3 @@ END_PROVIDER END_PROVIDER - - -!==============================================================================! -! ! -! Complex ! -! ! -!==============================================================================! - - - - -!subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in) -! !todo: implement for complex -! print*,irp_here -! stop -1 -! use f77_zmq -! use selection_types -! -! implicit none -! -! integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull -! integer, intent(in) :: N_in -! double precision, intent(in) :: relative_error, E(N_states) -! double precision, intent(out) :: pt2(N_states),error(N_states) -! double precision, intent(out) :: variance(N_states),norm(N_states) -! -! -! integer :: i, N -! -! double precision :: state_average_weight_save(N_states), w(N_states,4) -! integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket -! type(selection_buffer) :: b -! -! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique -! PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order -! PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns -! PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted -! PROVIDE psi_det_hii selection_weight pseudo_sym -! -! if (h0_type == 'SOP') then -! PROVIDE psi_occ_pattern_hii det_to_occ_pattern -! endif -! -! if (N_det <= max(4,N_states)) then -! pt2=0.d0 -! variance=0.d0 -! norm=0.d0 -! call zmq_selection_complex(N_in, pt2, variance, norm) -! error(:) = 0.d0 -! else -! -! N = max(N_in,1) * N_states -! state_average_weight_save(:) = state_average_weight(:) -! if (int(N,8)*2_8 > huge(1)) then -! print *, irp_here, ': integer too large' -! stop -1 -! endif -! call create_selection_buffer(N, N*2, b) -! ASSERT (associated(b%det)) -! ASSERT (associated(b%val)) -! -! do pt2_stoch_istate=1,N_states -! state_average_weight(:) = 0.d0 -! state_average_weight(pt2_stoch_istate) = 1.d0 -! TOUCH state_average_weight pt2_stoch_istate selection_weight -! -! PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w -! PROVIDE psi_selectors pt2_u pt2_J pt2_R -! call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') -! -! integer, external :: zmq_put_psi -! integer, external :: zmq_put_N_det_generators -! integer, external :: zmq_put_N_det_selectors -! integer, external :: zmq_put_dvector -! integer, external :: zmq_put_ivector -! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then -! stop 'Unable to put psi on ZMQ server' -! endif -! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then -! stop 'Unable to put N_det_generators on ZMQ server' -! endif -! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then -! stop 'Unable to put N_det_selectors on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then -! stop 'Unable to put energy on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then -! stop 'Unable to put state_average_weight on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then -! stop 'Unable to put selection_weight on ZMQ server' -! endif -! if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then -! stop 'Unable to put pt2_stoch_istate on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then -! stop 'Unable to put threshold_generators on ZMQ server' -! endif -! -! -! integer, external :: add_task_to_taskserver -! character(300000) :: task -! -! integer :: j,k,ipos,ifirst -! ifirst=0 -! -! ipos=0 -! do i=1,N_det_generators -! if (pt2_F(i) > 1) then -! ipos += 1 -! endif -! enddo -! call write_int(6,sum(pt2_F),'Number of tasks') -! call write_int(6,ipos,'Number of fragmented tasks') -! -! ipos=1 -! do i= 1, N_det_generators -! do j=1,pt2_F(pt2_J(i)) -! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in -! ipos += 30 -! if (ipos > 300000-30) then -! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then -! stop 'Unable to add task to task server' -! endif -! ipos=1 -! if (ifirst == 0) then -! ifirst=1 -! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then -! print *, irp_here, ': Failed in zmq_set_running' -! endif -! endif -! endif -! end do -! enddo -! if (ipos > 1) then -! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then -! stop 'Unable to add task to task server' -! endif -! endif -! -! integer, external :: zmq_set_running -! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then -! print *, irp_here, ': Failed in zmq_set_running' -! endif -! -! -! double precision :: mem_collector, mem, rss -! -! call resident_memory(rss) -! -! mem_collector = 8.d0 * & ! bytes -! ( 1.d0*pt2_n_tasks_max & ! task_id, index -! + 0.635d0*N_det_generators & ! f,d -! + 3.d0*N_det_generators*N_states & ! eI, vI, nI -! + 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task -! + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 -! + 1.d0*(N_int*2.d0*N + N) & ! selection buffer -! + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer -! ) / 1024.d0**3 -! -! integer :: nproc_target, ii -! nproc_target = nthreads_pt2 -! ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) -! -! do -! mem = mem_collector + & ! -! nproc_target * 8.d0 * & ! bytes -! ( 0.5d0*pt2_n_tasks_max & ! task_id -! + 64.d0*pt2_n_tasks_max & ! task -! + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm -! + 1.d0*pt2_n_tasks_max & ! i_generator, subset -! + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer -! + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer -! + 2.0d0*(ii) & ! preinteresting, interesting, -! ! prefullinteresting, fullinteresting -! + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist -! + 1.0d0*(N_states*mo_num*mo_num) & ! mat -! ) / 1024.d0**3 -! -! if (nproc_target == 0) then -! call check_mem(mem,irp_here) -! nproc_target = 1 -! exit -! endif -! -! if (mem+rss < qp_max_mem) then -! exit -! endif -! -! nproc_target = nproc_target - 1 -! -! enddo -! call write_int(6,nproc_target,'Number of threads for PT2') -! call write_double(6,mem,'Memory (Gb)') -! -! call omp_set_nested(.false.) -! -! -! print '(A)', '========== ================= =========== =============== =============== =================' -! print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' -! print '(A)', '========== ================= =========== =============== =============== =================' -! -! PROVIDE global_selection_buffer -! !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & -! !$OMP PRIVATE(i) -! i = omp_get_thread_num() -! if (i==0) then -! -! call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w(1,1), w(1,2), w(1,3), w(1,4), b, N) -! pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1) -! error(pt2_stoch_istate) = w(pt2_stoch_istate,2) -! variance(pt2_stoch_istate) = w(pt2_stoch_istate,3) -! norm(pt2_stoch_istate) = w(pt2_stoch_istate,4) -! -! else -! call pt2_slave_inproc(i) -! endif -! !$OMP END PARALLEL -! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') -! -! print '(A)', '========== ================= =========== =============== =============== =================' -! -! enddo -! FREE pt2_stoch_istate -! -! if (N_in > 0) then -! b%cur = min(N_in,b%cur) -! if (s2_eig) then -! call make_selection_buffer_s2(b) -! else -! call remove_duplicates_in_selection_buffer(b) -! endif -! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) -! endif -! call delete_selection_buffer(b) -! -! state_average_weight(:) = state_average_weight_save(:) -! TOUCH state_average_weight -! endif -! do k=N_det+1,N_states -! pt2(k) = 0.d0 -! enddo -! -! call update_pt2_and_variance_weights(pt2, variance, norm, N_states) -! -!end subroutine - diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index 2d12359a..5e77e7f6 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -267,7 +267,6 @@ subroutine run_slave_main nproc_target = nthreads_pt2 ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) - !todo: change memory estimate for complex do mem = rss + & ! nproc_target * 8.d0 * & ! bytes @@ -282,6 +281,10 @@ subroutine run_slave_main + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist + 1.0d0*(N_states*mo_num*mo_num) & ! mat ) / 1024.d0**3 + if (is_complex) then + ! mat is complex + mem = mem + (nproc_target * 8.d0 * (n_states*mo_num*mo_num)) / 1024.d0**3 + endif if (nproc_target == 0) then call check_mem(mem,irp_here) diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index 059166fa..7f2fe313 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -233,156 +233,3 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) end subroutine -!==============================================================================! -! ! -! Complex ! -! ! -!==============================================================================! - -!subroutine ZMQ_selection_complex(N_in, pt2, variance, norm) -! !todo: implement -! print*,irp_here -! stop -1 -! use f77_zmq -! use selection_types -! -! implicit none -! -! integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull -! integer, intent(in) :: N_in -! type(selection_buffer) :: b -! integer :: i, N -! integer, external :: omp_get_thread_num -! double precision, intent(out) :: pt2(N_states) -! double precision, intent(out) :: variance(N_states) -! double precision, intent(out) :: norm(N_states) -! -!! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators -! -! N = max(N_in,1) -! if (.True.) then -! PROVIDE pt2_e0_denominator nproc -! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique -! PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order -! PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns -! PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym -! -! -! call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') -! -! integer, external :: zmq_put_psi -! integer, external :: zmq_put_N_det_generators -! integer, external :: zmq_put_N_det_selectors -! integer, external :: zmq_put_dvector -! -! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then -! stop 'Unable to put psi on ZMQ server' -! endif -! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then -! stop 'Unable to put N_det_generators on ZMQ server' -! endif -! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then -! stop 'Unable to put N_det_selectors on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then -! stop 'Unable to put energy on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then -! stop 'Unable to put state_average_weight on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then -! stop 'Unable to put selection_weight on ZMQ server' -! endif -! if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then -! stop 'Unable to put threshold_generators on ZMQ server' -! endif -! call create_selection_buffer(N, N*2, b) -! endif -! -! integer, external :: add_task_to_taskserver -! character(len=100000) :: task -! integer :: j,k,ipos -! ipos=1 -! task = ' ' -! -! do i= 1, N_det_generators -! do j=1,pt2_F(i) -! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N -! ipos += 30 -! if (ipos > 100000-30) then -! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then -! stop 'Unable to add task to task server' -! endif -! ipos=1 -! endif -! end do -! enddo -! if (ipos > 1) then -! if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then -! stop 'Unable to add task to task server' -! endif -! endif -! -! -! ASSERT (associated(b%det)) -! ASSERT (associated(b%val)) -! -! integer, external :: zmq_set_running -! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then -! print *, irp_here, ': Failed in zmq_set_running' -! endif -! -! integer :: nproc_target -! if (N_det < 3*nproc) then -! nproc_target = N_det/4 -! else -! nproc_target = nproc -! endif -! double precision :: mem -! mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3) -! call write_double(6,mem,'Estimated memory/thread (Gb)') -! if (qp_max_mem > 0) then -! nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem))) -! nproc_target = min(nproc_target,nproc) -! endif -! -! f(:) = 1.d0 -! if (.not.do_pt2) then -! double precision :: f(N_states), u_dot_u_complex -! do k=1,min(N_det,N_states) -! f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors) -! enddo -! endif -! -! !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) -! i = omp_get_thread_num() -! if (i==0) then -! call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) -! else -! call selection_slave_inproc(i) -! endif -! !$OMP END PARALLEL -! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection') -! do i=N_det+1,N_states -! pt2(i) = 0.d0 -! variance(i) = 0.d0 -! norm(i) = 0.d0 -! enddo -! if (N_in > 0) then -! if (s2_eig) then -! call make_selection_buffer_s2(b) -! endif -! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) -! call copy_H_apply_buffer_to_wf() -! call save_wavefunction -! endif -! call delete_selection_buffer(b) -! do k=1,N_states -! pt2(k) = pt2(k) * f(k) -! variance(k) = variance(k) * f(k) -! norm(k) = norm(k) * f(k) -! enddo -! -! call update_pt2_and_variance_weights(pt2, variance, norm, N_states) -! -!end subroutine diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index e938d50c..c469c907 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -735,8 +735,6 @@ end !==============================================================================! subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged) - print*,irp_here,' not implemented for complex' - stop -1 use bitmasks implicit none BEGIN_DOC @@ -784,6 +782,7 @@ subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_s !$OMP END PARALLEL if (dressing_state > 0) then + !todo: implement for complex print*,irp_here,' not implemented for complex if dressing_state > 0' stop -1 do k=1,N_st @@ -799,8 +798,6 @@ end subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag_in,Nint,dressing_state,converged) - print*,irp_here,' not implemented for complex' - stop -1 use bitmasks use mmap_module implicit none @@ -1024,7 +1021,6 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i y_s(N_st_diag*itermax,N_st_diag*itermax), & lambda(N_st_diag*itermax)) - !todo: complex types h = (0.d0,0.d0) U = (0.d0,0.d0) y = (0.d0,0.d0) @@ -1103,20 +1099,23 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i endif if (dressing_state > 0) then + !todo: implement for complex print*,irp_here,' not implemented for complex (dressed)' stop -1 ! ! if (N_st == 1) then ! ! l = dressed_column_idx(1) -! double precision :: f -! f = 1.0d0/psi_coef(l,1) +! complex*16 :: f +! !todo: check for complex +! f = (1.0d0,0.d0)/psi_coef(l,1) ! do istate=1,N_st_diag ! do i=1,sze -! W(i,shift+istate) += dressing_column_h(i,1) *f * U(l,shift+istate) -! W(l,shift+istate) += dressing_column_h(i,1) *f * U(i,shift+istate) -! S(i,shift+istate) += real(dressing_column_s(i,1) *f * U(l,shift+istate)) -! S(l,shift+istate) += real(dressing_column_s(i,1) *f * U(i,shift+istate)) +! !todo: conjugate? +! W(i,shift+istate) += dressing_column_h_complex(i,1) *f * U(l,shift+istate) +! W(l,shift+istate) += dressing_column_h_complex(i,1) *f * U(i,shift+istate) +! S(i,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(l,shift+istate)) +! S(l,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(i,shift+istate)) ! enddo ! ! enddo @@ -1404,6 +1403,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i enddo !if (U(k,j) * u_in(k,j) < 0.d0) then !todo: complex! maybe change criterion here? + ! if U is close to u_in, then arg(conjg(U)*u_in) will be near zero if (dble(dconjg(U(k,j)) * u_in(k,j)) < 0.d0) then do i=1,sze W(i,j) = -W(i,j) @@ -1432,7 +1432,6 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i call write_time(6) if (disk_based)then - !todo: already resized, but do we need to change c_f_pointer for complex? ! Remove temp files integer, external :: getUnitAndOpen call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 2*8, fd_w, ptr_w ) diff --git a/src/determinants/zmq.irp.f b/src/determinants/zmq.irp.f index ee8165da..4d66f27a 100644 --- a/src/determinants/zmq.irp.f +++ b/src/determinants/zmq.irp.f @@ -84,7 +84,6 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id) endif if (is_complex) then - !todo: check this if (size(psi_coef_complex,kind=8) /= psi_det_size*N_states) then deallocate(psi_coef_complex) allocate(psi_coef_complex(psi_det_size,N_states)) diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index 7f79f042..a967cec4 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -1,5 +1,5 @@ subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output) - !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + !TODO: test this implicit none integer,intent(in) :: n,m, sign character*(64), intent(in) :: label @@ -67,7 +67,7 @@ subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output) end subroutine mo_as_svd_vectors_of_mo_matrix_complex(matrix,lda,m,n,label) - !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + !TODO: test this implicit none integer,intent(in) :: lda,m,n character*(64), intent(in) :: label @@ -122,7 +122,7 @@ end subroutine mo_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,eig,label) - !TODO: test this; should we assign values to mo_coef and mo_coef_imag here? + !TODO: test this implicit none integer,intent(in) :: lda,m,n character*(64), intent(in) :: label diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index b3de1940..1a6fd2c5 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -10,7 +10,6 @@ subroutine hcore_guess size(mo_one_e_integrals_complex,1), & size(mo_one_e_integrals_complex,2),label,1,.false.) call save_mos - !TODO: is this correct? decide how to handle separate real/imag parts of mo_coef SOFT_TOUCH mo_coef_complex mo_label else From 8bfac5669a1b858383d2189f70510a30275977dd Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 6 Mar 2020 08:46:10 -0600 Subject: [PATCH 133/256] fixed complex kind --- src/davidson/diagonalization_hs2_dressed.irp.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index c469c907..d16445cc 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1092,7 +1092,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i else call h_s2_u_0_nstates_openmp_complex(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) endif - S(1:sze,shift+1:shift+N_st_diag) = cmplx(S_d(1:sze,1:N_st_diag),kind(1.e0)) + S(1:sze,shift+1:shift+N_st_diag) = cmplx(S_d(1:sze,1:N_st_diag)) else ! Already computed in update below continue @@ -1162,7 +1162,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i do i=1,shift2 s_(i,j) = (0.d0,0.d0) do k=1,sze - s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j),kind(1.d0)) + s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j)) enddo enddo enddo @@ -1306,7 +1306,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i call zgemm('N','N', sze, N_st_diag, shift2, & (1.d0,0.d0), W, size(W,1), y, size(y,1), (0.d0,0.d0), W(1,shift2+1), size(W,1)) - y_s(:,:) = cmplx(y(:,:),kind(1.e0)) + y_s(:,:) = cmplx(y(:,:)) call cgemm('N','N', sze, N_st_diag, shift2, & (1.e0,0.e0), S, size(S,1), y_s, size(y_s,1), (0.e0,0.e0), S(1,shift2+1), size(S,1)) @@ -1413,7 +1413,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i enddo do j=1,N_st_diag do i=1,sze - S_d(i,j) = cmplx(S(i,j),kind(1.d0)) + S_d(i,j) = cmplx(S(i,j)) enddo enddo From 7145a7d916782dc192f7c2d504684cfa035df446 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 6 Mar 2020 09:00:30 -0600 Subject: [PATCH 134/256] fixed wrong types --- src/davidson/diagonalize_ci.irp.f | 9 +++++---- src/determinants/slater_rules.irp.f | 2 +- src/mo_two_e_ints/map_integrals_cplx.irp.f | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 13152fdd..740640c3 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -312,8 +312,8 @@ END_PROVIDER do j=1,N_det H_prime(j,j) = H_prime(j,j) + alpha*(s_z2_sz - expected_s2) enddo - call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) - ci_electronic_energy_complex(:) = 0.d0 + call lapack_diag_complex(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) + ci_electronic_energy_complex(:) = (0.d0,0.d0) i_state = 0 allocate (s2_eigvalues(N_det)) allocate(index_good_state_array(N_det),good_state_array(N_det)) @@ -399,9 +399,10 @@ END_PROVIDER ci_electronic_energy_complex(k) = 0.d0 do j=1,N_det do i=1,N_det + !todo: accumulate imag parts to test? (should sum to zero) ci_electronic_energy_complex(k) += & - ci_eigenvectors_complex(i,k) * ci_eigenvectors_complex(j,k) * & - H_matrix_all_dets_complex(i,j) + dble(dconjg(ci_eigenvectors_complex(i,k)) * ci_eigenvectors_complex(j,k) * & + H_matrix_all_dets_complex(i,j)) enddo enddo enddo diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index be82516a..29bd8b23 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2522,7 +2522,7 @@ subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase) double precision :: diag_H_mat_elem integer :: n_occ_ab(2) logical :: has_mipi(Nint*bit_kind_size) - double precision :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size) + complex*16 :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size) PROVIDE mo_two_e_integrals_in_map mo_integrals_map ASSERT (Nint > 0) diff --git a/src/mo_two_e_ints/map_integrals_cplx.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f index 67adec82..2156e103 100644 --- a/src/mo_two_e_ints/map_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/map_integrals_cplx.irp.f @@ -398,7 +398,7 @@ subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) ! if l Date: Fri, 6 Mar 2020 11:09:29 -0600 Subject: [PATCH 135/256] wrong types --- src/davidson/print_e_components.irp.f | 9 +++++---- src/mo_two_e_ints/integrals_3_index.irp.f | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/davidson/print_e_components.irp.f b/src/davidson/print_e_components.irp.f index 920daa18..9c3caf23 100644 --- a/src/davidson/print_e_components.irp.f +++ b/src/davidson/print_e_components.irp.f @@ -5,6 +5,7 @@ subroutine print_energy_components() END_DOC integer, save :: ifirst = 0 double precision :: Vee, Ven, Vnn, Vecp, T, f + complex*16 :: fc integer :: i,j,k Vnn = nuclear_repulsion @@ -21,10 +22,10 @@ subroutine print_energy_components() if (is_complex) then do j=1,mo_num do i=1,mo_num - f = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k) - Ven = Ven + dble(f * mo_integrals_n_e_complex(j,i)) - Vecp = Vecp + dble(f * mo_pseudo_integrals_complex(j,i)) - T = T + dble(f * mo_kinetic_integrals_complex(j,i)) + fc = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k) + Ven = Ven + dble(fc * mo_integrals_n_e_complex(j,i)) + Vecp = Vecp + dble(fc * mo_pseudo_integrals_complex(j,i)) + T = T + dble(fc * mo_kinetic_integrals_complex(j,i)) enddo enddo else diff --git a/src/mo_two_e_ints/integrals_3_index.irp.f b/src/mo_two_e_ints/integrals_3_index.irp.f index 811ae493..983e2642 100644 --- a/src/mo_two_e_ints/integrals_3_index.irp.f +++ b/src/mo_two_e_ints/integrals_3_index.irp.f @@ -45,10 +45,10 @@ END_PROVIDER do j = 1, mo_num l = j integral = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) - big_array_coulomb_integrals(j,i,k) = integral + big_array_coulomb_integrals_complex(j,i,k) = integral l = j integral = get_two_e_integral_complex(i,j,l,k,mo_integrals_map,mo_integrals_map_2) - big_array_exchange_integrals(j,i,k) = integral + big_array_exchange_integrals_complex(j,i,k) = integral enddo enddo enddo From 8411167e90f01d66e27d59a4e61fa26d6eaa4fa7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 10 Mar 2020 18:10:55 -0500 Subject: [PATCH 136/256] cleaning up converter --- src/utils_complex/MolPyscfToQPkpts.py | 273 +++++++++++++++++++------- 1 file changed, 207 insertions(+), 66 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 5ebaa995..a3a84235 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -509,8 +509,74 @@ def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E v.real,v.imag)+'\n') - - +def print_kpts_unblocked(ints_k,outfilename,thresh): + ''' + for ints_k of shape (Nk,n1,n2), + print the elements of the corresponding block-diagonal matrix of shape (Nk*n1,Nk*n2) in file + ''' + Nk,n1,n2 = ints_k.shape + with open(outfilename,'w') as outfile: + for ik in range(Nk): + shift1 = ik*n1+1 + shift2 = ik*n2+1 + for i1 in range(n1): + for i2 in range(n2): + int_ij = ints_k[ik,i1,i2] + if abs(int_ij) > thresh: + outfile.write(stri2z(i1+shift1, i2+shift2, int_ij.real, int_ij.imag)+'\n') + return + +def print_kpts_unblocked_upper(ints_k,outfilename,thresh): + ''' + for hermitian ints_k of shape (Nk,n1,n1), + print the elements of the corresponding block-diagonal matrix of shape (Nk*n1,Nk*n1) in file + (only upper triangle is printed) + ''' + Nk,n1,n2 = ints_k.shape + if (n1!=n2): + raise Exception('print_kpts_unblocked_upper called with non-square matrix') + + with open(outfilename,'w') as outfile: + for ik in range(Nk): + shift = ik*n1+1 + for i1 in range(n1): + for i2 in range(i1,n1): + int_ij = ints_k[ik,i1,i2] + if abs(int_ij) > thresh: + outfile.write(stri2z(i1+shift, i2+shift, int_ij.real, int_ij.imag)+'\n') + return + + + +def get_kin_ao(mf): + nao = mf.cell.nao_nr() + Nk = len(mf.kpts) + return np.reshape(mf.cell.pbc_intor('int1e_kin',1,1,kpts=mf.kpts),(Nk,nao,nao)) + +def get_ovlp_ao(mf): + nao = mf.cell.nao_nr() + Nk = len(mf.kpts) + return np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)) + +def get_pot_ao(mf): + nao = mf.cell.nao_nr() + Nk = len(mf.kpts) + + if mf.cell.pseudo: + v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) + else: + v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) + + if len(cell._ecpbas) > 0: + from pyscf.pbc.gto import ecp + v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) + + return v_kpts_ao + +def ao_to_mo_1e(ao_kpts,mo_coef): + return np.einsum('kim,kij,kjn->kmn',mo_coef.conj(),ao_kpts_ao,mo_coef) + + def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_ao_ints_bi=False, print_mo_ints_bi=False, @@ -532,19 +598,23 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, import h5py import scipy - qph5=h5py.File('qpdat.h5') - qph5.create_group('nuclei') - qph5.create_group('electrons') - qph5.create_group('ao_basis') - qph5.create_group('mo_basis') - - mo_coef_threshold = int_threshold ovlp_threshold = int_threshold kin_threshold = int_threshold ne_threshold = int_threshold bielec_int_threshold = int_threshold + thresh_mono = int_threshold + + + qph5path = 'qpdat.h5' + # create hdf5 file, delete old data if exists + with h5py.File(qph5path,'w') as qph5: + qph5.create_group('nuclei') + qph5.create_group('electrons') + qph5.create_group('ao_basis') + qph5.create_group('mo_basis') + qph5 = h5py.File(qph5path,'a') natom = cell.natm nelec = cell.nelectron neleca,nelecb = cell.nelec @@ -573,18 +643,19 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print("n active Mos per kpt", nmo) print("n AOs per kpt", nao) - naux = mf.with_df.auxcell.nao - print("n df fitting functions", naux) +# naux = mf.with_df.auxcell.nao +# print("n df fitting functions", naux) #in old version: param << nelec*Nk, nmo*Nk, natom*Nk qph5['electrons'].attrs['elec_alpha_num']=neleca*Nk qph5['electrons'].attrs['elec_beta_num']=nelecb*Nk qph5['mo_basis'].attrs['mo_num']=Nk*nmo qph5['ao_basis'].attrs['ao_num']=Nk*nao - qph5['nuclei'].attrs['nucl_num']=Nk*natom + #qph5['nuclei'].attrs['nucl_num']=Nk*natom + qph5['nuclei'].attrs['nucl_num']=natom qph5['nuclei'].attrs['kpt_num']=Nk qph5.create_group('ao_two_e_ints') - qph5['ao_two_e_ints'].attrs['df_num']=naux +# qph5['ao_two_e_ints'].attrs['df_num']=naux qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis ao_nucl=[mf.cell.bas_atom(i)+1 for i in range(nao)] @@ -612,67 +683,52 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) - - with open('C.qp','w') as outfile: - c_kpts = np.reshape(mo_k,(Nk,nao,nmo)) - - for ik in range(Nk): - shift1=ik*nao+1 - shift2=ik*nmo+1 - for i in range(nao): - for j in range(nmo): - cij = c_kpts[ik,i,j] - if abs(cij) > mo_coef_threshold: - outfile.write(stri2z(i+shift1, j+shift2, cij.real, cij.imag)+'\n') + + print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) # ___ # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) # _| - - if mf.cell.pseudo: - v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) - else: - v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) - if len(cell._ecpbas) > 0: - v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) - - ne_ao = ('V',v_kpts_ao,ne_threshold) - ovlp_ao = ('S',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) - kin_ao = ('T',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) - - kin_ao_blocked=scipy.linalg.block_diag(*kin_ao[1]) - ovlp_ao_blocked=scipy.linalg.block_diag(*ovlp_ao[1]) - ne_ao_blocked=scipy.linalg.block_diag(*v_kpts_ao) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) + ne_ao = get_pot_ao(mf) + kin_ao = get_kin_ao(mf) + ovlp_ao = get_ovlp_ao(mf) + if print_ao_ints_mono: + kin_ao_blocked=scipy.linalg.block_diag(*kin_ao) + ovlp_ao_blocked=scipy.linalg.block_diag(*ovlp_ao) + ne_ao_blocked=scipy.linalg.block_diag(*ne_ao) - for name, intval_kpts_ao, thresh in (ne_ao, ovlp_ao, kin_ao): - if print_ao_ints_mono: - with open('%s.qp' % name,'w') as outfile: - for ik in range(Nk): - shift=ik*nao+1 - for i in range(nao): - for j in range(i,nao): - int_ij = intval_kpts_ao[ik,i,j] - if abs(int_ij) > thresh: - outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') - if print_mo_ints_mono: - intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) - with open('%s_mo.qp' % name,'w') as outfile: - for ik in range(Nk): - shift=ik*nmo+1 - for i in range(nmo): - for j in range(i,nmo): - int_ij = intval_kpts_mo[ik,i,j] - if abs(int_ij) > thresh: - outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) + + for fname,ints in zip(('S.qp','V.qp','T.qp'), + (ovlp_ao, ne_ao, kin_ao)): + print_kpts_unblocked_upper(ints,fname,thresh_mono) + + if print_mo_ints_mono: + kin_mo = ao_to_mo_1e(kin_ao,mo_k) + ovlp_mo = ao_to_mo_1e(ovlp_ao,mo_k) + ne_mo = ao_to_mo_1e(ne_ao,mo_k) + + kin_mo_blocked=scipy.linalg.block_diag(*kin_mo) + ovlp_mo_blocked=scipy.linalg.block_diag(*ovlp_mo) + ne_mo_blocked=scipy.linalg.block_diag(*ne_mo) + + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) + for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), + (ovlp_mo, ne_mo, kin_mo)): + print_kpts_unblocked_upper(ints,fname,thresh_mono) # ___ _ @@ -721,6 +777,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) nkpt_pairs = j3arr.shape[0] + naux = max(i.shape[0] for i in j3arr) + print("n df fitting functions", naux) + qph5['ao_two_e_ints'].attrs['df_num']=naux df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) if print_ao_ints_df: @@ -764,6 +823,88 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if (print_mo_ints_bi): print_mo_bi(mf,kconserv,'W.mo.qp',cas_idx,bielec_int_threshold) + +def getj3ao(cell,mf, kpts, cas_idx=None, int_threshold = 1E-8): + ''' + kpts = List of kpoints coordinates. Cannot be null, for gamma is other script + kmesh = Mesh of kpoints (optional) + cas_idx = List of active MOs. If not specified all MOs are actives + int_threshold = The integral will be not printed in they are bellow that + ''' + + from pyscf.pbc import ao2mo + from pyscf.pbc import tools + from pyscf.pbc.gto import ecp + from pyscf.data import nist + import h5py + import scipy + + + + mo_coef_threshold = int_threshold + ovlp_threshold = int_threshold + kin_threshold = int_threshold + ne_threshold = int_threshold + bielec_int_threshold = int_threshold + + mo_coeff = mf.mo_coeff + # Mo_coeff actif + mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) + e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) + + Nk, nao, nmo = mo_k.shape + print("n Kpts", Nk) + print("n active Mos per kpt", nmo) + print("n AOs per kpt", nao) + +# naux = mf.with_df.auxcell.nao +# print("n df fitting functions", naux) + + + + + + with h5py.File(mf.with_df._cderi) as intfile: +# intfile=h5py.File(mf.with_df._cderi,'r') + + j3c = intfile.get('j3c') + naosq = nao*nao + naotri = (nao*(nao+1))//2 + j3ckeys = list(j3c.keys()) + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + j3clist = [j3c.get(i+'/0') for i in j3ckeys] + if j3clist==[None]*len(j3clist): + # if using older version, stop before last level + j3clist = [j3c.get(i) for i in j3ckeys] + + nkinvsq = 1./np.sqrt(Nk) + + # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j + # output dimensions should be reversed (nao, nao, naux, nkptpairs) + j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + + return j3arr + #nkpt_pairs = j3arr.shape[0] + #df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) + + #if print_ao_ints_df: + # with open('D.qp','w') as outfile: + # pass + # with open('D.qp','a') as outfile: + # for k,kpt_pair in enumerate(j3arr): + # for iaux,dfbasfunc in enumerate(kpt_pair): + # for i,i0 in enumerate(dfbasfunc): + # for j,v in enumerate(i0): + # if (abs(v) > bielec_int_threshold): + # outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') + # df_ao_tmp[i,j,iaux,k]=v + + + #def testpyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8): From f07bdee9cd9b14643306be0c366ca874ae97788c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 11 Mar 2020 13:48:35 -0500 Subject: [PATCH 137/256] converter cleanup --- src/utils_complex/MolPyscfToQPkpts.py | 373 ++++++++++++++++---------- 1 file changed, 225 insertions(+), 148 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index a3a84235..71da37db 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -33,6 +33,9 @@ def idx40(i,j,k,l): def idx4(i,j,k,l): return idx2_tri((idx2_tri((i-1,k-1)),idx2_tri((j-1,l-1))))+1 +def stri4(i,j,k,l): + return (4*'{:5d}').format(i,j,k,l) + def stri4z(i,j,k,l,zr,zi): return (4*'{:5d}'+2*'{:25.16e}').format(i,j,k,l,zr,zi) @@ -509,6 +512,25 @@ def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E v.real,v.imag)+'\n') +def print_kcon_chem_to_phys(kcon,fname): + ''' + input: kconserv in chem notation kcon_c[a,b,c] = d + where (ab|cd) is allowed by symmetry + output: kconserv in phys notation kcon_p[i,j,k] = l + where is allowed by symmetry + (printed to file) + ''' + Nk,n2,n3 = kcon.shape + if (n2!=n3 or Nk!=n2): + raise Exception('print_kcon_chem_to_phys called with non-cubic array') + + with open(fname,'w') as outfile: + for a in range(Nk): + for b in range(Nk): + for c in range(Nk): + d = kcon[a,b,c] + outfile.write(stri4(a+1,c+1,b+1,d+1)+'\n') + def print_kpts_unblocked(ints_k,outfilename,thresh): ''' for ints_k of shape (Nk,n1,n2), @@ -556,26 +578,70 @@ def get_kin_ao(mf): def get_ovlp_ao(mf): nao = mf.cell.nao_nr() Nk = len(mf.kpts) - return np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)) + return np.reshape(mf.get_ovlp(cell=mf.cell,kpts=mf.kpts),(Nk,nao,nao)) def get_pot_ao(mf): nao = mf.cell.nao_nr() Nk = len(mf.kpts) if mf.cell.pseudo: - v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) + v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=mf.kpts),(Nk,nao,nao)) else: - v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) + v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=mf.kpts),(Nk,nao,nao)) - if len(cell._ecpbas) > 0: + if len(mf.cell._ecpbas) > 0: from pyscf.pbc.gto import ecp - v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) + v_kpts_ao += np.reshape(ecp.ecp_int(mf.cell, mf.kpts),(Nk,nao,nao)) return v_kpts_ao def ao_to_mo_1e(ao_kpts,mo_coef): return np.einsum('kim,kij,kjn->kmn',mo_coef.conj(),ao_kpts_ao,mo_coef) +def get_j3ao(fname,nao,Nk): + import h5py + with h5py.File(fname,'r') as intfile: + j3c = intfile.get('j3c') + j3ckeys = list(j3c.keys()) + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + j3clist = [j3c.get(i+'/0') for i in j3ckeys] + #if j3clist==[None]*len(j3clist): + if not(any(j3clist)): + # if using older version, stop before last level + j3clist = [j3c.get(i) for i in j3ckeys] + + naosq = nao*nao + naotri = (nao*(nao+1))//2 + nkinvsq = 1./np.sqrt(Nk) + + # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j + # output dimensions should be reversed (nao, nao, naux, nkptpairs) + return np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + +def print_df(j3arr,fname,thresh): + with open(fname,'w') as outfile: + for k,kpt_pair in enumerate(j3arr): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + if (abs(v) > thresh): + outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') + return + +def df_pad_ref_test(j3arr,nao,naux,nkpt_pairs): + df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) + for k,kpt_pair in enumerate(j3arr): + for iaux,dfbasfunc in enumerate(kpt_pair): + for i,i0 in enumerate(dfbasfunc): + for j,v in enumerate(i0): + df_ao_tmp[i,j,iaux,k]=v + return df_ao_tmp + + def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_ao_ints_bi=False, @@ -591,12 +657,11 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, int_threshold = The integral will be not printed in they are bellow that ''' - from pyscf.pbc import ao2mo +# from pyscf.pbc import ao2mo from pyscf.pbc import tools - from pyscf.pbc.gto import ecp - from pyscf.data import nist import h5py - import scipy +# import scipy + from scipy.linalg import block_diag mo_coef_threshold = int_threshold ovlp_threshold = int_threshold @@ -614,98 +679,127 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_group('ao_basis') qph5.create_group('mo_basis') - qph5 = h5py.File(qph5path,'a') - natom = cell.natm - nelec = cell.nelectron - neleca,nelecb = cell.nelec - atom_xyz = mf.cell.atom_coords() - if not(mf.cell.unit.startswith(('B','b','au','AU'))): - atom_xyz /= nist.BOHR # always convert to au - - strtype=h5py.special_dtype(vlen=str) - atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) - for i in range(natom): - atom_dset[i] = mf.cell.atom_pure_symbol(i) - qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) - qph5.create_dataset('nuclei/nucl_charge',data=mf.cell.atom_charges()) - - - print('n_atom per kpt', natom) - print('num_elec per kpt', nelec) - mo_coeff = mf.mo_coeff # Mo_coeff actif mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) Nk, nao, nmo = mo_k.shape + print("n Kpts", Nk) print("n active Mos per kpt", nmo) print("n AOs per kpt", nao) -# naux = mf.with_df.auxcell.nao -# print("n df fitting functions", naux) - - #in old version: param << nelec*Nk, nmo*Nk, natom*Nk - qph5['electrons'].attrs['elec_alpha_num']=neleca*Nk - qph5['electrons'].attrs['elec_beta_num']=nelecb*Nk - qph5['mo_basis'].attrs['mo_num']=Nk*nmo - qph5['ao_basis'].attrs['ao_num']=Nk*nao - #qph5['nuclei'].attrs['nucl_num']=Nk*natom - qph5['nuclei'].attrs['nucl_num']=natom - qph5['nuclei'].attrs['kpt_num']=Nk - qph5.create_group('ao_two_e_ints') -# qph5['ao_two_e_ints'].attrs['df_num']=naux + ########################################## + # # + # Nuclei # + # # + ########################################## - qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis - ao_nucl=[mf.cell.bas_atom(i)+1 for i in range(nao)] - qph5.create_dataset('ao_basis/ao_nucl',data=Nk*ao_nucl) + natom = cell.natm + print('n_atom per kpt', natom) + atom_xyz = mf.cell.atom_coords() + if not(mf.cell.unit.startswith(('B','b','au','AU'))): + from pyscf.data.nist import BOHR + atom_xyz /= BOHR # always convert to au + + with h5py.File(qph5path,'a') as qph5: + qph5['nuclei'].attrs['kpt_num']=Nk + qph5['nuclei'].attrs['nucl_num']=natom + qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) + qph5.create_dataset('nuclei/nucl_charge',data=mf.cell.atom_charges()) + + strtype=h5py.special_dtype(vlen=str) + atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) + for i in range(natom): + atom_dset[i] = mf.cell.atom_pure_symbol(i) + + ########################################## + # # + # Basis # + # # + ########################################## + + # nucleus on which each AO is centered + ao_nucl=[i[0] for i in mf.cell.ao_labels(fmt=False,base=1)] + + with h5py.File(qph5path,'a') as qph5: + qph5['mo_basis'].attrs['mo_num']=Nk*nmo + qph5['ao_basis'].attrs['ao_num']=Nk*nao + + qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis + + qph5.create_dataset('ao_basis/ao_nucl',data=Nk*ao_nucl) + + ########################################## + # # + # Electrons # + # # + ########################################## + + nelec = cell.nelectron + neleca,nelecb = cell.nelec + + print('num_elec per kpt', nelec) + + with h5py.File(qph5path,'a') as qph5: + #in old version: param << nelec*Nk, nmo*Nk, natom*Nk + qph5['electrons'].attrs['elec_alpha_num']=neleca*Nk + qph5['electrons'].attrs['elec_beta_num']=nelecb*Nk + + ########################################## + # # + # Nuclear Repulsion # + # # + ########################################## - # _ - # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ - # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | - # | - #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 e_nuc = (cell.energy_nuc() + shift)*Nk print('nucl_repul', e_nuc) - qph5['nuclei'].attrs['nuclear_repulsion']=e_nuc + + with h5py.File(qph5path,'a') as qph5: + qph5['nuclei'].attrs['nuclear_repulsion']=e_nuc - # __ __ _ - # |\/| | | | _ _ |_ _ - # | | |__| |__ (_) (/_ | _> - # - mo_coef_blocked=scipy.linalg.block_diag(*mo_k) - qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) - qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) - qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) - qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + ########################################## + # # + # MO Coef # + # # + ########################################## + + mo_coef_blocked=block_diag(*mo_k) + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) + qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) + qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) + qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) - # ___ - # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ - # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) - # _| + ########################################## + # # + # Integrals Mono # + # # + ########################################## ne_ao = get_pot_ao(mf) kin_ao = get_kin_ao(mf) ovlp_ao = get_ovlp_ao(mf) if print_ao_ints_mono: - kin_ao_blocked=scipy.linalg.block_diag(*kin_ao) - ovlp_ao_blocked=scipy.linalg.block_diag(*ovlp_ao) - ne_ao_blocked=scipy.linalg.block_diag(*ne_ao) + kin_ao_blocked=block_diag(*kin_ao) + ovlp_ao_blocked=block_diag(*ovlp_ao) + ne_ao_blocked=block_diag(*ne_ao) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) for fname,ints in zip(('S.qp','V.qp','T.qp'), (ovlp_ao, ne_ao, kin_ao)): @@ -716,107 +810,91 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ovlp_mo = ao_to_mo_1e(ovlp_ao,mo_k) ne_mo = ao_to_mo_1e(ne_ao,mo_k) - kin_mo_blocked=scipy.linalg.block_diag(*kin_mo) - ovlp_mo_blocked=scipy.linalg.block_diag(*ovlp_mo) - ne_mo_blocked=scipy.linalg.block_diag(*ne_mo) + kin_mo_blocked=block_diag(*kin_mo) + ovlp_mo_blocked=block_diag(*ovlp_mo) + ne_mo_blocked=block_diag(*ne_mo) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) - qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) - qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), (ovlp_mo, ne_mo, kin_mo)): print_kpts_unblocked_upper(ints,fname,thresh_mono) - # ___ _ - # | ._ _|_ _ _ ._ _. | _ |_) o - # _|_ | | |_ (/_ (_| | (_| | _> |_) | - # _| - # + ########################################## + # # + # k-points # + # # + ########################################## + kconserv = tools.get_kconserv(cell, kpts) - qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) + + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) + kcon_test = np.zeros((Nk,Nk,Nk),dtype=int) for a in range(Nk): for b in range(Nk): for c in range(Nk): kcon_test[a,c,b] = kconserv[a,b,c]+1 - qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) - - with open('K.qp','w') as outfile: - for a in range(Nk): - for b in range(Nk): - for c in range(Nk): - d = kconserv[a,b,c] - outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) - + print_kcon_chem_to_phys(kconserv,'K.qp') + + ########################################## + # # + # Integrals Bi # + # # + ########################################## - intfile=h5py.File(mf.with_df._cderi,'r') +# qph5['ao_two_e_ints'].attrs['df_num']=naux - j3c = intfile.get('j3c') - naosq = nao*nao - naotri = (nao*(nao+1))//2 - j3ckeys = list(j3c.keys()) - j3ckeys.sort(key=lambda strkey:int(strkey)) - - # in new(?) version of PySCF, there is an extra layer of groups before the datasets - # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] - # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] - j3clist = [j3c.get(i+'/0') for i in j3ckeys] - if j3clist==[None]*len(j3clist): - # if using older version, stop before last level - j3clist = [j3c.get(i) for i in j3ckeys] - - nkinvsq = 1./np.sqrt(Nk) - - # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j - # output dimensions should be reversed (nao, nao, naux, nkptpairs) - j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) + j3arr = get_j3ao(mf.with_df._cderi,nao,Nk) nkpt_pairs = j3arr.shape[0] naux = max(i.shape[0] for i in j3arr) print("n df fitting functions", naux) - qph5['ao_two_e_ints'].attrs['df_num']=naux - df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) + with h5py.File(qph5path,'a') as qph5: + qph5.create_group('ao_two_e_ints') + qph5['ao_two_e_ints'].attrs['df_num']=naux if print_ao_ints_df: - with open('D.qp','w') as outfile: - pass - with open('D.qp','a') as outfile: - for k,kpt_pair in enumerate(j3arr): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - df_ao_tmp[i,j,iaux,k]=v + print_df(j3arr,'D.qp',bielec_int_threshold) + + df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) + for i,di in enumerate(j3arr): + df_ao_tmp[:,:,:di.shape[0],i] = np.transpose(di,(1,2,0)) - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) + #df_ao_old = df_pad_ref_test(j3arr,nao,naux,nkpt_pairs) + #assert(abs(df_ao_tmp - df_ao_old).max() <= 1e-12) + + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) if print_mo_ints_df: - kpair_list=[] - for i in range(Nk): - for j in range(Nk): - if(i>=j): - kpair_list.append((i,j,idx2_tri((i,j)))) + from itertools import product + # WARNING: this is a generator, not a list; don't use it more than once + kpair_list = ((i,j,idx2_tri((i,j))) for (i,j) in product(range(Nk),repeat=2) if (i>=j)) j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) + print_df(j3mo,'D.mo.qp',bielec_int_threshold) + df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) - with open('D_mo.qp','w') as outfile: - pass - with open('D_mo.qp','a') as outfile: - for k,kpt_pair in enumerate(j3mo): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - df_mo_tmp[i,j,iaux,k]=v - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) + for i,di in enumerate(j3mo): + df_mo_tmp[:,:,:di.shape[0],i] = np.transpose(di,(1,2,0)) + + #df_mo_old = df_pad_ref_test(j3mo,nmo,naux,nkpt_pairs) + #assert(abs(df_mo_tmp - df_mo_old).max() <= 1e-12) + + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) if (print_ao_ints_bi): print_ao_bi(mf,kconserv,'W.qp',bielec_int_threshold) @@ -835,7 +913,6 @@ def getj3ao(cell,mf, kpts, cas_idx=None, int_threshold = 1E-8): from pyscf.pbc import ao2mo from pyscf.pbc import tools from pyscf.pbc.gto import ecp - from pyscf.data import nist import h5py import scipy From b0bf0c79d64c301f8da17f4bf9527e4f8c8f44b7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 11 Mar 2020 15:16:58 -0500 Subject: [PATCH 138/256] removed unused functions from converter --- src/utils_complex/MolPyscfToQPkpts.py | 496 ++++---------------------- 1 file changed, 69 insertions(+), 427 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 71da37db..6f835a99 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -218,203 +218,6 @@ def qp2rename(): shutil.move(old,new) shutil.copy('e_nuc','E.qp') -def pyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, - print_ao_ints_bi=False, - print_mo_ints_bi=False, - print_ao_ints_df=True, - print_mo_ints_df=False, - print_ao_ints_mono=True, - print_mo_ints_mono=False): - ''' - kpts = List of kpoints coordinates. Cannot be null, for gamma is other script - kmesh = Mesh of kpoints (optional) - cas_idx = List of active MOs. If not specified all MOs are actives - int_threshold = The integral will be not printed in they are bellow that - ''' - - from pyscf.pbc import ao2mo - from pyscf.pbc import tools - from pyscf.pbc.gto import ecp - import h5py - - mo_coef_threshold = int_threshold - ovlp_threshold = int_threshold - kin_threshold = int_threshold - ne_threshold = int_threshold - bielec_int_threshold = int_threshold - - natom = len(cell.atom_coords()) - print('n_atom per kpt', natom) - print('num_elec per kpt', cell.nelectron) - - mo_coeff = mf.mo_coeff - # Mo_coeff actif - mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) - e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) - - Nk, nao, nmo = mo_k.shape - print("n Kpts", Nk) - print("n active Mos per kpt", nmo) - print("n AOs per kpt", nao) - - naux = mf.with_df.auxcell.nao - print("n df fitting functions", naux) - with open('num_df','w') as f: - f.write(str(naux)) - - # Write all the parameter need to creat a dummy EZFIO folder who will containt the integral after. - # More an implentation detail than a real thing - with open('param','w') as f: - # Note the use of nmo_tot - f.write(' '.join(map(str,(cell.nelectron*Nk, Nk*nmo, natom*Nk)))) - - with open('num_ao','w') as f: - f.write(str(nao*Nk)) - with open('kpt_num','w') as f: - f.write(str(Nk)) - # _ - # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ - # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | - # | - - #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = - shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 - e_nuc = (cell.energy_nuc() + shift)*Nk - - print('nucl_repul', e_nuc) - with open('e_nuc','w') as f: - f.write(str(e_nuc)) - - - - # __ __ _ - # |\/| | | | _ _ |_ _ - # | | |__| |__ (_) (/_ | _> - # - with open('mo_coef_complex','w') as outfile: - c_kpts = np.reshape(mo_k,(Nk,nao,nmo)) - - for ik in range(Nk): - shift1=ik*nao+1 - shift2=ik*nmo+1 - for i in range(nao): - for j in range(nmo): - cij = c_kpts[ik,i,j] - if abs(cij) > mo_coef_threshold: - outfile.write('%s %s %s %s\n' % (i+shift1, j+shift2, cij.real, cij.imag)) - - # ___ - # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ - # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) - # _| - - if mf.cell.pseudo: - v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) - else: - v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) - if len(cell._ecpbas) > 0: - v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) - - ne_ao = ('ne',v_kpts_ao,ne_threshold) - ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) - kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) - - for name, intval_kpts_ao, thresh in (ne_ao, ovlp_ao, kin_ao): - if print_ao_ints_mono: - with open('%s_ao_complex' % name,'w') as outfile: - for ik in range(Nk): - shift=ik*nao+1 - for i in range(nao): - for j in range(i,nao): - int_ij = intval_kpts_ao[ik,i,j] - if abs(int_ij) > thresh: - outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') - if print_mo_ints_mono: - intval_kpts_mo = np.einsum('kim,kij,kjn->kmn',mo_k.conj(),intval_kpts_ao,mo_k) - with open('%s_mo_complex' % name,'w') as outfile: - for ik in range(Nk): - shift=ik*nmo+1 - for i in range(nmo): - for j in range(i,nmo): - int_ij = intval_kpts_mo[ik,i,j] - if abs(int_ij) > thresh: - outfile.write(stri2z(i+shift, j+shift, int_ij.real, int_ij.imag)+'\n') - - - # ___ _ - # | ._ _|_ _ _ ._ _. | _ |_) o - # _|_ | | |_ (/_ (_| | (_| | _> |_) | - # _| - # - kconserv = tools.get_kconserv(cell, kpts) - - with open('kconserv_complex','w') as outfile: - for a in range(Nk): - for b in range(Nk): - for c in range(Nk): - d = kconserv[a,b,c] - outfile.write('%s %s %s %s\n' % (a+1,c+1,b+1,d+1)) - - - intfile=h5py.File(mf.with_df._cderi,'r') - - j3c = intfile.get('j3c') - naosq = nao*nao - naotri = (nao*(nao+1))//2 - j3ckeys = list(j3c.keys()) - j3ckeys.sort(key=lambda strkey:int(strkey)) - - # in new(?) version of PySCF, there is an extra layer of groups before the datasets - # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] - # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] - j3clist = [j3c.get(i+'/0') for i in j3ckeys] - if j3clist==[None]*len(j3clist): - # if using older version, stop before last level - j3clist = [j3c.get(i) for i in j3ckeys] - - nkinvsq = 1./np.sqrt(Nk) - - # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j - # output dimensions should be reversed (nao, nao, naux, nkptpairs) - j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) - - nkpt_pairs = j3arr.shape[0] - - if print_ao_ints_df: - with open('df_ao_integral_array','w') as outfile: - pass - with open('df_ao_integral_array','a') as outfile: - for k,kpt_pair in enumerate(j3arr): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - - if print_mo_ints_df: - kpair_list=[] - for i in range(Nk): - for j in range(Nk): - if(i>=j): - kpair_list.append((i,j,idx2_tri((i,j)))) - j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) - with open('df_mo_integral_array','w') as outfile: - pass - with open('df_mo_integral_array','a') as outfile: - for k,kpt_pair in enumerate(j3mo): - for iaux,dfbasfunc in enumerate(kpt_pair): - for i,i0 in enumerate(dfbasfunc): - for j,v in enumerate(i0): - if (abs(v) > bielec_int_threshold): - outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - - - if (print_ao_ints_bi): - print_ao_bi(mf,kconserv,'bielec_ao_complex',bielec_int_threshold) - if (print_mo_ints_bi): - print_mo_bi(mf,kconserv,'bielec_mo_complex',cas_idx,bielec_int_threshold) - - def print_mo_bi(mf,kconserv=None,outfilename='W.mo.qp',cas_idx=None,bielec_int_threshold = 1E-8): cell = mf.cell @@ -474,8 +277,8 @@ def print_ao_bi(mf,kconserv=None,outfilename='W.ao.qp',bielec_int_threshold = 1E Nk = kpts.shape[0] if (kconserv is None): - from pyscf.pbc import tools - kconserv = tools.get_kconserv(cell, kpts) + from pyscf.pbc.tools import get_kconserv + kconserv = get_kconserv(cell, kpts) with open(outfilename,'w') as outfile: for d, kd in enumerate(kpts): @@ -598,7 +401,12 @@ def get_pot_ao(mf): def ao_to_mo_1e(ao_kpts,mo_coef): return np.einsum('kim,kij,kjn->kmn',mo_coef.conj(),ao_kpts_ao,mo_coef) -def get_j3ao(fname,nao,Nk): +def get_j3ao_old(fname,nao,Nk): + ''' + returns list of Nk_pair arrays of shape (naux,nao,nao) + if naux is the same for each pair, returns numpy array + if naux is not the same for each pair, returns array of arrays + ''' import h5py with h5py.File(fname,'r') as intfile: j3c = intfile.get('j3c') @@ -622,6 +430,42 @@ def get_j3ao(fname,nao,Nk): # output dimensions should be reversed (nao, nao, naux, nkptpairs) return np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) +def get_j3ao(fname,nao,Nk): + ''' + returns padded df AO array + fills in zeros when functions are dropped due to linear dependency + ''' + import h5py + with h5py.File(fname,'r') as intfile: + j3c = intfile.get('j3c') + j3ckeys = list(j3c.keys()) + nkpairs = len(j3ckeys) + + # get num order instead of lex order + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + keysub = '/0' if bool(j3c.get('0/0',getclass=True)) else '' + + naux = max(map(lambda k: j3c[k+keysub].shape[0],j3c.keys())) + + naosq = nao*nao + naotri = (nao*(nao+1))//2 + nkinvsq = 1./np.sqrt(Nk) + + j3arr = np.zeros((nkpairs,naux,nao,nao),dtype=np.complex128) + + for i,kpair in enumerate(j3ckeys): + iaux,dim2 = j3c[kpair+keysub].shape + if (dim2==naosq): + j3arr[i,:iaux,:,:] = j3c[kpair+keysub][()].reshape([iaux,nao,nao]) * nkinvsq + else: + j3arr[i,:iaux,:,:] = makesq3(j3c[kpair+keysub][()],nao) * nkinvsq + + return j3arr + def print_df(j3arr,fname,thresh): with open(fname,'w') as outfile: for k,kpt_pair in enumerate(j3arr): @@ -642,6 +486,21 @@ def df_pad_ref_test(j3arr,nao,naux,nkpt_pairs): return df_ao_tmp +def df_ao_to_mo(j3ao,mo_coef): + from itertools import product + Nk = mo_coef.shape[0] + kpair_list = ((i,j,idx2_tri((i,j))) for (i,j) in product(range(Nk),repeat=2) if (i>=j)) + return np.array([ + np.einsum('mij,ik,jl->mkl',j3ao[kij],mo_coef[ki].conj(),mo_coef[kj]) + for ki,kj,kij in kpair_list]) + +def df_ao_to_mo_test(j3ao,mo_coef): + from itertools import product + Nk = mo_coef.shape[0] + return np.array([ + np.einsum('mij,ik,jl->mkl',j3ao[idx2_tri((ki,kj))],mo_coef[ki].conj(),mo_coef[kj]) + for ki,kj in product(range(Nk),repeat=2) if (ki>=kj)]) + def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_ao_ints_bi=False, @@ -853,11 +712,13 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # # ########################################## -# qph5['ao_two_e_ints'].attrs['df_num']=naux - j3arr = get_j3ao(mf.with_df._cderi,nao,Nk) + # test? should be (Nk*(Nk+1))//2 nkpt_pairs = j3arr.shape[0] + + # mf.with_df.get_naoaux() gives correct naux if no linear dependency in auxbasis + # this should work even with linear dependency naux = max(i.shape[0] for i in j3arr) print("n df fitting functions", naux) with h5py.File(qph5path,'a') as qph5: @@ -879,10 +740,11 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) if print_mo_ints_df: - from itertools import product - # WARNING: this is a generator, not a list; don't use it more than once - kpair_list = ((i,j,idx2_tri((i,j))) for (i,j) in product(range(Nk),repeat=2) if (i>=j)) - j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij],mo_k[ki].conj(),mo_k[kj]) for ki,kj,kij in kpair_list]) + + j3mo = df_ao_to_mo(j3arr,mo_k) + #j3mo_test = df_ao_to_mo_test(j3arr,mo_k) + #assert(all([abs(i-j).max() <= 1e-12 for (i,j) in zip(j3mo,j3mo_test)])) + print_df(j3mo,'D.mo.qp',bielec_int_threshold) df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) @@ -900,224 +762,4 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_ao_bi(mf,kconserv,'W.qp',bielec_int_threshold) if (print_mo_ints_bi): print_mo_bi(mf,kconserv,'W.mo.qp',cas_idx,bielec_int_threshold) - - -def getj3ao(cell,mf, kpts, cas_idx=None, int_threshold = 1E-8): - ''' - kpts = List of kpoints coordinates. Cannot be null, for gamma is other script - kmesh = Mesh of kpoints (optional) - cas_idx = List of active MOs. If not specified all MOs are actives - int_threshold = The integral will be not printed in they are bellow that - ''' - - from pyscf.pbc import ao2mo - from pyscf.pbc import tools - from pyscf.pbc.gto import ecp - import h5py - import scipy - - - - mo_coef_threshold = int_threshold - ovlp_threshold = int_threshold - kin_threshold = int_threshold - ne_threshold = int_threshold - bielec_int_threshold = int_threshold - - mo_coeff = mf.mo_coeff - # Mo_coeff actif - mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) - e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) - - Nk, nao, nmo = mo_k.shape - print("n Kpts", Nk) - print("n active Mos per kpt", nmo) - print("n AOs per kpt", nao) - -# naux = mf.with_df.auxcell.nao -# print("n df fitting functions", naux) - - - - - - with h5py.File(mf.with_df._cderi) as intfile: -# intfile=h5py.File(mf.with_df._cderi,'r') - - j3c = intfile.get('j3c') - naosq = nao*nao - naotri = (nao*(nao+1))//2 - j3ckeys = list(j3c.keys()) - j3ckeys.sort(key=lambda strkey:int(strkey)) - - # in new(?) version of PySCF, there is an extra layer of groups before the datasets - # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] - # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] - j3clist = [j3c.get(i+'/0') for i in j3ckeys] - if j3clist==[None]*len(j3clist): - # if using older version, stop before last level - j3clist = [j3c.get(i) for i in j3ckeys] - - nkinvsq = 1./np.sqrt(Nk) - - # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j - # output dimensions should be reversed (nao, nao, naux, nkptpairs) - j3arr=np.array([(i.value.reshape([-1,nao,nao]) if (i.shape[1] == naosq) else makesq3(i.value,nao)) * nkinvsq for i in j3clist]) - - return j3arr - #nkpt_pairs = j3arr.shape[0] - #df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) - - #if print_ao_ints_df: - # with open('D.qp','w') as outfile: - # pass - # with open('D.qp','a') as outfile: - # for k,kpt_pair in enumerate(j3arr): - # for iaux,dfbasfunc in enumerate(kpt_pair): - # for i,i0 in enumerate(dfbasfunc): - # for j,v in enumerate(i0): - # if (abs(v) > bielec_int_threshold): - # outfile.write(stri4z(i+1,j+1,iaux+1,k+1,v.real,v.imag)+'\n') - # df_ao_tmp[i,j,iaux,k]=v - - - - - -#def testpyscf2QP(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8): -# ''' -# kpts = List of kpoints coordinates. Cannot be null, for gamma is other script -# kmesh = Mesh of kpoints (optional) -# cas_idx = List of active MOs. If not specified all MOs are actives -# int_threshold = The integral will be not printed in they are bellow that -# ''' -# -# from pyscf.pbc import ao2mo -# from pyscf.pbc import tools -# from pyscf.pbc.gto import ecp -# -# mo_coef_threshold = int_threshold -# ovlp_threshold = int_threshold -# kin_threshold = int_threshold -# ne_threshold = int_threshold -# bielec_int_threshold = int_threshold -# -# natom = len(cell.atom_coords()) -# print('n_atom per kpt', natom) -# print('num_elec per kpt', cell.nelectron) -# -# mo_coeff = mf.mo_coeff -# # Mo_coeff actif -# mo_k = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) -# e_k = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) -# -# Nk, nao, nmo = mo_k.shape -# print("n Kpts", Nk) -# print("n active Mos per kpt", nmo) -# print("n AOs per kpt", nao) -# -# naux = mf.with_df.get_naoaux() -# print("n df fitting functions", naux) -# -# # _ -# # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ -# # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | -# # | -# -# #Total energy shift due to Ewald probe charge = -1/2 * Nelec*madelung/cell.vol = -# shift = tools.pbc.madelung(cell, kpts)*cell.nelectron * -.5 -# e_nuc = (cell.energy_nuc() + shift)*Nk -# -# print('nucl_repul', e_nuc) -# -# -# # ___ -# # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ -# # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) -# # _| -# -# if mf.cell.pseudo: -# v_kpts_ao = np.reshape(mf.with_df.get_pp(kpts=kpts),(Nk,nao,nao)) -# else: -# v_kpts_ao = np.reshape(mf.with_df.get_nuc(kpts=kpts),(Nk,nao,nao)) -# if len(cell._ecpbas) > 0: -# v_kpts_ao += np.reshape(ecp.ecp_int(cell, kpts),(Nk,nao,nao)) -# -# ne_ao = ('ne',v_kpts_ao,ne_threshold) -# ovlp_ao = ('overlap',np.reshape(mf.get_ovlp(cell=cell,kpts=kpts),(Nk,nao,nao)),ovlp_threshold) -# kin_ao = ('kinetic',np.reshape(cell.pbc_intor('int1e_kin',1,1,kpts=kpts),(Nk,nao,nao)),kin_threshold) -# -# -# # ___ _ -# # | ._ _|_ _ _ ._ _. | _ |_) o -# # _|_ | | |_ (/_ (_| | (_| | _> |_) | -# # _| -# # -# kconserv = tools.get_kconserv(cell, kpts) -# -# -# import h5py -# -# intfile=h5py.File(mf.with_df._cderi,'r') -# -# j3c = intfile.get('j3c') -# naosq = nao*nao -# naotri = (nao*(nao+1))//2 -# j3keys = list(j3c.keys()) -# j3keys.sort(key=lambda x:int(x)) -# j3clist = [j3c.get(i) for i in j3keys] -# nkinvsq = 1./np.sqrt(Nk) -# -# # dimensions are (kikj,iaux,jao,kao), where kikj is compound index of kpts i and j -# # output dimensions should be reversed (nao, nao, naux, nkptpairs) -# j3arr=np.array([(pad(i.value.reshape([-1,nao,nao]),[naux,nao,nao]) if (i.shape[1] == naosq) else makesq(i.value,naux,nao)) * nkinvsq for i in j3clist]) -# -# nkpt_pairs = j3arr.shape[0] -# -# kpair_list=[] -# for i in range(Nk): -# for j in range(Nk): -# if(i>=j): -# kpair_list.append((i,j,idx2_tri((i,j)))) -# j3mo = np.array([np.einsum('mij,ik,jl->mkl',j3arr[kij,:,:,:],mo_k[ki,:,:].conj(),mo_k[kj,:,:]) for ki,kj,kij in kpair_list]) -# -# -# -# eri_mo = np.zeros(4*[nmo*Nk],dtype=np.complex128) -# eri_ao = np.zeros(4*[nao*Nk],dtype=np.complex128) -# -# for d, kd in enumerate(kpts): -# for c, kc in enumerate(kpts): -# for b, kb in enumerate(kpts): -# a = kconserv[b,c,d] -# ka = kpts[a] -# eri_4d_ao_kpt = mf.with_df.get_ao_eri(kpts=[ka,kb,kc,kd],compact=False).reshape((nao,)*4) -# eri_4d_ao_kpt *= 1./Nk -# for l in range(nao): -# ll=l+d*nao -# for j in range(nao): -# jj=j+c*nao -# for k in range(nao): -# kk=k+b*nao -# for i in range(nao): -# ii=i+a*nao -# v=eri_4d_ao_kpt[i,k,j,l] -# eri_ao[ii,kk,jj,ll]=v -# -# eri_4d_mo_kpt = mf.with_df.ao2mo([mo_k[a], mo_k[b], mo_k[c], mo_k[d]], -# [ka,kb,kc,kd],compact=False).reshape((nmo,)*4) -# eri_4d_mo_kpt *= 1./Nk -# for l in range(nmo): -# ll=l+d*nmo -# for j in range(nmo): -# jj=j+c*nmo -# for k in range(nmo): -# kk=k+b*nmo -# for i in range(nmo): -# ii=i+a*nmo -# v=eri_4d_mo_kpt[i,k,j,l] -# eri_mo[ii,kk,jj,ll]=v -# -# return (mo_k,j3arr,j3mo,eri_ao,eri_mo,kpair_list) - - + return From 01360efd8474c894a182fb8fe222a9c31141ce57 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 11 Mar 2020 17:44:47 -0500 Subject: [PATCH 139/256] working on converter hdf5 outputs c-contiguous numpy arrays ezfio assumes arrays are fortran-ordered np.view can be used to get re,im parts as floats with doubling of one dimension (last for c-contiguous, possibly first for f-contiguous?) working on changing the converter to minimize transposing, reshaping, taking re/im parts, stacking, etc. --- src/utils_complex/MolPyscfToQPkpts.py | 95 +++++++++++++++++++-------- 1 file changed, 68 insertions(+), 27 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 6f835a99..f3119300 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -434,6 +434,8 @@ def get_j3ao(fname,nao,Nk): ''' returns padded df AO array fills in zeros when functions are dropped due to linear dependency + last AO index corresponds to smallest kpt index? + (k, mu, i, j) where i.kpt >= j.kpt ''' import h5py with h5py.File(fname,'r') as intfile: @@ -461,8 +463,48 @@ def get_j3ao(fname,nao,Nk): iaux,dim2 = j3c[kpair+keysub].shape if (dim2==naosq): j3arr[i,:iaux,:,:] = j3c[kpair+keysub][()].reshape([iaux,nao,nao]) * nkinvsq + #j3arr[i,:iaux,:,:] = j3c[kpair+keysub][()].reshape([iaux,nao,nao]).transpose((0,2,1)) * nkinvsq else: j3arr[i,:iaux,:,:] = makesq3(j3c[kpair+keysub][()],nao) * nkinvsq + #j3arr[i,:iaux,:,:] = makesq3(j3c[kpair+keysub][()].conj(),nao) * nkinvsq + + return j3arr + +def get_j3ao_new(fname,nao,Nk): + ''' + returns padded df AO array + fills in zeros when functions are dropped due to linear dependency + last AO index corresponds to largest kpt index? + (k, mu, j, i) where i.kpt >= j.kpt + ''' + import h5py + with h5py.File(fname,'r') as intfile: + j3c = intfile.get('j3c') + j3ckeys = list(j3c.keys()) + nkpairs = len(j3ckeys) + + # get num order instead of lex order + j3ckeys.sort(key=lambda strkey:int(strkey)) + + # in new(?) version of PySCF, there is an extra layer of groups before the datasets + # datasets used to be [/j3c/0, /j3c/1, /j3c/2, ...] + # datasets now are [/j3c/0/0, /j3c/1/0, /j3c/2/0, ...] + keysub = '/0' if bool(j3c.get('0/0',getclass=True)) else '' + + naux = max(map(lambda k: j3c[k+keysub].shape[0],j3c.keys())) + + naosq = nao*nao + naotri = (nao*(nao+1))//2 + nkinvsq = 1./np.sqrt(Nk) + + j3arr = np.zeros((nkpairs,naux,nao,nao),dtype=np.complex128) + + for i,kpair in enumerate(j3ckeys): + iaux,dim2 = j3c[kpair+keysub].shape + if (dim2==naosq): + j3arr[i,:iaux,:,:] = j3c[kpair+keysub][()].reshape([iaux,nao,nao]).transpose((0,2,1)) * nkinvsq + else: + j3arr[i,:iaux,:,:] = makesq3(j3c[kpair+keysub][()].conj(),nao) * nkinvsq return j3arr @@ -494,6 +536,16 @@ def df_ao_to_mo(j3ao,mo_coef): np.einsum('mij,ik,jl->mkl',j3ao[kij],mo_coef[ki].conj(),mo_coef[kj]) for ki,kj,kij in kpair_list]) + +def df_ao_to_mo_new(j3ao,mo_coef): + #TODO: fix this (C/F ordering, conj, transpose, view cmplx->float) + + from itertools import product + Nk = mo_coef.shape[0] + return np.array([ + np.einsum('mji,ik,jl->mlk',j3ao[idx2_tri((ki,kj))],mo_coef[ki].conj(),mo_coef[kj]) + for ki,kj in product(range(Nk),repeat=2) if (ki>=kj)]) + def df_ao_to_mo_test(j3ao,mo_coef): from itertools import product Nk = mo_coef.shape[0] @@ -627,13 +679,17 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # MO Coef # # # ########################################## - - mo_coef_blocked=block_diag(*mo_k) + with h5py.File(qph5path,'a') as qph5: + mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c') + mo_coef_blocked=block_diag(*mo_k) + mo_coef_blocked_f = block_diag(*mo_coef_f) qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + qph5.create_dataset('mo_basis/mo_coef',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) + qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) @@ -714,12 +770,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3arr = get_j3ao(mf.with_df._cderi,nao,Nk) - # test? should be (Nk*(Nk+1))//2 - nkpt_pairs = j3arr.shape[0] + # test? nkpt_pairs should be (Nk*(Nk+1))//2 + nkpt_pairs, naux, _, _ = j3arr.shape - # mf.with_df.get_naoaux() gives correct naux if no linear dependency in auxbasis - # this should work even with linear dependency - naux = max(i.shape[0] for i in j3arr) print("n df fitting functions", naux) with h5py.File(qph5path,'a') as qph5: qph5.create_group('ao_two_e_ints') @@ -727,36 +780,24 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if print_ao_ints_df: print_df(j3arr,'D.qp',bielec_int_threshold) + j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) - df_ao_tmp = np.zeros((nao,nao,naux,nkpt_pairs),dtype=np.complex128) - for i,di in enumerate(j3arr): - df_ao_tmp[:,:,:di.shape[0],i] = np.transpose(di,(1,2,0)) - - #df_ao_old = df_pad_ref_test(j3arr,nao,naux,nkpt_pairs) - #assert(abs(df_ao_tmp - df_ao_old).max() <= 1e-12) - with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=df_ao_tmp.real) - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=df_ao_tmp.imag) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=j3arr.transpose((2,3,1,0)).imag) + qph5.create_dataset('ao_two_e_ints/df_ao_integrals',data=j3ao_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nao,nao,2))) if print_mo_ints_df: j3mo = df_ao_to_mo(j3arr,mo_k) - #j3mo_test = df_ao_to_mo_test(j3arr,mo_k) - #assert(all([abs(i-j).max() <= 1e-12 for (i,j) in zip(j3mo,j3mo_test)])) + j3mo_new = df_ao_to_mo_new(j3ao_new,mo_k) print_df(j3mo,'D.mo.qp',bielec_int_threshold) - df_mo_tmp = np.zeros((nmo,nmo,naux,nkpt_pairs),dtype=np.complex128) - for i,di in enumerate(j3mo): - df_mo_tmp[:,:,:di.shape[0],i] = np.transpose(di,(1,2,0)) - - #df_mo_old = df_pad_ref_test(j3mo,nmo,naux,nkpt_pairs) - #assert(abs(df_mo_tmp - df_mo_old).max() <= 1e-12) - with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=df_mo_tmp.real) - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=df_mo_tmp.imag) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=j3mo.transpose((2,3,1,0)).real) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=j3mo.transpose((2,3,1,0)).imag) + qph5.create_dataset('mo_two_e_ints/df_mo_integrals',data=j3mo_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nmo,nmo,2))) if (print_ao_ints_bi): print_ao_bi(mf,kconserv,'W.qp',bielec_int_threshold) From 120e421239646a2201f999b78b2724b4244a7c5d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 16:06:31 -0500 Subject: [PATCH 140/256] updated converter --- .../Gen_Ezfio_from_integral_complex_3idx.sh | 1 - src/utils_complex/MolPyscfToQPkpts.py | 43 +++-- .../create_ezfio_complex_3idx.py | 175 ++++++++++-------- src/utils_complex/dump_ao_1e_cplx.irp.f | 10 + 4 files changed, 132 insertions(+), 97 deletions(-) diff --git a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh index 9bce8816..94895f18 100755 --- a/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh +++ b/src/utils_complex/Gen_Ezfio_from_integral_complex_3idx.sh @@ -17,7 +17,6 @@ echo 'Create EZFIO' qp_edit -c $ezfio &> /dev/null #cp $ezfio/{ao,mo}_basis/ao_md5 -qp_run import_kconserv $ezfio #qp_run import_ao_2e_complex $ezfio #qp_run dump_ao_2e_from_df $ezfio #Read the integral diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index f3119300..a9afbc27 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -681,6 +681,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ########################################## with h5py.File(qph5path,'a') as qph5: + # k,mo,ao(,2) mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c') mo_coef_blocked=block_diag(*mo_k) mo_coef_blocked_f = block_diag(*mo_coef_f) @@ -688,8 +689,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) - qph5.create_dataset('mo_basis/mo_coef',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) - qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) + qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) + qph5.create_dataset('mo_basis/mo_coef_complex_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) @@ -704,11 +705,20 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ovlp_ao = get_ovlp_ao(mf) if print_ao_ints_mono: - kin_ao_blocked=block_diag(*kin_ao) - ovlp_ao_blocked=block_diag(*ovlp_ao) - ne_ao_blocked=block_diag(*ne_ao) with h5py.File(qph5path,'a') as qph5: + kin_ao_blocked=block_diag(*kin_ao) + ovlp_ao_blocked=block_diag(*ovlp_ao) + ne_ao_blocked=block_diag(*ne_ao) + + kin_ao_f = np.array(kin_ao.transpose((0,2,1)),order='c') + ovlp_ao_f = np.array(ovlp_ao.transpose((0,2,1)),order='c') + ne_ao_f = np.array(ne_ao.transpose((0,2,1)),order='c') + + kin_ao_blocked_f = block_diag(*kin_ao_f) + ovlp_ao_blocked_f = block_diag(*ovlp_ao_f) + ne_ao_blocked_f = block_diag(*ne_ao_f) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) @@ -716,6 +726,10 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic',data=kin_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap',data=ovlp_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=ne_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + for fname,ints in zip(('S.qp','V.qp','T.qp'), (ovlp_ao, ne_ao, kin_ao)): print_kpts_unblocked_upper(ints,fname,thresh_mono) @@ -750,15 +764,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, kconserv = tools.get_kconserv(cell, kpts) with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('nuclei/kconserv',data=np.transpose(kconserv+1,(0,2,1))) - - kcon_test = np.zeros((Nk,Nk,Nk),dtype=int) - for a in range(Nk): - for b in range(Nk): - for c in range(Nk): - kcon_test[a,c,b] = kconserv[a,b,c]+1 - with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('nuclei/kconserv_test',data=kcon_test) + kcon_f_phys = np.array(kconserv.transpose((1,2,0)),order='c') + qph5.create_dataset('nuclei/kconserv',data=kcon_f_phys+1) print_kcon_chem_to_phys(kconserv,'K.qp') @@ -783,8 +790,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) - qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=j3arr.transpose((2,3,1,0)).imag) + #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) + #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=j3arr.transpose((2,3,1,0)).imag) qph5.create_dataset('ao_two_e_ints/df_ao_integrals',data=j3ao_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nao,nao,2))) if print_mo_ints_df: @@ -795,8 +802,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, print_df(j3mo,'D.mo.qp',bielec_int_threshold) with h5py.File(qph5path,'a') as qph5: - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=j3mo.transpose((2,3,1,0)).real) - qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=j3mo.transpose((2,3,1,0)).imag) + #qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=j3mo.transpose((2,3,1,0)).real) + #qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=j3mo.transpose((2,3,1,0)).imag) qph5.create_dataset('mo_two_e_ints/df_mo_integrals',data=j3mo_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nmo,nmo,2))) if (print_ao_ints_bi): diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index a1a2cca9..34d2c801 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -5,33 +5,37 @@ import h5py import sys import numpy as np filename = sys.argv[1] -h5filename = sys.argv[2] -#num_elec, nucl_num, mo_num = map(int,sys.argv[2:5]) +qph5path = sys.argv[2] -#nuclear_repulsion = float(sys.argv[5]) -#ao_num = int(sys.argv[6]) -#n_kpts = int(sys.argv[7]) -#n_aux = int(sys.argv[8]) ezfio.set_file(filename) -qph5=h5py.File(h5filename,'r') +#qph5=h5py.File(qph5path,'r') -kpt_num = qph5['nuclei'].attrs['kpt_num'] +ezfio.set_nuclei_is_complex(True) + +with h5py.File(qph5path,'r') as qph5: + kpt_num = qph5['nuclei'].attrs['kpt_num'] + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + ezfio.set_nuclei_kpt_num(kpt_num) kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) +# don't multiply nuclei by kpt_num +# work in k-space, not in equivalent supercell +nucl_num_per_kpt = nucl_num +ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) # these are totals (kpt_num * num_per_kpt) # need to change if we want to truncate orbital space within pyscf -ezfio.electrons_elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] -ezfio.electrons_elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] -nucl_num = qph5['nuclei'].attrs['nucl_num'] -nucl_num_per_kpt = nucl_num // kpt_num -ao_num = qph5['ao_basis'].attrs['ao_num'] -mo_num = qph5['mo_basis'].attrs['mo_num'] - +ezfio.set_ao_basis_ao_num(ao_num) ezfio.set_mo_basis_mo_num(mo_num) +ezfio.electrons_elec_alpha_num = elec_alpha_num +ezfio.electrons_elec_beta_num = elec_beta_num @@ -57,30 +61,30 @@ ezfio.set_mo_basis_mo_num(mo_num) #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) -ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) -nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() +with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + ezfio.set_nuclei_nucl_charge(nucl_charge) - -nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() ezfio.set_nuclei_nucl_coord(nucl_coord) - -nucl_label=qph5['nuclei/nucl_label'][()].tolist() ezfio.set_nuclei_nucl_label(nucl_label) - ezfio.set_nuclei_io_nuclear_repulsion('Read') -nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) -# Ao num -#ao_num = mo_num -#ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") -ezfio.set_ao_basis_ao_num(ao_num) -#ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff -ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) -ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) +########################################## +# # +# Basis # +# # +########################################## + +with h5py.File(qph5path,'r') as qph5: + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) #Just need one (can clean this up later) @@ -94,67 +98,82 @@ ezfio.set_ao_basis_ao_expo(d) -ezfio.set_mo_basis_mo_num(mo_num) -#c_mo = [[1 if i==j else 0 for i in range(mo_num)] for j in range(ao_num)] -#ezfio.set_mo_basis_mo_coef([ [0]*mo_num] * ao_num) -##ezfio.set_mo_basis_mo_coef_real(c_mo) - -mo_coef_re0 = qph5['mo_basis/mo_coef_real'][()].T -mo_coef_im0 = qph5['mo_basis/mo_coef_imag'][()].T -mo_coef_cmplx0 = np.stack((mo_coef_re0,mo_coef_im0),axis=-1).tolist() - -#ezfio.set_mo_basis_mo_coef_real(qph5['mo_basis/mo_coef_real'][()].tolist()) -#ezfio.set_mo_basis_mo_coef_imag(qph5['mo_basis/mo_coef_imag'][()].tolist()) -ezfio.set_mo_basis_mo_coef_complex(mo_coef_cmplx0) + +########################################## +# # +# MO Coef # +# # +########################################## + +with h5py.File(qph5path,'r') as qph5: + mo_coef_reim = qph5['mo_basis/mo_coef_complex'][()].tolist() +ezfio.set_mo_basis_mo_coef_complex(mo_coef_reim) #maybe fix qp so we don't need this? #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) -ezfio.set_nuclei_is_complex(True) -# fortran-ordered re,im parts -kin_ao_re0=qph5['ao_one_e_ints/ao_integrals_kinetic_real'][()].T -kin_ao_im0=qph5['ao_one_e_ints/ao_integrals_kinetic_imag'][()].T -#test where to stack? (axis=0 or -1?) -kin_ao_cmplx0=np.stack((kin_ao_re0,kin_ao_im0),axis=-1).tolist() +########################################## +# # +# Integrals Mono # +# # +########################################## + +with h5py.File(qph5path,'r') as qph5: + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() -ovlp_ao_re0=qph5['ao_one_e_ints/ao_integrals_overlap_real'][()].T -ovlp_ao_im0=qph5['ao_one_e_ints/ao_integrals_overlap_imag'][()].T -#test where to stack? (axis=0 or -1?) -ovlp_ao_cmplx0=np.stack((ovlp_ao_re0,ovlp_ao_im0),axis=-1).tolist() - -ne_ao_re0=qph5['ao_one_e_ints/ao_integrals_n_e_real'][()].T -ne_ao_im0=qph5['ao_one_e_ints/ao_integrals_n_e_imag'][()].T -#test where to stack? (axis=0 or -1?) -ne_ao_cmplx0=np.stack((ne_ao_re0,ne_ao_im0),axis=-1).tolist() - -ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_cmplx0) -ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_cmplx0) -ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_cmplx0) +ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) +ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) +ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + +########################################## +# # +# k-points # +# # +########################################## + +with h5py.File(qph5path,'r') as qph5: + kconserv = qph5['nuclei/kconserv'][()].tolist() + +ezfio.set_nuclei_kconserv(kconserv) +ezfio.set_nuclei_io_kconserv('Read') + +########################################## +# # +# Integrals Bi # +# # +########################################## # should this be in ao_basis? ao_two_e_ints? -if 'ao_two_e_ints' in qph5.keys(): - df_num = qph5['ao_two_e_ints'].attrs['df_num'] - ezfio.set_ao_two_e_ints_df_num(df_num) - if 'df_ao_integrals_real' in qph5['ao_two_e_ints'].keys(): - dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) - dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) - dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() - ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) - ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') +with h5py.File(qph5path,'r') as qph5: + if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): +# dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) +# dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) +# dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() +# ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') -if 'mo_two_e_ints' in qph5.keys(): - df_num = qph5['ao_two_e_ints'].attrs['df_num'] - ezfio.set_ao_two_e_ints_df_num(df_num) - dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) - dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) - dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() - ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) - ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') + if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) +# dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) +# dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) +# dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() +# ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') #TODO: add check and only do this if ints exist diff --git a/src/utils_complex/dump_ao_1e_cplx.irp.f b/src/utils_complex/dump_ao_1e_cplx.irp.f index f49b2529..de5a48ee 100644 --- a/src/utils_complex/dump_ao_1e_cplx.irp.f +++ b/src/utils_complex/dump_ao_1e_cplx.irp.f @@ -13,6 +13,16 @@ subroutine run do i=1,ao_num write(*,'(200(E24.15))') ao_one_e_integrals_complex(i,:) enddo + write(*,'(A)') 'ao_kinetic_integrals_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_kinetic_integrals_complex(i,:) + enddo + write(*,'(A)') 'ao_ne_integrals_complex' + write(*,'(A)') '---------------' + do i=1,ao_num + write(*,'(200(E24.15))') ao_integrals_n_e_complex(i,:) + enddo write(*,'(A)') 'ao_overlap_complex' write(*,'(A)') '---------------' do i=1,ao_num From 7be57b7a14918f333f73a535bf7eff27a84bf958 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 16:07:28 -0500 Subject: [PATCH 141/256] read complex orbitals --- src/hartree_fock/scf.irp.f | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 276b4e65..2b93a1df 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -45,7 +45,11 @@ subroutine create_guess END_DOC logical :: exists PROVIDE ezfio_filename - call ezfio_has_mo_basis_mo_coef(exists) + if (is_complex) then + call ezfio_has_mo_basis_mo_coef_complex(exists) + else + call ezfio_has_mo_basis_mo_coef(exists) + endif if (.not.exists) then if (mo_guess_type == "HCore") then if (is_complex) then From d44a22f3d8167bc807c34794e11e8f6493b89d50 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 16:09:00 -0500 Subject: [PATCH 142/256] fix bitmask for kpoint ordered MOs --- src/bitmask/bitmasks.irp.f | 32 ++++++++++++-- src/scf_utils/fock_matrix_cplx.irp.f | 2 +- .../scf_density_matrix_ao_cplx.irp.f | 42 +++++++++++++++++-- 3 files changed, 67 insertions(+), 9 deletions(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index 91617397..e86d747d 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -78,14 +78,38 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)] END_DOC integer :: i,j,n integer :: occ(elec_alpha_num) + integer :: occb(elec_beta_num) HF_bitmask = 0_bit_kind - do i=1,elec_alpha_num - occ(i) = i - enddo + if (is_complex) then + integer :: kpt,korb + kpt=1 + korb=1 + do i=1,elec_beta_num + occ(i) = korb + (kpt-1) * ao_num_per_kpt + occb(i) = korb + (kpt-1) * ao_num_per_kpt + kpt += 1 + if (kpt > kpt_num) then + kpt = 1 + korb += 1 + endif + enddo + do i=elec_beta_num+1,elec_alpha_num + occ(i) = korb + (kpt-1) * ao_num_per_kpt + kpt += 1 + if (kpt > kpt_num) then + kpt = 1 + korb += 1 + endif + enddo + else + do i=1,elec_alpha_num + occ(i) = i + enddo + endif call list_to_bitstring( HF_bitmask(1,1), occ, elec_alpha_num, N_int) ! elec_alpha_num <= elec_beta_num, so occ is already OK. - call list_to_bitstring( HF_bitmask(1,2), occ, elec_beta_num, N_int) + call list_to_bitstring( HF_bitmask(1,2), occb, elec_beta_num, N_int) END_PROVIDER diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index 577fe5c2..61d23467 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -80,7 +80,7 @@ if (dabs(dimag(Fock_matrix_mo_complex(i,i))) .gt. 1.0d-12) then !stop 'diagonal elements of Fock matrix should be real' print *, 'diagonal elements of Fock matrix should be real',i,Fock_matrix_mo_complex(i,i) - stop -1 + !stop -1 endif enddo diff --git a/src/scf_utils/scf_density_matrix_ao_cplx.irp.f b/src/scf_utils/scf_density_matrix_ao_cplx.irp.f index 6e22e209..a6a66863 100644 --- a/src/scf_utils/scf_density_matrix_ao_cplx.irp.f +++ b/src/scf_utils/scf_density_matrix_ao_cplx.irp.f @@ -3,12 +3,29 @@ BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_alpha_complex, (ao_num,ao_num BEGIN_DOC ! $C.C^t$ over $\alpha$ MOs END_DOC + + complex*16, allocatable :: mo_coef_alpha_tmp(:,:) + integer :: occ(N_int*bit_kind_size) + integer :: na, i + + call bitstring_to_list(hf_bitmask(1,1), occ, na, n_int) + allocate(mo_coef_alpha_tmp(ao_num,na)) + do i=1,na + mo_coef_alpha_tmp(:,i) = mo_coef_complex(:,occ(i)) + enddo + call zgemm('N','C',ao_num,ao_num,elec_alpha_num,(1.d0,0.d0), & - mo_coef_complex, size(mo_coef_complex,1), & - mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + mo_coef_alpha_tmp, size(mo_coef_alpha_tmp,1), & + mo_coef_alpha_tmp, size(mo_coef_alpha_tmp,1), (0.d0,0.d0), & scf_density_matrix_ao_alpha_complex, size(scf_density_matrix_ao_alpha_complex,1)) + deallocate(mo_coef_alpha_tmp) + !call zgemm('N','C',ao_num,ao_num,elec_alpha_num,(1.d0,0.d0), & + ! mo_coef_complex, size(mo_coef_complex,1), & + ! mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + ! scf_density_matrix_ao_alpha_complex, size(scf_density_matrix_ao_alpha_complex,1)) + END_PROVIDER BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_beta_complex, (ao_num,ao_num) ] @@ -17,11 +34,28 @@ BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_beta_complex, (ao_num,ao_num ! $C.C^t$ over $\beta$ MOs END_DOC + complex*16, allocatable :: mo_coef_beta_tmp(:,:) + integer :: occ(N_int*bit_kind_size) + integer :: nb, i + + call bitstring_to_list(hf_bitmask(1,2), occ, nb, n_int) + allocate(mo_coef_beta_tmp(ao_num,nb)) + do i=1,nb + mo_coef_beta_tmp(:,i) = mo_coef_complex(:,occ(i)) + enddo + + call zgemm('N','C',ao_num,ao_num,elec_beta_num,(1.d0,0.d0), & - mo_coef_complex, size(mo_coef_complex,1), & - mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + mo_coef_beta_tmp, size(mo_coef_beta_tmp,1), & + mo_coef_beta_tmp, size(mo_coef_beta_tmp,1), (0.d0,0.d0), & scf_density_matrix_ao_beta_complex, size(scf_density_matrix_ao_beta_complex,1)) + deallocate(mo_coef_beta_tmp) + !call zgemm('N','C',ao_num,ao_num,elec_beta_num,(1.d0,0.d0), & + ! mo_coef_complex, size(mo_coef_complex,1), & + ! mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), & + ! scf_density_matrix_ao_beta_complex, size(scf_density_matrix_ao_beta_complex,1)) + END_PROVIDER BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_complex, (ao_num,ao_num) ] From 82b6bccc37c08b400ea87e04676c0baff40b950c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:02:03 -0500 Subject: [PATCH 143/256] printing --- src/mo_one_e_ints/kin_mo_ints_cplx.irp.f | 2 ++ src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f | 3 ++- src/mo_one_e_ints/pot_mo_ints_cplx.irp.f | 4 +++- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f b/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f index f8c790b8..511ccc78 100644 --- a/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f @@ -5,10 +5,12 @@ BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] END_DOC integer :: i,j + print *, 'Providing MO kinetic integrals' if (read_mo_integrals_kinetic) then call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_complex(mo_kinetic_integrals_complex) print *, 'MO kinetic integrals read from disk' else + print *, 'Providing MO kinetic integrals from AO kinetic integrals' call ao_to_mo_complex( & ao_kinetic_integrals_complex, & size(ao_kinetic_integrals_complex,1), & diff --git a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f index de1fbb36..d4546af7 100644 --- a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] ELSE mo_one_e_integrals_complex = mo_integrals_n_e_complex + mo_kinetic_integrals_complex - IF (DO_PSEUDO) THEN + IF (do_pseudo) THEN mo_one_e_integrals_complex += mo_pseudo_integrals_complex ENDIF @@ -22,6 +22,7 @@ BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] call ezfio_set_mo_one_e_ints_mo_one_e_integrals_complex(mo_one_e_integrals_complex) print *, 'MO one-e integrals written to disk' ENDIF + print*,'Provided the one-electron integrals' END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f index b1972b11..8f9c1660 100644 --- a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f @@ -4,11 +4,13 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] ! Kinetic energy integrals in the MO basis END_DOC integer :: i,j - + + print *, 'Providing MO N-e integrals' if (read_mo_integrals_e_n) then call ezfio_get_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex) print *, 'MO N-e integrals read from disk' else + print *, 'Providing MO N-e integrals from AO N-e integrals' call ao_to_mo_complex( & ao_integrals_n_e_complex, & size(ao_integrals_n_e_complex,1), & From a3195ae08a178c3d08e803db7960d87407c2ed42 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:02:18 -0500 Subject: [PATCH 144/256] complex mo swap --- src/tools/swap_mos.irp.f | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/tools/swap_mos.irp.f b/src/tools/swap_mos.irp.f index bba9cb34..44b9cc50 100644 --- a/src/tools/swap_mos.irp.f +++ b/src/tools/swap_mos.irp.f @@ -7,11 +7,20 @@ program swap_mos double precision :: x print *, 'MOs to swap?' read(*,*) i1, i2 - do i=1,ao_num - x = mo_coef(i,i1) - mo_coef(i,i1) = mo_coef(i,i2) - mo_coef(i,i2) = x - enddo + if (is_complex) then + complex*16 :: xc + do i=1,ao_num + xc = mo_coef_complex(i,i1) + mo_coef_complex(i,i1) = mo_coef_complex(i,i2) + mo_coef_complex(i,i2) = xc + enddo + else + do i=1,ao_num + x = mo_coef(i,i1) + mo_coef(i,i1) = mo_coef(i,i2) + mo_coef(i,i2) = x + enddo + endif call save_mos end From 508fb9526dd1390c351b79dd77757e40c42d5d6f Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:02:54 -0500 Subject: [PATCH 145/256] cleanup kpt bitmask --- src/bitmask/bitmasks.irp.f | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index e86d747d..469b27b0 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -78,23 +78,14 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)] END_DOC integer :: i,j,n integer :: occ(elec_alpha_num) - integer :: occb(elec_beta_num) HF_bitmask = 0_bit_kind - if (is_complex) then + !if (is_complex) then + if (.False.) then integer :: kpt,korb kpt=1 korb=1 - do i=1,elec_beta_num - occ(i) = korb + (kpt-1) * ao_num_per_kpt - occb(i) = korb + (kpt-1) * ao_num_per_kpt - kpt += 1 - if (kpt > kpt_num) then - kpt = 1 - korb += 1 - endif - enddo - do i=elec_beta_num+1,elec_alpha_num + do i=1,elec_alpha_num occ(i) = korb + (kpt-1) * ao_num_per_kpt kpt += 1 if (kpt > kpt_num) then @@ -109,7 +100,7 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)] endif call list_to_bitstring( HF_bitmask(1,1), occ, elec_alpha_num, N_int) ! elec_alpha_num <= elec_beta_num, so occ is already OK. - call list_to_bitstring( HF_bitmask(1,2), occb, elec_beta_num, N_int) + call list_to_bitstring( HF_bitmask(1,2), occ, elec_beta_num, N_int) END_PROVIDER From 25181963f86dcee0cd89f8b6bcf59bf400f53949 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:05:36 -0500 Subject: [PATCH 146/256] fixed range error --- src/mo_two_e_ints/map_integrals_cplx.irp.f | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/mo_two_e_ints/map_integrals_cplx.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f index 2156e103..1356f128 100644 --- a/src/mo_two_e_ints/map_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/map_integrals_cplx.irp.f @@ -437,8 +437,10 @@ subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) call map_get_many(map2, hash_im(1:klmin-1), out_im(1:klmin-1), klmin-1) call map_get_many(map, hash_re(klmin:klmax), out_re(klmin:klmax), klmax-klmin+1) call map_get_many(map, hash_im(klmin:klmax), out_im(klmin:klmax), klmax-klmin+1) - call map_get_many(map2, hash_re(klmax+1:sze), out_re(klmax+1:sze), sze-klmax) - call map_get_many(map2, hash_im(klmax+1:sze), out_im(klmax+1:sze), sze-klmax) + if (klmax.lt.size) then + call map_get_many(map2, hash_re(klmax+1:sze), out_re(klmax+1:sze), sze-klmax) + call map_get_many(map2, hash_im(klmax+1:sze), out_im(klmax+1:sze), sze-klmax) + endif do i=1,sze out_val(i) = dcmplx(out_re(i),sign*sign2(i)*out_im(i)) enddo @@ -447,8 +449,10 @@ subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) call map_get_many(map2, hash_im(1:klmin-1), tmp_im(1:klmin-1), klmin-1) call map_get_many(map, hash_re(klmin:klmax), tmp_re(klmin:klmax), klmax-klmin+1) call map_get_many(map, hash_im(klmin:klmax), tmp_im(klmin:klmax), klmax-klmin+1) - call map_get_many(map2, hash_re(klmax+1:sze), tmp_re(klmax+1:sze), sze-klmax) - call map_get_many(map2, hash_im(klmax+1:sze), tmp_im(klmax+1:sze), sze-klmax) + if (klmax.lt.size) then + call map_get_many(map2, hash_re(klmax+1:sze), tmp_re(klmax+1:sze), sze-klmax) + call map_get_many(map2, hash_im(klmax+1:sze), tmp_im(klmax+1:sze), sze-klmax) + endif ! Conversion to double complex do i=1,sze out_val(i) = dcmplx(tmp_re(i),sign*sign2(i)*tmp_im(i)) From d504108a3357ba5fb5c907b0db8537b482ffbe51 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:21:50 -0500 Subject: [PATCH 147/256] testing --- src/utils_complex/dump_kcon.irp.f | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 src/utils_complex/dump_kcon.irp.f diff --git a/src/utils_complex/dump_kcon.irp.f b/src/utils_complex/dump_kcon.irp.f new file mode 100644 index 00000000..9f74a0c0 --- /dev/null +++ b/src/utils_complex/dump_kcon.irp.f @@ -0,0 +1,21 @@ +program dump_kcon + call run +end + +subroutine run + use map_module + implicit none + + integer ::i,j,k,l + + provide kconserv + do i=1,kpt_num + do j=1,kpt_num + do k=1,kpt_num + l = kconserv(i,j,k) + print'(4(I4))',i,j,k,l + enddo + enddo + enddo + +end From 922eeb24c0ea0471e737e435faebcc63cdc2ff56 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 12 Mar 2020 18:22:37 -0500 Subject: [PATCH 148/256] starting kpts --- src/ao_one_e_ints/EZFIO.cfg | 30 ++++++++++++++++++++++ src/ao_one_e_ints/ao_one_e_ints.irp.f | 30 ++++++++++++++++++++++ src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f | 2 +- src/ao_one_e_ints/ao_overlap.irp.f | 28 +++++++++++++++++--- src/ao_one_e_ints/kin_ao_ints.irp.f | 21 +++++++++++++++ src/ao_one_e_ints/pot_ao_ints.irp.f | 15 +++++++++++ src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f | 18 +++++++++++++ 7 files changed, 140 insertions(+), 4 deletions(-) diff --git a/src/ao_one_e_ints/EZFIO.cfg b/src/ao_one_e_ints/EZFIO.cfg index 583c7757..a958b45b 100644 --- a/src/ao_one_e_ints/EZFIO.cfg +++ b/src/ao_one_e_ints/EZFIO.cfg @@ -10,6 +10,12 @@ doc: Complex nucleus-electron integrals in |AO| basis set size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio +[ao_integrals_n_e_kpts] +type: double precision +doc: Complex nucleus-electron integrals in |AO| basis set +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_ao_integrals_n_e] type: Disk_access doc: Read/Write |AO| nucleus-electron attraction integrals from/to disk [ Write | Read | None ] @@ -29,6 +35,12 @@ doc: Complex kinetic energy integrals in |AO| basis set size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio +[ao_integrals_kinetic_kpts] +type: double precision +doc: Complex kinetic energy integrals in |AO| basis set +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_ao_integrals_kinetic] type: Disk_access doc: Read/Write |AO| kinetic integrals from/to disk [ Write | Read | None ] @@ -48,6 +60,12 @@ doc: Complex pseudopotential integrals in |AO| basis set size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio +[ao_integrals_pseudo_kpts] +type: double precision +doc: Complex pseudopotential integrals in |AO| basis set +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_ao_integrals_pseudo] type: Disk_access doc: Read/Write |AO| pseudopotential integrals from/to disk [ Write | Read | None ] @@ -67,6 +85,12 @@ doc: Complex overlap integrals in |AO| basis set size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio +[ao_integrals_overlap_kpts] +type: double precision +doc: Complex overlap integrals in |AO| basis set +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_ao_integrals_overlap] type: Disk_access doc: Read/Write |AO| overlap integrals from/to disk [ Write | Read | None ] @@ -86,6 +110,12 @@ doc: Complex combined integrals in |AO| basis set size: (2,ao_basis.ao_num,ao_basis.ao_num) interface: ezfio +[ao_one_e_integrals_kpts] +type: double precision +doc: Complex combined integrals in |AO| basis set +size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_ao_one_e_integrals] type: Disk_access doc: Read/Write |AO| one-electron integrals from/to disk [ Write | Read | None ] diff --git a/src/ao_one_e_ints/ao_one_e_ints.irp.f b/src/ao_one_e_ints/ao_one_e_ints.irp.f index be70bf23..9e18e5de 100644 --- a/src/ao_one_e_ints/ao_one_e_ints.irp.f +++ b/src/ao_one_e_ints/ao_one_e_ints.irp.f @@ -82,3 +82,33 @@ END_PROVIDER ENDIF END_PROVIDER + BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_kpts,(ao_num_per_kpt,ao_num_per_kpt,kpt_num)] +&BEGIN_PROVIDER [ double precision, ao_one_e_integrals_diag_kpts,(ao_num_per_kpt,kpt_num)] + implicit none + integer :: j,k + BEGIN_DOC + ! One-electron Hamiltonian in the |AO| basis. + END_DOC + + if (read_ao_one_e_integrals) then + call ezfio_get_ao_one_e_ints_ao_one_e_integrals_kpts(ao_one_e_integrals_kpts) + else + ao_one_e_integrals_kpts = ao_integrals_n_e_kpts + ao_kinetic_integrals_kpts + + if (do_pseudo) then + ao_one_e_integrals_kpts += ao_pseudo_integrals_kpts + endif + endif + + do k = 1, kpt_num + do j = 1, ao_num_per_kpt + ao_one_e_integrals_diag_kpts(j,k) = dble(ao_one_e_integrals_kpts(j,j,k)) + enddo + enddo + + if (write_ao_one_e_integrals) then + call ezfio_set_ao_one_e_ints_ao_one_e_integrals_kpts(ao_one_e_integrals_kpts) + print *, 'AO one-e integrals written to disk' + endif +END_PROVIDER + diff --git a/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f index c84fe6a7..87a30d2d 100644 --- a/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f @@ -1,4 +1,4 @@ - +!todo: add kpts BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_complex, (ao_num,ao_cart_to_sphe_num) ] implicit none BEGIN_DOC diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index ad9fcff5..2e1695a7 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -104,6 +104,23 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ] endif END_PROVIDER +BEGIN_PROVIDER [ complex*16, ao_overlap_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Overlap for complex AOs + END_DOC + if (read_ao_integrals_overlap) then + call ezfio_get_ao_one_e_ints_ao_integrals_overlap_kpts(ao_overlap_kpts) + print *, 'AO overlap integrals read from disk' + else + print*,'complex AO overlap ints must be provided',irp_here + endif + if (write_ao_integrals_overlap) then + call ezfio_set_ao_one_e_ints_ao_integrals_overlap_kpts(ao_overlap_kpts) + print *, 'AO overlap integrals written to disk' + endif +END_PROVIDER + @@ -123,9 +140,14 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ] integer :: power_A(3), power_B(3) double precision :: lower_exp_val, dx if (is_complex) then - do j=1,ao_num - do i= 1,ao_num - ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j)) + ao_overlap_abs = 0.d0 + integer :: k, ishift + do k=1,kpt_num + ishift = (k-1)*ao_num_per_kpt + do j=1,ao_num_per_kpt + do i= 1,ao_num_per_kpt + ao_overlap_abs(ishift+i,ishift+j)= cdabs(ao_overlap_kpts(i,j,k)) + enddo enddo enddo else diff --git a/src/ao_one_e_ints/kin_ao_ints.irp.f b/src/ao_one_e_ints/kin_ao_ints.irp.f index f352d1c4..18f866d2 100644 --- a/src/ao_one_e_ints/kin_ao_ints.irp.f +++ b/src/ao_one_e_ints/kin_ao_ints.irp.f @@ -191,3 +191,24 @@ BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_complex, (ao_num,ao_num)] print *, 'AO kinetic integrals written to disk' endif END_PROVIDER + +BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the |AO| basis. + ! + ! $\langle \chi_i |\hat{T}| \chi_j \rangle$ + ! + END_DOC + if (read_ao_integrals_kinetic) then + call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_kpts(ao_kinetic_integrals_kpts) + print *, 'AO kinetic integrals read from disk' + else + print *, irp_here, ': Not yet implemented' + stop -1 + endif + if (write_ao_integrals_kinetic) then + call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_kpts(ao_kinetic_integrals_kpts) + print *, 'AO kinetic integrals written to disk' + endif +END_PROVIDER diff --git a/src/ao_one_e_ints/pot_ao_ints.irp.f b/src/ao_one_e_ints/pot_ao_ints.irp.f index 08c78464..59ded4fc 100644 --- a/src/ao_one_e_ints/pot_ao_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_ints.irp.f @@ -120,6 +120,21 @@ BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)] endif END_PROVIDER +BEGIN_PROVIDER [complex*16, ao_integrals_n_e_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Nucleus-electron interaction, in the |AO| basis set. + ! + ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` + END_DOC + if (read_ao_integrals_n_e) then + call ezfio_get_ao_one_e_ints_ao_integrals_n_e_kpts(ao_integrals_n_e_kpts) + print *, 'AO N-e integrals read from disk' + else + print *, irp_here, ': Not yet implemented' + endif +END_PROVIDER + BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)] BEGIN_DOC ! Nucleus-electron interaction in the |AO| basis set, per atom A. diff --git a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f index 0032b2ae..1bf44d21 100644 --- a/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_pseudo_ints.irp.f @@ -62,6 +62,24 @@ BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_complex, (ao_num, ao_num) ] endif END_PROVIDER +BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Overlap for complex AOs + END_DOC + if (read_ao_integrals_pseudo) then + call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_kpts(ao_pseudo_integrals_kpts) + print *, 'AO pseudo_integrals integrals read from disk' + else + print*,irp_here,'not implemented' + stop -1 + endif + if (write_ao_integrals_pseudo) then + call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_kpts(ao_pseudo_integrals_kpts) + print *, 'AO pseudo_integrals integrals written to disk' + endif +END_PROVIDER + BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)] implicit none BEGIN_DOC From b547d974527f49f45998fab06ebf8edbd108fe77 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 11:15:42 -0500 Subject: [PATCH 149/256] typo --- src/mo_two_e_ints/map_integrals_cplx.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mo_two_e_ints/map_integrals_cplx.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f index 1356f128..66b9e3c0 100644 --- a/src/mo_two_e_ints/map_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/map_integrals_cplx.irp.f @@ -437,7 +437,7 @@ subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) call map_get_many(map2, hash_im(1:klmin-1), out_im(1:klmin-1), klmin-1) call map_get_many(map, hash_re(klmin:klmax), out_re(klmin:klmax), klmax-klmin+1) call map_get_many(map, hash_im(klmin:klmax), out_im(klmin:klmax), klmax-klmin+1) - if (klmax.lt.size) then + if (klmax.lt.sze) then call map_get_many(map2, hash_re(klmax+1:sze), out_re(klmax+1:sze), sze-klmax) call map_get_many(map2, hash_im(klmax+1:sze), out_im(klmax+1:sze), sze-klmax) endif @@ -449,7 +449,7 @@ subroutine get_mo_two_e_integrals_exch_ii_complex(k,l,sze,out_val,map,map2) call map_get_many(map2, hash_im(1:klmin-1), tmp_im(1:klmin-1), klmin-1) call map_get_many(map, hash_re(klmin:klmax), tmp_re(klmin:klmax), klmax-klmin+1) call map_get_many(map, hash_im(klmin:klmax), tmp_im(klmin:klmax), klmax-klmin+1) - if (klmax.lt.size) then + if (klmax.lt.sze) then call map_get_many(map2, hash_re(klmax+1:sze), tmp_re(klmax+1:sze), sze-klmax) call map_get_many(map2, hash_im(klmax+1:sze), tmp_im(klmax+1:sze), sze-klmax) endif From 072067c4fa88e0a249ebc3049452afecd6c72051 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 11:16:41 -0500 Subject: [PATCH 150/256] fixed bug? --- src/davidson/u0_h_u0.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index ac98c362..6142e828 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -755,7 +755,7 @@ subroutine u_0_H_u_0_complex(e_0,s_0,u_0,n,keys_tmp,Nint,N_st,sze) do istate = 1,N_st do j=1,n do i=1,n - v_0(i,istate) = v_0(i,istate) + h_matrix_all_dets(i,j) * u_0(j,istate) + v_0(i,istate) = v_0(i,istate) + h_matrix_all_dets_complex(i,j) * u_0(j,istate) s_vec(i,istate) = s_vec(i,istate) + S2_matrix_all_dets(i,j) * u_0(j,istate) enddo enddo From 8e615f6788640c165a98588dc085feffcbb294f8 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 11:38:19 -0500 Subject: [PATCH 151/256] fixed complex/real bug --- src/determinants/slater_rules.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 29bd8b23..723f3194 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2777,7 +2777,7 @@ subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) - call get_single_excitation_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) + call get_single_excitation_from_fock_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) end subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij) From 3ebad92f76ab55169d59ff32008c3b5f873f27e0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 12:10:15 -0500 Subject: [PATCH 152/256] complex hf bitmask --- src/bitmask/bitmasks.irp.f | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index 469b27b0..03127b1c 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -80,8 +80,7 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)] integer :: occ(elec_alpha_num) HF_bitmask = 0_bit_kind - !if (is_complex) then - if (.False.) then + if (is_complex) then integer :: kpt,korb kpt=1 korb=1 From 13f685722dd50ecf047cae9d1241735b2cfcacfb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 13:17:36 -0500 Subject: [PATCH 153/256] small converter patch --- src/utils_complex/MolPyscfToQPkpts.py | 14 ++++++-- .../create_ezfio_complex_3idx.py | 36 ++++++++++++++----- 2 files changed, 39 insertions(+), 11 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index a9afbc27..55c41181 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -399,7 +399,7 @@ def get_pot_ao(mf): return v_kpts_ao def ao_to_mo_1e(ao_kpts,mo_coef): - return np.einsum('kim,kij,kjn->kmn',mo_coef.conj(),ao_kpts_ao,mo_coef) + return np.einsum('kim,kij,kjn->kmn',mo_coef.conj(),ao_kpts,mo_coef) def get_j3ao_old(fname,nao,Nk): ''' @@ -744,12 +744,22 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ne_mo_blocked=block_diag(*ne_mo) with h5py.File(qph5path,'a') as qph5: + kin_mo_f = np.array(kin_mo.transpose((0,2,1)),order='c') + ovlp_mo_f = np.array(ovlp_mo.transpose((0,2,1)),order='c') + ne_mo_f = np.array(ne_mo.transpose((0,2,1)),order='c') + + kin_mo_blocked_f = block_diag(*kin_mo_f) + ovlp_mo_blocked_f = block_diag(*ovlp_mo_f) + ne_mo_blocked_f = block_diag(*ne_mo_f) qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic',data=kin_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap',data=ovlp_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e', data=ne_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), (ovlp_mo, ne_mo, kin_mo)): print_kpts_unblocked_upper(ints,fname,thresh_mono) @@ -785,9 +795,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_group('ao_two_e_ints') qph5['ao_two_e_ints'].attrs['df_num']=naux + j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) if print_ao_ints_df: print_df(j3arr,'D.qp',bielec_int_threshold) - j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) with h5py.File(qph5path,'a') as qph5: #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 34d2c801..2947b565 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -120,17 +120,35 @@ ezfio.set_mo_basis_mo_coef_complex(mo_coef_reim) ########################################## with h5py.File(qph5path,'r') as qph5: - kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() - ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() - ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() + if 'ao_one_e_ints' in qph5.keys(): + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() -ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) -ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) -ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) + + ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + + +with h5py.File(qph5path,'r') as qph5: + if 'mo_one_e_ints' in qph5.keys(): + kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic'][()].tolist() + #ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() + ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e'][()].tolist() -ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') -ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') -ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_mo_integrals_kinetic_complex(kin_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_overlap_complex(ovlp_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_e_n_complex(ne_mo_reim) + + ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') ########################################## # # From 38337eb0dc50cd38ba0d0e17c7f158314cdfb8fe Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 13:22:33 -0500 Subject: [PATCH 154/256] notes --- src/utils_complex/qp2-pbc-diff.txt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index ac0769fa..7cadd3c4 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,6 +1,10 @@ + +todo: +change everything to be blocked by kpt + ------------------------------------------------------------------------------------- -current: +old: select_connected select_singles_and_doubles (this should be separated real/complex) spot_isinwf (same for real/complex) From 70cfbbd631748bdbe6812a0e0d0f087bd1195f22 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 16 Mar 2020 16:35:35 -0500 Subject: [PATCH 155/256] ao ortho kpts --- src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f | 146 +++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f diff --git a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f new file mode 100644 index 00000000..3e3a371a --- /dev/null +++ b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f @@ -0,0 +1,146 @@ +!todo: add kpts + +BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ] + implicit none + ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ] + implicit none + BEGIN_DOC + ! complex version of ao_cart_to_sphe_coef for one k-point + END_DOC + call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, & + ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), & + ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1)) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! AO overlap matrix in the spherical basis set + END_DOC + integer :: k + complex*16, allocatable :: S(:,:) + allocate (S(ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt)) + + !todo: call with (:,:,k) vs (1,1,k)? is there a difference? does one create a temporary array? + do k=1, kpt_num + + call zgemm('T','N',ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), & + ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), & + ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1), (0.d0,0.d0), & + S, size(S,1)) + + call zgemm('N','N',ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), & + S, size(S,1), & + ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), (0.d0,0.d0), & + ao_cart_to_sphe_overlap_kpts(1,1,k),size(ao_cart_to_sphe_overlap_kpts,1)) + enddo + deallocate(S) + +END_PROVIDER + + + + +BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt, kpt_num)] + implicit none + BEGIN_DOC +! ao_ortho_canonical_coef_complex^(-1) + END_DOC + integer :: k + do k=1, kpt_num + call get_inverse_complex(ao_ortho_canonical_coef_kpts,size(ao_ortho_canonical_coef_kpts,1),& + ao_num_per_kpt, ao_ortho_cano_coef_inv_kpts, size(ao_ortho_cano_coef_inv_kpts,1)) + enddo +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)] +&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt, (kpt_num) ] +&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt_max ] + implicit none + BEGIN_DOC +! TODO: ao_ortho_canonical_num_complex should be the same as the real version +! maybe if the providers weren't linked we could avoid making a complex one? +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital + END_DOC + integer :: i,k + ao_ortho_canonical_coef_kpts = (0.d0,0.d0) + do k=1,kpt_num + do i=1,ao_num + ao_ortho_canonical_coef_kpts(i,i,k) = (1.d0,0.d0) + enddo + enddo + +!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num) +!ao_ortho_canonical_num=ao_num +!return + + if (ao_cartesian) then + + ao_ortho_canonical_num_per_kpt = ao_num_per_kpt + do k=1,kpt_num + call ortho_canonical_complex(ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), & + ao_num_per_kpt,ao_ortho_canonical_coef_kpts(:,:,k),size(ao_ortho_canonical_coef_kpts,1), & + ao_ortho_canonical_num_per_kpt(k)) + enddo + + + else + + complex*16, allocatable :: S(:,:) + + allocate(S(ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt)) + do k=1,kpt_num + S = (0.d0,0.d0) + do i=1,ao_cart_to_sphe_num_per_kpt + S(i,i) = (1.d0,0.d0) + enddo + + ao_ortho_canonical_num_per_kpt(k) = ao_cart_to_sphe_num_per_kpt + call ortho_canonical_complex(ao_cart_to_sphe_overlap_kpts, size(ao_cart_to_sphe_overlap_kpts,1), & + ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k)) + + call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), & + ao_cart_to_sphe_coef_kpts(:,:,k), size(ao_cart_to_sphe_coef_kpts,1), & + S, size(S,1), & + (0.d0,0.d0), ao_ortho_canonical_coef_kpts(:,:,k), size(ao_ortho_canonical_coef_kpts,1)) + enddo + + deallocate(S) + endif + ao_ortho_canonical_num_per_kpt_max = max(ao_ortho_canonical_num_per_kpt) +END_PROVIDER + +BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical_num_per_kpt_max,ao_ortho_canonical_num_per_kpt_max,kpt_num)] + implicit none + BEGIN_DOC +! overlap matrix of the ao_ortho_canonical. +! Expected to be the Identity + END_DOC + integer :: i,j,k,l,kk + complex*16 :: c + do k=1,kpt_num + do j=1, ao_ortho_canonical_num_per_kpt_max + do i=1, ao_ortho_canonical_num_per_kpt_max + ao_ortho_canonical_overlap_complex(i,j,k) = (0.d0,0.d0) + enddo + enddo + enddo + do kk=1,kpt_num + do j=1, ao_ortho_canonical_num_per_kpt(kk) + do k=1, ao_num_per_kpt + c = (0.d0,0.d0) + do l=1, ao_num_per_kpt + c += conjg(ao_ortho_canonical_coef_kpts(l,j,kk)) * ao_overlap_kpts(l,k,kk) + enddo + do i=1, ao_ortho_canonical_num_per_kpt(kk) + ao_ortho_canonical_overlap_kpts(i,j,kk) += ao_ortho_canonical_coef_kpts(k,i,kk) * c + enddo + enddo + enddo + enddo +END_PROVIDER From 92294cf97372c8d1929654ec50349f2d96c50697 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 17 Mar 2020 10:30:34 -0500 Subject: [PATCH 156/256] cleaner ao ortho canonical for kpts --- src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f | 72 ++++++++++++++++++---- 1 file changed, 61 insertions(+), 11 deletions(-) diff --git a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f index 3e3a371a..1cc4ba9d 100644 --- a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f @@ -1,19 +1,69 @@ !todo: add kpts -BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ] + BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)] +&BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ] implicit none - ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num -END_PROVIDER + BEGIN_DOC +! Coefficients to go from cartesian to spherical coordinates in the current +! basis set + END_DOC + integer :: i + integer, external :: ao_power_index + integer :: ibegin,j,k + integer :: prev + prev = 0 + ao_cart_to_sphe_coefi_kpts(:,:) = (0.d0,0.d0) + ! Assume order provided by ao_power_index + i = 1 + ao_cart_to_sphe_num_per_kpt = 0 + do while (i <= ao_num_per_kpt) + select case ( ao_l(i) ) + case (0) + ao_cart_to_sphe_num_per_kpt += 1 + ao_cart_to_sphe_coef_kpts(i,ao_cart_to_sphe_num_per_kpt) = (1.d0,0.d0) + i += 1 + BEGIN_TEMPLATE + case ($SHELL) + if (ao_power(i,1) == $SHELL) then + do k=1,size(cart_to_sphe_$SHELL,2) + do j=1,size(cart_to_sphe_$SHELL,1) + ao_cart_to_sphe_coef_kpts(i+j-1,ao_cart_to_sphe_num_per_kpt+k) = dcmplx(cart_to_sphe_$SHELL(j,k),0.d0) + enddo + enddo + i += size(cart_to_sphe_$SHELL,1) + ao_cart_to_sphe_num_per_kpt += size(cart_to_sphe_$SHELL,2) + endif + SUBST [ SHELL ] + 1;; + 2;; + 3;; + 4;; + 5;; + 6;; + 7;; + 8;; + 9;; + END_TEMPLATE + case default + stop 'Error in ao_cart_to_sphe_kpts : angular momentum too high' + end select + enddo -BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ] - implicit none - BEGIN_DOC - ! complex version of ao_cart_to_sphe_coef for one k-point - END_DOC - call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, & - ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), & - ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1)) END_PROVIDER +!BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ] +! implicit none +! ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num +!END_PROVIDER +! +!BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ] +! implicit none +! BEGIN_DOC +! ! complex version of ao_cart_to_sphe_coef for one k-point +! END_DOC +! call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, & +! ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), & +! ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1)) +!END_PROVIDER BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,kpt_num) ] implicit none From 84531d8021763996777b709f1ace6fa2efb1938c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 17 Mar 2020 17:57:56 -0500 Subject: [PATCH 157/256] working on kpts --- src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f | 14 +- src/bitmask/core_inact_act_virt.irp.f | 441 +++++++++++++++++++++ src/hartree_fock/scf.irp.f | 21 +- src/mo_basis/mos_cplx.irp.f | 274 +++++++++++++ src/mo_basis/utils_cplx.irp.f | 267 +++++++++++++ src/mo_guess/mo_ortho_lowdin_cplx.irp.f | 61 +++ src/scf_utils/diagonalize_fock_cplx.irp.f | 62 +++ src/scf_utils/fock_matrix_cplx.irp.f | 374 +++++++++++++++++ src/scf_utils/huckel_cplx.irp.f | 49 +++ src/utils_complex/qp2-pbc-diff.txt | 4 +- 10 files changed, 1551 insertions(+), 16 deletions(-) diff --git a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f index 1cc4ba9d..01a02f02 100644 --- a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f @@ -12,7 +12,7 @@ integer :: ibegin,j,k integer :: prev prev = 0 - ao_cart_to_sphe_coefi_kpts(:,:) = (0.d0,0.d0) + ao_cart_to_sphe_coef_kpts(:,:) = (0.d0,0.d0) ! Assume order provided by ao_power_index i = 1 ao_cart_to_sphe_num_per_kpt = 0 @@ -79,13 +79,13 @@ BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_ call zgemm('T','N',ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), & ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), & - ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1), (0.d0,0.d0), & + ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), (0.d0,0.d0), & S, size(S,1)) call zgemm('N','N',ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), & S, size(S,1), & ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), (0.d0,0.d0), & - ao_cart_to_sphe_overlap_kpts(1,1,k),size(ao_cart_to_sphe_overlap_kpts,1)) + ao_cart_to_sphe_overlap_kpts(:,:,k),size(ao_cart_to_sphe_overlap_kpts,1)) enddo deallocate(S) @@ -106,7 +106,7 @@ BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_kpts, (ao_num_per_kpt,ao_num enddo END_PROVIDER - BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)] + BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] &BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt, (kpt_num) ] &BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt_max ] implicit none @@ -155,14 +155,14 @@ END_PROVIDER ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k)) call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), & - ao_cart_to_sphe_coef_kpts(:,:,k), size(ao_cart_to_sphe_coef_kpts,1), & + ao_cart_to_sphe_coef_kpts, size(ao_cart_to_sphe_coef_kpts,1), & S, size(S,1), & (0.d0,0.d0), ao_ortho_canonical_coef_kpts(:,:,k), size(ao_ortho_canonical_coef_kpts,1)) enddo deallocate(S) endif - ao_ortho_canonical_num_per_kpt_max = max(ao_ortho_canonical_num_per_kpt) + ao_ortho_canonical_num_per_kpt_max = maxval(ao_ortho_canonical_num_per_kpt) END_PROVIDER BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical_num_per_kpt_max,ao_ortho_canonical_num_per_kpt_max,kpt_num)] @@ -176,7 +176,7 @@ BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical do k=1,kpt_num do j=1, ao_ortho_canonical_num_per_kpt_max do i=1, ao_ortho_canonical_num_per_kpt_max - ao_ortho_canonical_overlap_complex(i,j,k) = (0.d0,0.d0) + ao_ortho_canonical_overlap_kpts(i,j,k) = (0.d0,0.d0) enddo enddo enddo diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index d30e989f..c0484057 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -413,3 +413,444 @@ END_PROVIDER print *, list_inact_act(1:n_inact_act_orb) END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! +BEGIN_PROVIDER [ integer, n_core_orb_kpts, (kpt_num)] + implicit none + BEGIN_DOC + ! Number of core MOs + END_DOC + integer :: i,k,kshift + + do k=1,kpt_num + n_core_orb_kpts(k) = 0 + kshift = (1-k)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+kshift) == 'Core')then + n_core_orb_kpts(k) += 1 + endif + enddo + enddo + +! call write_int(6,n_core_orb, 'Number of core MOs') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_inact_orb_kpts, (kpt_num)] + implicit none + BEGIN_DOC + ! Number of inactive MOs + END_DOC + integer :: i,k,kshift + + do k=1,kpt_num + n_inact_orb_kpts(k) = 0 + kshift = (1-k)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+kshift) == 'Inactive')then + n_inact_orb_kpts(k) += 1 + endif + enddo + enddo + +! call write_int(6,n_inact_orb, 'Number of inactive MOs') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_act_orb_kpts, (kpt_num)] + implicit none + BEGIN_DOC + ! Number of active MOs + END_DOC + integer :: i,k,kshift + + do k=1,kpt_num + n_act_orb_kpts(k) = 0 + kshift = (1-k)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+kshift) == 'Active')then + n_act_orb_kpts(k) += 1 + endif + enddo + enddo + +! call write_int(6,n_act_orb, 'Number of active MOs') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_virt_orb_kpts, (kpt_num)] + implicit none + BEGIN_DOC + ! Number of virtual MOs + END_DOC + integer :: i,k,kshift + + do k=1,kpt_num + n_virt_orb_kpts(k) = 0 + kshift = (1-k)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+kshift) == 'Virtual')then + n_virt_orb_kpts(k) += 1 + endif + enddo + enddo + +! call write_int(6,n_virt_orb, 'Number of virtual MOs') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_del_orb_kpts, (kpt_num)] + implicit none + BEGIN_DOC + ! Number of deleted MOs + END_DOC + integer :: i,k,kshift + + do k=1,kpt_num + n_del_orb_kpts(k) = 0 + kshift = (1-k)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+kshift) == 'Deleted')then + n_del_orb_kpts(k) += 1 + endif + enddo + enddo + +! call write_int(6,n_del_orb, 'Number of deleted MOs') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_core_inact_orb_kpts, (kpt_num) ] + !todo: finish implementation for kpts (will need kpt_mask) + implicit none + BEGIN_DOC + ! n_core + n_inact + END_DOC + integer :: i,k + do k=1,kpt_num + n_core_inact_orb_kpts(k) = 0 + do i = 1, N_int + n_core_inact_orb_kpts(k) += popcnt(iand(kpt_mask(i,k),reunion_of_core_inact_bitmask(i,1))) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [integer, n_inact_act_orb_kpts, (kpt_num) ] + implicit none + BEGIN_DOC + ! n_inact + n_act + END_DOC + integer :: k + do k=1,kpt_num + n_inact_act_orb_kpts(k) = (n_inact_orb_kpts(k)+n_act_orb_kpts(k)) + enddo +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_core_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_core. + ! it is at least 1 + END_DOC + dim_list_core_orb_kpts = max(maxval(n_core_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_inact_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_inact. + ! it is at least 1 + END_DOC + dim_list_inact_orb_kpts = max(maxval(n_inact_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_core_inact_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_core. + ! it is at least 1 + END_DOC + dim_list_core_inact_orb_kpts = max(maxval(n_core_inact_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_act_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_act. + ! it is at least 1 + END_DOC + dim_list_act_orb_kpts = max(maxval(n_act_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_virt_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_virt. + ! it is at least 1 + END_DOC + dim_list_virt_orb_kpts = max(maxval(n_virt_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_del_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_del. + ! it is at least 1 + END_DOC + dim_list_del_orb_kpts = max(maxval(n_del_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, n_core_inact_act_orb_kpts, (kpt_num) ] + implicit none + BEGIN_DOC + ! Number of core inactive and active MOs + END_DOC + integer :: k + do k=1,kpt_num + n_core_inact_act_orb_kpts(k) = (n_core_orb_kpts(k) + n_inact_orb_kpts(k) + n_act_orb_kpts(k)) + enddo +END_PROVIDER + + +!todo: finish below for kpts +! +! BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ] +! implicit none +! BEGIN_DOC +! ! Bitmask identifying the core MOs +! END_DOC +! core_bitmask = 0_bit_kind +! if(n_core_orb > 0)then +! call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int) +! call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int) +! endif +! END_PROVIDER +! +! BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ] +! implicit none +! BEGIN_DOC +! ! Bitmask identifying the inactive MOs +! END_DOC +! inact_bitmask = 0_bit_kind +! if(n_inact_orb > 0)then +! call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int) +! call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int) +! endif +! END_PROVIDER +! +! BEGIN_PROVIDER [ integer(bit_kind), act_bitmask , (N_int,2) ] +! implicit none +! BEGIN_DOC +! ! Bitmask identifying the active MOs +! END_DOC +! act_bitmask = 0_bit_kind +! if(n_act_orb > 0)then +! call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int) +! call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int) +! endif +! END_PROVIDER +! +! BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask , (N_int,2) ] +! implicit none +! BEGIN_DOC +! ! Bitmask identifying the virtual MOs +! END_DOC +! virt_bitmask = 0_bit_kind +! if(n_virt_orb > 0)then +! call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int) +! call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int) +! endif +! END_PROVIDER +! +! BEGIN_PROVIDER [ integer(bit_kind), del_bitmask , (N_int,2) ] +! implicit none +! BEGIN_DOC +! ! Bitmask identifying the deleted MOs +! END_DOC +! +! del_bitmask = 0_bit_kind +! +! if(n_del_orb > 0)then +! call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int) +! call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int) +! endif +! +! END_PROVIDER +! +! +! +! +! +! BEGIN_PROVIDER [ integer, list_core , (dim_list_core_orb) ] +!&BEGIN_PROVIDER [ integer, list_core_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of MO indices which are in the core. +! END_DOC +! integer :: i, n +! list_core = 0 +! list_core_reverse = 0 +! +! n=0 +! do i = 1, mo_num +! if(mo_class(i) == 'Core')then +! n += 1 +! list_core(n) = i +! list_core_reverse(i) = n +! endif +! enddo +! print *, 'Core MOs:' +! print *, list_core(1:n_core_orb) +! +!END_PROVIDER +! +! BEGIN_PROVIDER [ integer, list_inact , (dim_list_inact_orb) ] +!&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of MO indices which are inactive. +! END_DOC +! integer :: i, n +! list_inact = 0 +! list_inact_reverse = 0 +! +! n=0 +! do i = 1, mo_num +! if (mo_class(i) == 'Inactive')then +! n += 1 +! list_inact(n) = i +! list_inact_reverse(i) = n +! endif +! enddo +! print *, 'Inactive MOs:' +! print *, list_inact(1:n_inact_orb) +! +!END_PROVIDER +! +! BEGIN_PROVIDER [ integer, list_virt , (dim_list_virt_orb) ] +!&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of MO indices which are virtual +! END_DOC +! integer :: i, n +! list_virt = 0 +! list_virt_reverse = 0 +! +! n=0 +! do i = 1, mo_num +! if (mo_class(i) == 'Virtual')then +! n += 1 +! list_virt(n) = i +! list_virt_reverse(i) = n +! endif +! enddo +! print *, 'Virtual MOs:' +! print *, list_virt(1:n_virt_orb) +! +!END_PROVIDER +! +! BEGIN_PROVIDER [ integer, list_del , (dim_list_del_orb) ] +!&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of MO indices which are deleted. +! END_DOC +! integer :: i, n +! list_del = 0 +! list_del_reverse = 0 +! +! n=0 +! do i = 1, mo_num +! if (mo_class(i) == 'Deleted')then +! n += 1 +! list_del(n) = i +! list_del_reverse(i) = n +! endif +! enddo +! print *, 'Deleted MOs:' +! print *, list_del(1:n_del_orb) +! +!END_PROVIDER +! +! BEGIN_PROVIDER [ integer, list_act , (dim_list_act_orb) ] +!&BEGIN_PROVIDER [ integer, list_act_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of MO indices which are in the active. +! END_DOC +! integer :: i, n +! list_act = 0 +! list_act_reverse = 0 +! +! n=0 +! do i = 1, mo_num +! if (mo_class(i) == 'Active')then +! n += 1 +! list_act(n) = i +! list_act_reverse(i) = n +! endif +! enddo +! print *, 'Active MOs:' +! print *, list_act(1:n_act_orb) +! +!END_PROVIDER +! +! +! +! BEGIN_PROVIDER [ integer, list_core_inact , (dim_list_core_inact_orb) ] +!&BEGIN_PROVIDER [ integer, list_core_inact_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of indices of the core and inactive MOs +! END_DOC +! integer :: i,itmp +! call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int) +! list_core_inact_reverse = 0 +! ASSERT (itmp == n_core_inact_orb) +! do i = 1, n_core_inact_orb +! list_core_inact_reverse(list_core_inact(i)) = i +! enddo +! print *, 'Core and Inactive MOs:' +! print *, list_core_inact(1:n_core_inact_orb) +!END_PROVIDER +! +! +! BEGIN_PROVIDER [ integer, list_core_inact_act , (n_core_inact_act_orb) ] +!&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of indices of the core inactive and active MOs +! END_DOC +! integer :: i,itmp +! call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int) +! list_core_inact_act_reverse = 0 +! ASSERT (itmp == n_core_inact_act_orb) +! do i = 1, n_core_inact_act_orb +! list_core_inact_act_reverse(list_core_inact_act(i)) = i +! enddo +! print *, 'Core, Inactive and Active MOs:' +! print *, list_core_inact_act(1:n_core_inact_act_orb) +!END_PROVIDER +! +! +! BEGIN_PROVIDER [ integer, list_inact_act , (n_inact_act_orb) ] +!&BEGIN_PROVIDER [ integer, list_inact_act_reverse, (mo_num) ] +! implicit none +! BEGIN_DOC +! ! List of indices of the inactive and active MOs +! END_DOC +! integer :: i,itmp +! call bitstring_to_list(reunion_of_inact_act_bitmask(1,1), list_inact_act, itmp, N_int) +! list_inact_act_reverse = 0 +! ASSERT (itmp == n_inact_act_orb) +! do i = 1, n_inact_act_orb +! list_inact_act_reverse(list_inact_act(i)) = i +! enddo +! print *, 'Inactive and Active MOs:' +! print *, list_inact_act(1:n_inact_act_orb) +!END_PROVIDER +! diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 2b93a1df..9d1671ec 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -46,21 +46,25 @@ subroutine create_guess logical :: exists PROVIDE ezfio_filename if (is_complex) then - call ezfio_has_mo_basis_mo_coef_complex(exists) +! call ezfio_has_mo_basis_mo_coef_complex(exists) + call ezfio_has_mo_basis_mo_coef_kpts(exists) else call ezfio_has_mo_basis_mo_coef(exists) endif if (.not.exists) then if (mo_guess_type == "HCore") then if (is_complex) then - mo_coef_complex = ao_ortho_lowdin_coef_complex - TOUCH mo_coef_complex + !mo_coef_complex = ao_ortho_lowdin_coef_complex + mo_coef_kpts = ao_ortho_lowdin_coef_kpts + TOUCH mo_coef_kpts mo_label = 'Guess' - call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_complex, & - size(mo_one_e_integrals_complex,1), & - size(mo_one_e_integrals_complex,2), & + !call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_kpts, & + call mo_as_eigvectors_of_mo_matrix_kpts(mo_one_e_integrals_kpts, & + size(mo_one_e_integrals_kpts,1), & + size(mo_one_e_integrals_kpts,2), & + size(mo_one_e_integrals_kpts,3), & mo_label,1,.false.) - SOFT_TOUCH mo_coef_complex mo_label + SOFT_TOUCH mo_coef_kpts mo_label else mo_coef = ao_ortho_lowdin_coef TOUCH mo_coef @@ -73,7 +77,8 @@ subroutine create_guess endif else if (mo_guess_type == "Huckel") then if (is_complex) then - call huckel_guess_complex + !call huckel_guess_complex + call huckel_guess_kpts else call huckel_guess endif diff --git a/src/mo_basis/mos_cplx.irp.f b/src/mo_basis/mos_cplx.irp.f index a4f3f9ed..6b7e14c7 100644 --- a/src/mo_basis/mos_cplx.irp.f +++ b/src/mo_basis/mos_cplx.irp.f @@ -93,6 +93,7 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex_kpts, (ao_num_per_kpt, mo_num_per_k END_PROVIDER + BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex, (mo_num,ao_num) ] &BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex_conjg, (mo_num,ao_num) ] implicit none @@ -198,3 +199,276 @@ subroutine ao_ortho_cano_to_ao_cplx(A_ao,LDA_ao,A,LDA) deallocate(T) end +!============================================! +! ! +! kpts ! +! ! +!============================================! + + +BEGIN_PROVIDER [ complex*16, mo_coef_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Molecular orbital coefficients on |AO| basis set + ! + ! mo_coef_kpts(i,j,k) = coefficient of the i-th |AO| on the jth |MO| in kth kpt + ! + ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc) + END_DOC + integer :: i, j, k + logical :: exists + PROVIDE ezfio_filename + + if (mpi_master) then + ! Coefs + call ezfio_has_mo_basis_mo_coef_complex(exists) + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_coef_kpts with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + call ezfio_get_mo_basis_mo_coef_kpts(mo_coef_kpts) + write(*,*) 'Read mo_coef_kpts' + endif + IRP_IF MPI + call MPI_BCAST( mo_coef_kpts, kpt_num*mo_num_per_kpt*ao_num_per_kpt, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_coef_kpts with MPI' + endif + IRP_ENDIF + else + ! Orthonormalized AO basis + + do k=1,kpt_num + do i=1,mo_num_per_kpt + do j=1,ao_num_per_kpt + mo_coef_kpts(j,i,k) = ao_ortho_canonical_coef_kpts(j,i,k) + enddo + enddo + enddo + endif +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! |MO| coefficients in orthogonalized |AO| basis + ! + ! $C^{-1}.C_{mo}$ + END_DOC + integer :: k + do k=1,kpt_num + + call zgemm('N','N',ao_num_per_kpt,mo_num_per_kpt,ao_num_per_kpt,(1.d0,0.d0), & + ao_ortho_cano_coef_inv_kpts(:,:,k), size(ao_ortho_cano_coef_inv_kpts,1),& + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), (0.d0,0.d0), & + mo_coef_in_ao_ortho_basis_kpts(:,:,k), size(mo_coef_in_ao_ortho_basis_kpts,1)) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, mo_coef_transp_kpts, (mo_num_per_kpt,ao_num_per_kpt,kpt_num) ] +&BEGIN_PROVIDER [ complex*16, mo_coef_transp_kpts_conjg, (mo_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! |MO| coefficients on |AO| basis set + END_DOC + integer :: i, j, k + + do k=1,kpt_num + do j=1,ao_num_per_kpt + do i=1,mo_num_per_kpt + mo_coef_transp_kpts(i,j,k) = mo_coef_kpts(j,i,k) + mo_coef_transp_kpts_conjg(i,j,k) = dconjg(mo_coef_kpts(j,i,k)) + enddo + enddo + enddo + +END_PROVIDER + +subroutine ao_to_mo_kpts(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + !todo: check this + BEGIN_DOC + ! Transform A from the AO basis to the MO basis + ! where A is complex in the AO basis + ! + ! C^\dagger.A_ao.C + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num) + complex*16, intent(out) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num_per_kpt,mo_num_per_kpt) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + integer :: k + + do k=1,kpt_num + call zgemm('N','N', ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('C','N', mo_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, & + (1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), & + T, ao_num_per_kpt, & + (0.d0,0.d0), A_mo(:,:,k), size(A_mo,1)) + enddo + + deallocate(T) +end + +subroutine ao_to_mo_noconjg_kpts(A_ao,LDA_ao,A_mo,LDA_mo) + implicit none + BEGIN_DOC + ! Transform A from the AO basis to the MO basis + ! where A is complex in the AO basis + ! + ! C^T.A_ao.C + ! needed for 4idx tranform in four_idx_novvvv + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num) + complex*16, intent(out) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num_per_kpt,mo_num_per_kpt) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + integer :: k + do k=1,kpt_num + call zgemm('N','N', ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, & + (1.d0,0.d0), A_ao,LDA_ao, & + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('T','N', mo_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, & + (1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), & + T, ao_num_per_kpt, & + (0.d0,0.d0), A_mo(:,:,k), size(A_mo,1)) + enddo + deallocate(T) +end + + +subroutine ao_ortho_cano_to_ao_kpts(A_ao,LDA_ao,A,LDA) + implicit none + !todo: check this; no longer using assumed-size arrays + BEGIN_DOC + ! Transform A from the |AO| basis to the orthogonal |AO| basis + ! + ! $C^{-1}.A_{ao}.C^{\dagger-1}$ + END_DOC + integer, intent(in) :: LDA_ao,LDA + complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num) + complex*16, intent(out) :: A(LDA,ao_num_per_kpt,kpt_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(ao_num_per_kpt,ao_num_per_kpt) ) + + integer :: k + do k=1,kpt_num + call zgemm('C','N', ao_num_per_kpt, ao_num_per_kpt, ao_num_per_kpt, & + (1.d0,0.d0), & + ao_ortho_cano_coef_inv_kpts(:,:,k), size(ao_ortho_cano_coef_inv_kpts,1),& + A_ao(:,:,k),size(A_ao,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, ao_num_per_kpt, (1.d0,0.d0), & + T, size(T,1), & + ao_ortho_cano_coef_inv_kpts(:,:,k),size(ao_ortho_cano_coef_inv_kpts,1),& + (0.d0,0.d0), A(:,:,k), size(A,1)) + enddo + + deallocate(T) +end + + +!============================================! +! ! +! elec kpts ! +! ! +!============================================! + + BEGIN_PROVIDER [ integer, elec_alpha_num_kpts, (kpt_num) ] +&BEGIN_PROVIDER [ integer, elec_beta_num_kpts, (kpt_num) ] + !todo: reorder? if not integer multiple, use some list of kpts to determine filling order + implicit none + + integer :: i,k,kpt + + PROVIDE elec_alpha_num elec_beta_num + + do k=1,kpt_num + elec_alpha_num_kpts(k) = 0 + elec_beta_num_kpts(k) = 0 + enddo + kpt=1 + do i=1,elec_beta_num + elec_alpha_num_kpts(kpt) += 1 + elec_beta_num_kpts(kpt) += 1 + kpt += 1 + if (kpt > kpt_num) then + kpt = 1 + endif + enddo + do i=elec_beta_num+1,elec_alpha_num + elec_alpha_num_kpts(kpt) += 1 + kpt += 1 + if (kpt > kpt_num) then + kpt = 1 + endif + enddo + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, mo_occ_kpts, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! |MO| occupation numbers + END_DOC + PROVIDE ezfio_filename elec_beta_num_kpts elec_alpha_num_kpts + if (mpi_master) then + logical :: exists + call ezfio_has_mo_basis_mo_occ_kpts(exists) + if (exists) then + call ezfio_get_mo_basis_mo_occ_kpts(mo_occ_kpts) + else + mo_occ_kpts = 0.d0 + integer :: i,k + do k=1,kpt_num + do i=1,elec_beta_num_kpts(k) + mo_occ_kpts(i,k) = 2.d0 + enddo + do i=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) + mo_occ_kpts(i,k) = 1.d0 + enddo + enddo + endif + write(*,*) 'Read mo_occ_kpts' + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( mo_occ_kpts, mo_num_per_kpt*kpt_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_occ_kpts with MPI' + endif + IRP_ENDIF + +END_PROVIDER diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index a967cec4..58230cdd 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -245,4 +245,271 @@ subroutine mo_coef_new_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,mo end +!============================================! +! ! +! kpts ! +! ! +!============================================! + +subroutine mo_as_eigvectors_of_mo_matrix_kpts(matrix,n,m,nk,label,sign,output) + !TODO: test this + implicit none + integer,intent(in) :: n,m,nk, sign + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(n,m,nk) + logical, intent(in) :: output + + integer :: i,j,k + double precision, allocatable :: eigvalues(:) + complex*16, allocatable :: mo_coef_new(:,:), R(:,:), A(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R + + call write_time(6) + if (m /= mo_num_per_kpt) then + print *, irp_here, ': Error : m/= mo_num_per_kpt' + stop 1 + endif + if (nk /= kpt_num) then + print *, irp_here, ': Error : nk/= kpt_num' + stop 1 + endif + allocate(A(n,m),R(n,m),mo_coef_new(ao_num_per_kpt,m),eigvalues(m)) + do k=1,nk + if (sign == -1) then + do j=1,m + do i=1,n + A(i,j) = -matrix(i,j,k) + enddo + enddo + else + do j=1,m + do i=1,n + A(i,j) = matrix(i,j,k) + enddo + enddo + endif + mo_coef_new = mo_coef_kpts(:,:,k) + + call lapack_diag_complex(eigvalues,R,A,n,m) + if (sign == -1) then + do i=1,m + eigvalues(i) = -eigvalues(i) + enddo + endif + if (output) then + do i=1,m + write (6,'(2(I8),1X,F16.10)') k,i,eigvalues(i) + enddo + write (6,'(A)') '======== ================' + write (6,'(A)') '' + write (6,'(A)') 'Fock Matrix' + write (6,'(A)') '-----------' + do i=1,n + write(*,'(200(E24.15))') A(i,:) + enddo + endif + + call zgemm('N','N',ao_num_per_kpt,m,m,(1.d0,0.d0), & + mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0), & + mo_coef_kpts(:,:,k),size(mo_coef_kpts,1)) + enddo + deallocate(A,mo_coef_new,R,eigvalues) + call write_time(6) + + mo_label = label + if (output) then + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================' + endif +end + +subroutine mo_as_svd_vectors_of_mo_matrix_kpts(matrix,lda,m,n,label) + !TODO: implement + print *, irp_here, ' not implemented for kpts' + stop 1 + implicit none + integer,intent(in) :: lda,m,n + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(lda,n) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_new = mo_coef_complex + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) + deallocate(A,mo_coef_new,U,Vt,D) + call write_time(6) + + mo_label = label +end + + +subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,eig,label) + !TODO: implement + print *, irp_here, ' not implemented for kpts' + stop 1 + implicit none + integer,intent(in) :: lda,m,n + character*(64), intent(in) :: label + complex*16, intent(in) :: matrix(lda,n) + double precision, intent(out) :: eig(m) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:), work(:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_new = mo_coef_complex + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) + + do i=1,m + eig(i) = D(i) + enddo + + deallocate(A,mo_coef_new,U,Vt,D) + call write_time(6) + + mo_label = label + +end + + +subroutine mo_coef_new_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,mo_coef_before,eig,mo_coef_new) + !TODO: implement + print *, irp_here, ' not implemented for kpts' + stop 1 + implicit none + BEGIN_DOC +! You enter with matrix in the MO basis defined with the mo_coef_before. +! +! You SVD the matrix and set the eigenvectors as mo_coef_new ordered by increasing singular values + END_DOC + integer,intent(in) :: lda,m,n + complex*16, intent(in) :: matrix(lda,n),mo_coef_before(ao_num,m) + double precision, intent(out) :: eig(m) + complex*16, intent(out) :: mo_coef_new(ao_num,m) + + integer :: i,j + double precision :: accu + double precision, allocatable :: D(:) + complex*16, allocatable :: mo_coef_tmp(:,:), U(:,:), A(:,:), Vt(:,:), work(:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, Vt, A + + call write_time(6) + if (m /= mo_num) then + print *, irp_here, ': Error : m/= mo_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_tmp = mo_coef_before + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================ ================' + write (6,'(A)') ' MO Eigenvalue Cumulative ' + write (6,'(A)') '======== ================ ================' + + accu = 0.d0 + do i=1,m + accu = accu + D(i) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + enddo + write (6,'(A)') '======== ================ ================' + write (6,'(A)') '' + + call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_new,size(mo_coef_new,1)) + + do i=1,m + eig(i) = D(i) + enddo + + deallocate(A,U,Vt,D,mo_coef_tmp) + call write_time(6) + +end diff --git a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f index 5e1dacbe..3a2750cd 100644 --- a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f +++ b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f @@ -46,3 +46,64 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_complex, (ao_num,ao_num)] enddo enddo END_PROVIDER + +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital + END_DOC + integer :: i,j,k,l + complex*16, allocatable :: tmp_matrix(:,:) + allocate (tmp_matrix(ao_num,ao_num)) + do k=1,kpt_num + tmp_matrix(:,:) = (0.d0,0.d0) + do j=1, ao_num + tmp_matrix(j,j) = (1.d0,0.d0) + enddo + call ortho_lowdin_complex(ao_overlap_kpts(:,:,k),ao_num_per_kpt,ao_num_per_kpt,tmp_matrix,ao_num_per_kpt,ao_num_per_kpt) + do i=1, ao_num_per_kpt + do j=1, ao_num_per_kpt + ao_ortho_lowdin_coef_kpts(j,i,k) = tmp_matrix(i,j) + enddo + enddo + enddo + deallocate(tmp_matrix) +END_PROVIDER + +BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC +! overlap matrix of the ao_ortho_lowdin +! supposed to be the Identity + END_DOC + integer :: i,j,k,l,kk + complex*16 :: c + do kk=1,kpt_num + do j=1, ao_num_per_kpt + do i=1, ao_num_per_kpt + ao_ortho_lowdin_overlap_kpts(i,j,kk) = (0.d0,0.d0) + enddo + enddo + enddo + do kk=1,kpt_num + do k=1, ao_num_per_kpt + do j=1, ao_num_per_kpt + c = (0.d0,0.d0) + do l=1, ao_num_per_kpt + c += dconjg(ao_ortho_lowdin_coef_kpts(j,l,kk)) * ao_overlap_kpts(k,l,kk) + enddo + do i=1, ao_num_per_kpt + ao_ortho_lowdin_overlap_kpts(i,j,kk) += ao_ortho_lowdin_coef_kpts(i,k,kk) * c + enddo + enddo + enddo + enddo +END_PROVIDER diff --git a/src/scf_utils/diagonalize_fock_cplx.irp.f b/src/scf_utils/diagonalize_fock_cplx.irp.f index 645dbcf9..de38c767 100644 --- a/src/scf_utils/diagonalize_fock_cplx.irp.f +++ b/src/scf_utils/diagonalize_fock_cplx.irp.f @@ -51,3 +51,65 @@ BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_complex, (ao_num,mo_num END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! +BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_kpts, (ao_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! Eigenvectors of the Fock matrix in the |MO| basis obtained with level shift. + END_DOC + + integer :: i,j,k + integer :: n + complex*16, allocatable :: F(:,:) + double precision, allocatable :: diag(:) + + + allocate( F(mo_num_per_kpt,mo_num_per_kpt) ) + allocate (diag(mo_num_per_kpt) ) + + do k=1,kpt_num + do j=1,mo_num + do i=1,mo_num + !F(i,j) = fock_matrix_mo_complex(i,j) + F(i,j) = fock_matrix_mo_kpts(i,j,k) + enddo + enddo + + if(frozen_orb_scf)then + integer :: iorb,jorb + !todo: core/act per kpt + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, n_act_orb + jorb = list_act(j) + F(iorb,jorb) = (0.d0,0.d0) + F(jorb,iorb) = (0.d0,0.d0) + enddo + enddo + endif + + ! Insert level shift here + !todo: elec per kpt + do i = elec_beta_num_per_kpt(k)+1, elec_alpha_num_per_kpt(k) + F(i,i) += 0.5d0*level_shift + enddo + + do i = elec_alpha_num_per_kpt(k)+1, mo_num_per_kpt + F(i,i) += level_shift + enddo + + n = mo_num_per_kpt + call lapack_diagd_diag_in_place_complex(diag,F,n,n) + + call zgemm('N','N',ao_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt, (1.d0,0.d0), & + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), F, size(F,1), & + (0.d0,0.d0), eigenvectors_Fock_matrix_mo_kpts(:,:,k), size(eigenvectors_Fock_matrix_mo_kpts,1)) + enddo + deallocate(F, diag) + + +END_PROVIDER diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index 61d23467..94508570 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -359,3 +359,377 @@ END_PROVIDER enddo END_PROVIDER + +!============================================! +! ! +! kpts ! +! ! +!============================================! + + BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] +&BEGIN_PROVIDER [ double precision, Fock_matrix_diag_mo_kpts, (mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis. + ! For open shells, the ROHF Fock Matrix is :: + ! + ! | F-K | F + K/2 | F | + ! |---------------------------------| + ! | F + K/2 | F | F - K/2 | + ! |---------------------------------| + ! | F | F - K/2 | F + K | + ! + ! + ! F = 1/2 (Fa + Fb) + ! + ! K = Fb - Fa + ! + END_DOC + integer :: i,j,n,k + !todo: fix for kpts? (okay for simple cases) + if (elec_alpha_num == elec_beta_num) then + Fock_matrix_mo_kpts = Fock_matrix_mo_alpha_kpts + else + do k=1,kpt_num + do j=1,elec_beta_num_kpts(k) + ! F-K + do i=1,elec_beta_num_kpts(k) !CC + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k))& + - (Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + ! F+K/2 + do i=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) !CA + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k))& + + 0.5d0*(Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + ! F + do i=elec_alpha_num_kpts(k)+1, mo_num_per_kpt !CV + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k)) + enddo + enddo + + do j=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) + ! F+K/2 + do i=1,elec_beta_num_kpts(k) !AC + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k))& + + 0.5d0*(Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + ! F + do i=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) !AA + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k)) + enddo + ! F-K/2 + do i=elec_alpha_num_kpts(k)+1, mo_num_per_kpt !AV + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k))& + - 0.5d0*(Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + enddo + + do j=elec_alpha_num_kpts(k)+1, mo_num_per_kpt + ! F + do i=1,elec_beta_num_kpts(k) !VC + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k)) + enddo + ! F-K/2 + do i=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) !VA + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k))& + - 0.5d0*(Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + ! F+K + do i=elec_alpha_num_kpts(k)+1,mo_num_per_kpt !VV + Fock_matrix_mo_kpts(i,j,k) = 0.5d0*(Fock_matrix_mo_alpha_kpts(i,j,k)+Fock_matrix_mo_beta_kpts(i,j,k)) & + + (Fock_matrix_mo_beta_kpts(i,j,k) - Fock_matrix_mo_alpha_kpts(i,j,k)) + enddo + enddo + enddo + + endif + do k=1,kpt_num + do i = 1, mo_num_per_kpt + Fock_matrix_diag_mo_kpts(i,k) = dble(Fock_matrix_mo_kpts(i,i,k)) + if (dabs(dimag(Fock_matrix_mo_kpts(i,i,k))) .gt. 1.0d-12) then + !stop 'diagonal elements of Fock matrix should be real' + print *, 'diagonal elements of Fock matrix should be real',i,Fock_matrix_mo_kpts(i,i,k) + !stop -1 + endif + enddo + enddo + + + if(frozen_orb_scf)then + integer :: iorb,jorb + do k=1,kpt_num + ! for tags: list_core, n_core_orb, n_act_orb, list_act + do i = 1, n_core_orb_kpts(k) + iorb = list_core_kpts(i,k) + do j = 1, n_act_orb_kpts(k) + jorb = list_act_kpts(j,k) + fock_matrix_mo_kpts(iorb,jorb,k) = (0.d0,0.d0) + fock_matrix_mo_kpts(jorb,iorb,k) = (0.d0,0.d0) + enddo + enddo + enddo + endif + +END_PROVIDER + + + +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_alpha_complex,size(Fock_matrix_ao_alpha_complex,1), & + Fock_matrix_mo_alpha_complex,size(Fock_matrix_mo_alpha_complex,1)) +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] + implicit none + BEGIN_DOC + ! Fock matrix on the MO basis + END_DOC + call ao_to_mo_complex(Fock_matrix_ao_beta_complex,size(Fock_matrix_ao_beta_complex,1), & + Fock_matrix_mo_beta_complex,size(Fock_matrix_mo_beta_complex,1)) +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Fock matrix in AO basis set + END_DOC + + if(frozen_orb_scf)then + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + else + if ( (elec_alpha_num == elec_beta_num).and. & + (level_shift == 0.) ) & + then + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_complex(i,j) = Fock_matrix_ao_alpha_complex(i,j) + enddo + enddo + else + call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & + Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + endif + endif +END_PROVIDER + + + BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_complex , (ao_num, ao_num) ] + use map_module + implicit none + BEGIN_DOC + ! Alpha and Beta Fock matrices in AO basis set + END_DOC + !TODO: finish implementing this: see complex qp1 (different mapping) + + integer :: i,j,k,l,k1,r,s + integer :: i0,j0,k0,l0 + integer*8 :: p,q + complex*16 :: integral, c0 + complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:) + complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:) + + ao_two_e_integral_alpha_complex = (0.d0,0.d0) + ao_two_e_integral_beta_complex = (0.d0,0.d0) + PROVIDE ao_two_e_integrals_in_map + + integer(omp_lock_kind) :: lck(ao_num) + integer(map_size_kind) :: i8 + integer :: ii(4), jj(4), kk(4), ll(4), k2 + integer(cache_map_size_kind) :: n_elements_max, n_elements + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) + integer(key_kind) :: key1 + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex, & + !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + + call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) + ! i<=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + + if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & + !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP c0,key1)& + !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & + !$OMP SCF_density_matrix_ao_beta_complex, & + !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + + call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) + allocate(keys(n_elements_max), values(n_elements_max)) + allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & + ao_two_e_integral_beta_tmp(ao_num,ao_num)) + ao_two_e_integral_alpha_tmp = (0.d0,0.d0) + ao_two_e_integral_beta_tmp = (0.d0,0.d0) + + !$OMP DO SCHEDULE(static,1) + do i8=0_8,ao_integrals_map_2%map_size + n_elements = n_elements_max + call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) + do k1=1,n_elements + ! get original key + ! reverse of 2*key (imag part) and 2*key-1 (real part) + key1 = shiftr(keys(k1)+1,1) + + call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) + ! i>=k, j<=l, ik<=jl + ! ijkl, jilk, klij*, lkji* + if (shiftl(key1,1)==keys(k1)) then !imaginary part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate + + !G_a(i,k) += D_{ab}(l,j)*() + !G_b(i,k) += D_{ab}(l,j)*() + !G_a(i,l) -= D_a (k,j)*() + !G_b(i,l) -= D_b (k,j)*() + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + else ! real part + do k2=1,4 + if (ii(k2)==0) then + cycle + endif + i = ii(k2) + j = jj(k2) + k = kk(k2) + l = ll(k2) + integral = values(k1) + + c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + + ao_two_e_integral_alpha_tmp(i,k) += c0 + ao_two_e_integral_beta_tmp (i,k) += c0 + + ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral + ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + enddo + endif + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + !$OMP END CRITICAL + deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) + !$OMP END PARALLEL + + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_complex, (ao_num, ao_num) ] +&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_complex, (ao_num, ao_num) ] + implicit none + BEGIN_DOC + ! Alpha Fock matrix in AO basis set + END_DOC + + integer :: i,j + do j=1,ao_num + do i=1,ao_num + Fock_matrix_ao_alpha_complex(i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_alpha_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_beta_complex (i,j) + enddo + enddo + +END_PROVIDER diff --git a/src/scf_utils/huckel_cplx.irp.f b/src/scf_utils/huckel_cplx.irp.f index d6da7ffb..a41ed831 100644 --- a/src/scf_utils/huckel_cplx.irp.f +++ b/src/scf_utils/huckel_cplx.irp.f @@ -40,3 +40,52 @@ subroutine huckel_guess_complex deallocate(A) end +!============================================! +! ! +! kpts ! +! ! +!============================================! +subroutine huckel_guess_kpts + implicit none + BEGIN_DOC +! Build the MOs using the extended Huckel model + END_DOC + integer :: i,j,k + double precision :: accu + double precision :: c + character*(64) :: label + complex*16, allocatable :: A(:,:) + label = "Guess" + c = 0.5d0 * 1.75d0 + + allocate (A(ao_num, ao_num)) + do k=1,kpt_num + A = (0.d0,0.d0) + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + A(i,j) = c * ao_overlap_kpts(i,j,k) * (ao_one_e_integrals_diag_kpts(i,k) + ao_one_e_integrals_diag_kpts(j,k)) + enddo + A(j,j) = ao_one_e_integrals_diag_kpts(j,k) + dble(ao_two_e_integral_alpha_kpts(j,j,k)) + if (dabs(dimag(ao_two_e_integral_alpha_kpts(j,j,k))) .gt. 1.0d-10) then + stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' + endif + enddo + +! Fock_matrix_ao_alpha(1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) +! Fock_matrix_ao_beta (1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) + call zlacpy('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + Fock_matrix_ao_alpha_kpts(:,:,k), size(Fock_matrix_ao_alpha_kpts,1)) + call zlacpy('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + Fock_matrix_ao_beta_kpts(:,:,k), size(Fock_matrix_ao_beta_kpts, 1)) + enddo + +! TOUCH mo_coef + + !TOUCH fock_matrix_ao_alpha_complex fock_matrix_ao_beta_kpts + TOUCH fock_matrix_ao_alpha_kpts fock_matrix_ao_beta_kpts + mo_coef_kpts = eigenvectors_fock_matrix_mo_kpts + SOFT_TOUCH mo_coef_complex + call save_mos + deallocate(A) + +end diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index 7cadd3c4..e7345240 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,7 +1,9 @@ todo: -change everything to be blocked by kpt + change everything to be blocked by kpt + elec_alpha_num_per_kpt (maybe add to mo_basis?) + bitmasks per kpt? (or at least occ/act/virt num and list) ------------------------------------------------------------------------------------- old: From 380cbdcbb5a997c7f884748dc56b6579bb13e631 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 18 Mar 2020 15:55:53 -0500 Subject: [PATCH 158/256] working on scf kpts --- src/bitmask/bitmasks.irp.f | 249 ++++++++ src/bitmask/core_inact_act_virt.irp.f | 546 ++++++++++-------- src/mo_basis/mos_cplx.irp.f | 2 +- src/mo_one_e_ints/ao_to_mo_cplx.irp.f | 78 +++ src/scf_utils/diagonalize_fock_cplx.irp.f | 4 +- src/scf_utils/fock_matrix_cplx.irp.f | 229 +++++--- .../scf_density_matrix_ao_cplx.irp.f | 51 ++ 7 files changed, 844 insertions(+), 315 deletions(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index 03127b1c..75421967 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -254,3 +254,252 @@ BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)] closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),act_bitmask(i,2)) enddo END_PROVIDER + +!============================================! +! ! +! kpts ! +! ! +!============================================! + +!BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int) ] +! implicit none +! BEGIN_DOC +! ! Bitmask to include all possible MOs +! END_DOC +! +! integer :: i,j,k +! k=0 +! do j=1,N_int +! full_ijkl_bitmask(j) = 0_bit_kind +! do i=0,bit_kind_size-1 +! k=k+1 +! if (mo_class(k) /= 'Deleted') then +! full_ijkl_bitmask(j) = ibset(full_ijkl_bitmask(j),i) +! endif +! if (k == mo_num) exit +! enddo +! enddo +!END_PROVIDER +! +!BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask_4, (N_int,4) ] +! implicit none +! integer :: i +! do i=1,N_int +! full_ijkl_bitmask_4(i,1) = full_ijkl_bitmask(i) +! full_ijkl_bitmask_4(i,2) = full_ijkl_bitmask(i) +! full_ijkl_bitmask_4(i,3) = full_ijkl_bitmask(i) +! full_ijkl_bitmask_4(i,4) = full_ijkl_bitmask(i) +! enddo +!END_PROVIDER +! +!BEGIN_PROVIDER [ integer(bit_kind), core_inact_act_bitmask_4, (N_int,4) ] +! implicit none +! integer :: i +! do i=1,N_int +! core_inact_act_bitmask_4(i,1) = reunion_of_core_inact_act_bitmask(i,1) +! core_inact_act_bitmask_4(i,2) = reunion_of_core_inact_act_bitmask(i,1) +! core_inact_act_bitmask_4(i,3) = reunion_of_core_inact_act_bitmask(i,1) +! core_inact_act_bitmask_4(i,4) = reunion_of_core_inact_act_bitmask(i,1) +! enddo +!END_PROVIDER +! +!BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask_4, (N_int,4) ] +! implicit none +! integer :: i +! do i=1,N_int +! virt_bitmask_4(i,1) = virt_bitmask(i,1) +! virt_bitmask_4(i,2) = virt_bitmask(i,1) +! virt_bitmask_4(i,3) = virt_bitmask(i,1) +! virt_bitmask_4(i,4) = virt_bitmask(i,1) +! enddo +!END_PROVIDER +! +! +! +! +BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Hartree Fock bit mask + END_DOC + integer :: i,k + + hf_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + hf_bitmask_kpts(i,1,k) = iand(hf_bitmask(i,1),kpts_bitmask(i,k)) + hf_bitmask_kpts(i,2,k) = iand(hf_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), ref_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask + END_DOC + ref_bitmask_kpts = HF_bitmask_kpts +END_PROVIDER + + + +!BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6) ] +! implicit none +! BEGIN_DOC +! ! Bitmasks for generator determinants. +! ! (N_int, alpha/beta, hole/particle, generator). +! ! +! ! 3rd index is : +! ! +! ! * 1 : hole for single exc +! ! +! ! * 2 : particle for single exc +! ! +! ! * 3 : hole for 1st exc of double +! ! +! ! * 4 : particle for 1st exc of double +! ! +! ! * 5 : hole for 2nd exc of double +! ! +! ! * 6 : particle for 2nd exc of double +! ! +! END_DOC +! logical :: exists +! PROVIDE ezfio_filename full_ijkl_bitmask +! +! integer :: ispin, i +! do ispin=1,2 +! do i=1,N_int +! generators_bitmask(i,ispin,s_hole ) = reunion_of_inact_act_bitmask(i,ispin) +! generators_bitmask(i,ispin,s_part ) = reunion_of_act_virt_bitmask(i,ispin) +! generators_bitmask(i,ispin,d_hole1) = reunion_of_inact_act_bitmask(i,ispin) +! generators_bitmask(i,ispin,d_part1) = reunion_of_act_virt_bitmask(i,ispin) +! generators_bitmask(i,ispin,d_hole2) = reunion_of_inact_act_bitmask(i,ispin) +! generators_bitmask(i,ispin,d_part2) = reunion_of_act_virt_bitmask(i,ispin) +! enddo +! enddo +! +!END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the core and inactive and virtual bitmasks + END_DOC + integer :: i,k + do k=1,kpt_num + do i = 1, N_int + reunion_of_core_inact_bitmask_kpts(i,1,k) = ior(core_bitmask_kpts(i,1,k),inact_bitmask_kpts(i,1,k)) + reunion_of_core_inact_bitmask_kpts(i,2,k) = ior(core_bitmask_kpts(i,2,k),inact_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + + +BEGIN_PROVIDER [integer(bit_kind), reunion_of_inact_act_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the inactive and active bitmasks + END_DOC + integer :: i,k + + do k=1,kpt_num + do i = 1, N_int + reunion_of_inact_act_bitmask_kpts(i,1,k) = ior(inact_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k)) + reunion_of_inact_act_bitmask_kpts(i,2,k) = ior(inact_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [integer(bit_kind), reunion_of_act_virt_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the inactive and active bitmasks + END_DOC + integer :: i,k + + do k=1,kpt_num + do i = 1, N_int + reunion_of_act_virt_bitmask_kpts(i,1,k) = ior(virt_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k)) + reunion_of_act_virt_bitmask_kpts(i,2,k) = ior(virt_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + + +BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the core, inactive and active bitmasks + END_DOC + integer :: i,k + + do k=1,kpt_num + do i = 1, N_int + reunion_of_core_inact_act_bitmask_kpts(i,1,k) = ior(reunion_of_core_inact_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k)) + reunion_of_core_inact_act_bitmask_kpts(i,2,k) = ior(reunion_of_core_inact_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + + +BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the inactive, active and virtual bitmasks + END_DOC + integer :: i,k + do k=1,kpt_num + do i = 1, N_int + reunion_of_bitmask_kpts(i,1,k) = ior(ior(act_bitmask_kpts(i,1,k),inact_bitmask_kpts(i,1,k)),virt_bitmask_kpts(i,1,k)) + reunion_of_bitmask_kpts(i,2,k) = ior(ior(act_bitmask_kpts(i,2,k),inact_bitmask_kpts(i,2,k)),virt_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + + + BEGIN_PROVIDER [ integer(bit_kind), inact_virt_bitmask_kpts, (N_int,2,kpt_num)] +&BEGIN_PROVIDER [ integer(bit_kind), core_inact_virt_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + BEGIN_DOC + ! Reunion of the inactive and virtual bitmasks + END_DOC + integer :: i,k + do k=1,kpt_num + do i = 1, N_int + inact_virt_bitmask_kpts(i,1,k) = ior(inact_bitmask_kpts(i,1,k),virt_bitmask_kpts(i,1,k)) + inact_virt_bitmask_kpts(i,2,k) = ior(inact_bitmask_kpts(i,2,k),virt_bitmask_kpts(i,2,k)) + core_inact_virt_bitmask_kpts(i,1,k) = ior(core_bitmask_kpts(i,1,k),inact_virt_bitmask_kpts(i,1,k)) + core_inact_virt_bitmask_kpts(i,2,k) = ior(core_bitmask_kpts(i,2,k),inact_virt_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + + +BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons_kpts, (N_int,kpt_num)] + implicit none + BEGIN_DOC + ! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask + END_DOC + integer :: i,k + unpaired_alpha_electrons_kpts = 0_bit_kind + do k = 1, kpt_num + do i = 1, N_int + unpaired_alpha_electrons_kpts(i,k) = xor(HF_bitmask_kpts(i,1,k),HF_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + integer :: i,k + + closed_shell_ref_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i = 1, N_int + closed_shell_ref_bitmask_kpts(i,1,k) = ior(ref_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k)) + closed_shell_ref_bitmask_kpts(i,2,k) = ior(ref_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k)) + enddo + enddo +END_PROVIDER + diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index c0484057..337e275b 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -418,6 +418,23 @@ END_PROVIDER ! kpts ! ! ! !============================================! +BEGIN_PROVIDER [ integer(bit_kind), kpts_bitmask , (N_int,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying each kpt + END_DOC + integer :: k,i,di + integer :: tmp_mo_list(mo_num_per_kpt) + kpts_bitmask = 0_bit_kind + do k=1,kpt_num + di=(k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + tmp_mo_list(i) = i+di + enddo + call list_to_bitstring( kpts_bitmask(1,k), tmp_mo_list, mo_num_per_kpt, N_int) + enddo +END_PROVIDER + BEGIN_PROVIDER [ integer, n_core_orb_kpts, (kpt_num)] implicit none BEGIN_DOC @@ -524,7 +541,7 @@ BEGIN_PROVIDER [ integer, n_del_orb_kpts, (kpt_num)] END_PROVIDER BEGIN_PROVIDER [ integer, n_core_inact_orb_kpts, (kpt_num) ] - !todo: finish implementation for kpts (will need kpt_mask) + !todo: finish implementation for kpts (will need kpts_bitmask) implicit none BEGIN_DOC ! n_core + n_inact @@ -533,7 +550,7 @@ BEGIN_PROVIDER [ integer, n_core_inact_orb_kpts, (kpt_num) ] do k=1,kpt_num n_core_inact_orb_kpts(k) = 0 do i = 1, N_int - n_core_inact_orb_kpts(k) += popcnt(iand(kpt_mask(i,k),reunion_of_core_inact_bitmask(i,1))) + n_core_inact_orb_kpts(k) += popcnt(iand(kpts_bitmask(i,k),reunion_of_core_inact_bitmask(i,1))) enddo enddo END_PROVIDER @@ -603,6 +620,24 @@ BEGIN_PROVIDER [integer, dim_list_del_orb_kpts] dim_list_del_orb_kpts = max(maxval(n_del_orb_kpts),1) END_PROVIDER +BEGIN_PROVIDER [integer, dim_list_core_inact_act_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_core_inact_act. + ! it is at least 1 + END_DOC + dim_list_core_inact_act_orb_kpts = max(maxval(n_core_inact_act_orb_kpts),1) +END_PROVIDER + +BEGIN_PROVIDER [integer, dim_list_inact_act_orb_kpts] + implicit none + BEGIN_DOC + ! dimensions for the allocation of list_inact_act. + ! it is at least 1 + END_DOC + dim_list_inact_act_orb_kpts = max(maxval(n_inact_act_orb_kpts),1) +END_PROVIDER + BEGIN_PROVIDER [integer, n_core_inact_act_orb_kpts, (kpt_num) ] implicit none BEGIN_DOC @@ -615,242 +650,273 @@ BEGIN_PROVIDER [integer, n_core_inact_act_orb_kpts, (kpt_num) ] END_PROVIDER + + +BEGIN_PROVIDER [ integer(bit_kind), core_bitmask_kpts , (N_int,2,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying the core MOs + END_DOC + integer :: k,i + core_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + core_bitmask_kpts(i,1,k) = iand(core_bitmask(i,1),kpts_bitmask(i,k)) + core_bitmask_kpts(i,2,k) = iand(core_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask_kpts , (N_int,2,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying the inactive MOs + END_DOC + integer :: k,i + inact_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + inact_bitmask_kpts(i,1,k) = iand(inact_bitmask(i,1),kpts_bitmask(i,k)) + inact_bitmask_kpts(i,2,k) = iand(inact_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), act_bitmask_kpts , (N_int,2,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying the active MOs + END_DOC + integer :: k,i + act_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + act_bitmask_kpts(i,1,k) = iand(act_bitmask(i,1),kpts_bitmask(i,k)) + act_bitmask_kpts(i,2,k) = iand(act_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask_kpts , (N_int,2,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying the virtual MOs + END_DOC + integer :: k,i + virt_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + virt_bitmask_kpts(i,1,k) = iand(virt_bitmask(i,1),kpts_bitmask(i,k)) + virt_bitmask_kpts(i,2,k) = iand(virt_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), del_bitmask_kpts , (N_int,2,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmask identifying the deleted MOs + END_DOC + integer :: k,i + del_bitmask_kpts = 0_bit_kind + do k=1,kpt_num + do i=1,N_int + del_bitmask_kpts(i,1,k) = iand(del_bitmask(i,1),kpts_bitmask(i,k)) + del_bitmask_kpts(i,2,k) = iand(del_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [ integer, list_core_kpts , (dim_list_core_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_core_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of MO indices which are in the core. + END_DOC + integer :: i, n,k,di + list_core_kpts = 0 + list_core_kpts_reverse = 0 + + do k=1,kpt_num + n=0 + di = (k-1)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+di) == 'Core')then + n += 1 + list_core_kpts(n,k) = i + list_core_kpts_reverse(i,k) = n + endif + enddo + print *, 'Core MOs: ',k + print *, list_core_kpts(1:n_core_orb_kpts(k),k) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ integer, list_inact_kpts , (dim_list_inact_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_inact_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of MO indices which are inactive. + END_DOC + integer :: i, n,k,di + list_inact_kpts = 0 + list_inact_kpts_reverse = 0 + + do k=1,kpt_num + n=0 + di = (k-1)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+di) == 'Inactive')then + n += 1 + list_inact_kpts(n,k) = i + list_inact_kpts_reverse(i,k) = n + endif + enddo + print *, 'Inactive MOs: ',k + print *, list_inact_kpts(1:n_inact_orb_kpts(k),k) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ integer, list_virt_kpts , (dim_list_virt_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_virt_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of MO indices which are virtual. + END_DOC + integer :: i, n,k,di + list_virt_kpts = 0 + list_virt_kpts_reverse = 0 + + do k=1,kpt_num + n=0 + di = (k-1)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+di) == 'Virtual')then + n += 1 + list_virt_kpts(n,k) = i + list_virt_kpts_reverse(i,k) = n + endif + enddo + print *, 'Virtual MOs: ',k + print *, list_virt_kpts(1:n_virt_orb_kpts(k),k) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ integer, list_del_kpts , (dim_list_del_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_del_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of MO indices which are deleted. + END_DOC + integer :: i, n,k,di + list_del_kpts = 0 + list_del_kpts_reverse = 0 + + do k=1,kpt_num + n=0 + di = (k-1)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+di) == 'Deleted')then + n += 1 + list_del_kpts(n,k) = i + list_del_kpts_reverse(i,k) = n + endif + enddo + print *, 'Deleted MOs: ',k + print *, list_del_kpts(1:n_del_orb_kpts(k),k) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ integer, list_act_kpts , (dim_list_act_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of MO indices which are active. + END_DOC + integer :: i, n,k,di + list_act_kpts = 0 + list_act_kpts_reverse = 0 + + do k=1,kpt_num + n=0 + di = (k-1)*mo_num_per_kpt + do i = 1, mo_num_per_kpt + if(mo_class(i+di) == 'Active')then + n += 1 + list_act_kpts(n,k) = i + list_act_kpts_reverse(i,k) = n + endif + enddo + print *, 'Active MOs: ',k + print *, list_act_kpts(1:n_act_orb_kpts(k),k) + enddo + +END_PROVIDER + !todo: finish below for kpts -! -! BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ] -! implicit none -! BEGIN_DOC -! ! Bitmask identifying the core MOs -! END_DOC -! core_bitmask = 0_bit_kind -! if(n_core_orb > 0)then -! call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int) -! call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int) -! endif -! END_PROVIDER -! -! BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ] -! implicit none -! BEGIN_DOC -! ! Bitmask identifying the inactive MOs -! END_DOC -! inact_bitmask = 0_bit_kind -! if(n_inact_orb > 0)then -! call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int) -! call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int) -! endif -! END_PROVIDER -! -! BEGIN_PROVIDER [ integer(bit_kind), act_bitmask , (N_int,2) ] -! implicit none -! BEGIN_DOC -! ! Bitmask identifying the active MOs -! END_DOC -! act_bitmask = 0_bit_kind -! if(n_act_orb > 0)then -! call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int) -! call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int) -! endif -! END_PROVIDER -! -! BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask , (N_int,2) ] -! implicit none -! BEGIN_DOC -! ! Bitmask identifying the virtual MOs -! END_DOC -! virt_bitmask = 0_bit_kind -! if(n_virt_orb > 0)then -! call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int) -! call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int) -! endif -! END_PROVIDER -! -! BEGIN_PROVIDER [ integer(bit_kind), del_bitmask , (N_int,2) ] -! implicit none -! BEGIN_DOC -! ! Bitmask identifying the deleted MOs -! END_DOC -! -! del_bitmask = 0_bit_kind -! -! if(n_del_orb > 0)then -! call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int) -! call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int) -! endif -! -! END_PROVIDER -! -! -! -! -! -! BEGIN_PROVIDER [ integer, list_core , (dim_list_core_orb) ] -!&BEGIN_PROVIDER [ integer, list_core_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of MO indices which are in the core. -! END_DOC -! integer :: i, n -! list_core = 0 -! list_core_reverse = 0 -! -! n=0 -! do i = 1, mo_num -! if(mo_class(i) == 'Core')then -! n += 1 -! list_core(n) = i -! list_core_reverse(i) = n -! endif -! enddo -! print *, 'Core MOs:' -! print *, list_core(1:n_core_orb) -! -!END_PROVIDER -! -! BEGIN_PROVIDER [ integer, list_inact , (dim_list_inact_orb) ] -!&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of MO indices which are inactive. -! END_DOC -! integer :: i, n -! list_inact = 0 -! list_inact_reverse = 0 -! -! n=0 -! do i = 1, mo_num -! if (mo_class(i) == 'Inactive')then -! n += 1 -! list_inact(n) = i -! list_inact_reverse(i) = n -! endif -! enddo -! print *, 'Inactive MOs:' -! print *, list_inact(1:n_inact_orb) -! -!END_PROVIDER -! -! BEGIN_PROVIDER [ integer, list_virt , (dim_list_virt_orb) ] -!&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of MO indices which are virtual -! END_DOC -! integer :: i, n -! list_virt = 0 -! list_virt_reverse = 0 -! -! n=0 -! do i = 1, mo_num -! if (mo_class(i) == 'Virtual')then -! n += 1 -! list_virt(n) = i -! list_virt_reverse(i) = n -! endif -! enddo -! print *, 'Virtual MOs:' -! print *, list_virt(1:n_virt_orb) -! -!END_PROVIDER -! -! BEGIN_PROVIDER [ integer, list_del , (dim_list_del_orb) ] -!&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of MO indices which are deleted. -! END_DOC -! integer :: i, n -! list_del = 0 -! list_del_reverse = 0 -! -! n=0 -! do i = 1, mo_num -! if (mo_class(i) == 'Deleted')then -! n += 1 -! list_del(n) = i -! list_del_reverse(i) = n -! endif -! enddo -! print *, 'Deleted MOs:' -! print *, list_del(1:n_del_orb) -! -!END_PROVIDER -! -! BEGIN_PROVIDER [ integer, list_act , (dim_list_act_orb) ] -!&BEGIN_PROVIDER [ integer, list_act_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of MO indices which are in the active. -! END_DOC -! integer :: i, n -! list_act = 0 -! list_act_reverse = 0 -! -! n=0 -! do i = 1, mo_num -! if (mo_class(i) == 'Active')then -! n += 1 -! list_act(n) = i -! list_act_reverse(i) = n -! endif -! enddo -! print *, 'Active MOs:' -! print *, list_act(1:n_act_orb) -! -!END_PROVIDER -! -! -! -! BEGIN_PROVIDER [ integer, list_core_inact , (dim_list_core_inact_orb) ] -!&BEGIN_PROVIDER [ integer, list_core_inact_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of indices of the core and inactive MOs -! END_DOC -! integer :: i,itmp -! call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int) -! list_core_inact_reverse = 0 -! ASSERT (itmp == n_core_inact_orb) -! do i = 1, n_core_inact_orb -! list_core_inact_reverse(list_core_inact(i)) = i -! enddo -! print *, 'Core and Inactive MOs:' -! print *, list_core_inact(1:n_core_inact_orb) -!END_PROVIDER -! -! -! BEGIN_PROVIDER [ integer, list_core_inact_act , (n_core_inact_act_orb) ] -!&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of indices of the core inactive and active MOs -! END_DOC -! integer :: i,itmp -! call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int) -! list_core_inact_act_reverse = 0 -! ASSERT (itmp == n_core_inact_act_orb) -! do i = 1, n_core_inact_act_orb -! list_core_inact_act_reverse(list_core_inact_act(i)) = i -! enddo -! print *, 'Core, Inactive and Active MOs:' -! print *, list_core_inact_act(1:n_core_inact_act_orb) -!END_PROVIDER -! -! -! BEGIN_PROVIDER [ integer, list_inact_act , (n_inact_act_orb) ] -!&BEGIN_PROVIDER [ integer, list_inact_act_reverse, (mo_num) ] -! implicit none -! BEGIN_DOC -! ! List of indices of the inactive and active MOs -! END_DOC -! integer :: i,itmp -! call bitstring_to_list(reunion_of_inact_act_bitmask(1,1), list_inact_act, itmp, N_int) -! list_inact_act_reverse = 0 -! ASSERT (itmp == n_inact_act_orb) -! do i = 1, n_inact_act_orb -! list_inact_act_reverse(list_inact_act(i)) = i -! enddo -! print *, 'Inactive and Active MOs:' -! print *, list_inact_act(1:n_inact_act_orb) -!END_PROVIDER -! + + BEGIN_PROVIDER [ integer, list_core_inact_kpts , (dim_list_core_inact_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_core_inact_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of indices of the core and inactive MOs + END_DOC + integer :: i,itmp,k + list_core_inact_kpts_reverse = 0 + do k=1,kpt_num + !call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int) + call bitstring_to_list(reunion_of_core_inact_bitmask_kpts(1,1,k), list_core_inact_kpts(1,k), itmp, N_int) + ASSERT (itmp == n_core_inact_orb_kpts(k)) + do i = 1, n_core_inact_orb_kpts(k) + list_core_inact_kpts_reverse(list_core_inact_kpts(i,k),k) = i + enddo + print *, 'Core and Inactive MOs: ',k + print *, list_core_inact_kpts(1:n_core_inact_orb_kpts(k),k) + enddo +END_PROVIDER + + + BEGIN_PROVIDER [ integer, list_core_inact_act_kpts , (dim_list_core_inact_act_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_core_inact_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of indices of the core inactive and active MOs + END_DOC + integer :: i,itmp,k + list_core_inact_act_kpts_reverse = 0 + do k=1,kpt_num + !call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int) + call bitstring_to_list(reunion_of_core_inact_act_bitmask_kpts(1,1,k), list_core_inact_act_kpts(1,k), itmp, N_int) + ASSERT (itmp == n_core_inact_act_orb_kpts(k)) + do i = 1, n_core_inact_act_orb_kpts(k) + list_core_inact_act_kpts_reverse(list_core_inact_act_kpts(i,k),k) = i + enddo + print *, 'Core, Inactive and Active MOs: ',k + print *, list_core_inact_act_kpts(1:n_core_inact_act_orb_kpts(k),k) + enddo +END_PROVIDER + + + BEGIN_PROVIDER [ integer, list_inact_act_kpts , (dim_list_inact_act_orb_kpts,kpt_num) ] +&BEGIN_PROVIDER [ integer, list_inact_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! List of indices of the inactive and active MOs + END_DOC + integer :: i,itmp,k + list_inact_act_kpts_reverse = 0 + do k=1,kpt_num + call bitstring_to_list(reunion_of_inact_act_bitmask_kpts(1,1,k), list_inact_act_kpts(1,k), itmp, N_int) + ASSERT (itmp == n_inact_act_orb_kpts(k)) + do i = 1, n_inact_act_orb_kpts(k) + list_inact_act_kpts_reverse(list_inact_act_kpts(i,k),k) = i + enddo + print *, 'Inactive and Active MOs: ',k + print *, list_inact_act_kpts(1:n_inact_act_orb_kpts(k),k) + enddo +END_PROVIDER + diff --git a/src/mo_basis/mos_cplx.irp.f b/src/mo_basis/mos_cplx.irp.f index 6b7e14c7..e25e7717 100644 --- a/src/mo_basis/mos_cplx.irp.f +++ b/src/mo_basis/mos_cplx.irp.f @@ -317,7 +317,7 @@ subroutine ao_to_mo_kpts(A_ao,LDA_ao,A_mo,LDA_mo) do k=1,kpt_num call zgemm('N','N', ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, & - (1.d0,0.d0), A_ao,LDA_ao, & + (1.d0,0.d0), A_ao(:,:,k),LDA_ao, & mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), & (0.d0,0.d0), T, size(T,1)) diff --git a/src/mo_one_e_ints/ao_to_mo_cplx.irp.f b/src/mo_one_e_ints/ao_to_mo_cplx.irp.f index 2530caf0..875d84a9 100644 --- a/src/mo_one_e_ints/ao_to_mo_cplx.irp.f +++ b/src/mo_one_e_ints/ao_to_mo_cplx.irp.f @@ -66,3 +66,81 @@ BEGIN_PROVIDER [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + +subroutine mo_to_ao_kpts(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis + ! + ! (S.C).A_mo.(S.C)t + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num_per_kpt,ao_num_per_kpt) ) + integer :: k + do k=1,kpt_num + call zgemm('N','C', mo_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, & + (1.d0,0.d0), A_mo(:,:,k),size(A_mo,1), & + S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, & + (1.d0,0.d0), S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao(:,:,k), size(A_ao,1)) + enddo + deallocate(T) +end + +subroutine mo_to_ao_no_overlap_kpts(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the S^-1 AO basis + ! Useful for density matrix + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + complex*16, intent(in) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num) + complex*16, intent(out) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num) + complex*16, allocatable :: T(:,:) + + allocate ( T(mo_num_per_kpt,ao_num_per_kpt) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + integer :: k + do k=1,kpt_num + call zgemm('N','C', mo_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, & + (1.d0,0.d0), A_mo(:,:,k),size(A_mo,1), & + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), & + (0.d0,0.d0), T, size(T,1)) + + call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, & + (1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), & + T, size(T,1), & + (0.d0,0.d0), A_ao(:,:,k), size(A_ao,1)) + enddo + deallocate(T) +end + +BEGIN_PROVIDER [ complex*16, S_mo_coef_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix. + END_DOC + + integer :: k + do k=1,kpt_num + call zgemm('N','N',ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, (1.d0,0.d0), & + ao_overlap_kpts(:,:,k), size(ao_overlap_kpts,1), & + mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), & + (0.d0,0.d0), & + S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1)) + enddo +END_PROVIDER + diff --git a/src/scf_utils/diagonalize_fock_cplx.irp.f b/src/scf_utils/diagonalize_fock_cplx.irp.f index de38c767..83d4b00f 100644 --- a/src/scf_utils/diagonalize_fock_cplx.irp.f +++ b/src/scf_utils/diagonalize_fock_cplx.irp.f @@ -94,11 +94,11 @@ BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_kpts, (ao_num_per_kpt,m ! Insert level shift here !todo: elec per kpt - do i = elec_beta_num_per_kpt(k)+1, elec_alpha_num_per_kpt(k) + do i = elec_beta_num_kpts(k)+1, elec_alpha_num_kpts(k) F(i,i) += 0.5d0*level_shift enddo - do i = elec_alpha_num_per_kpt(k)+1, mo_num_per_kpt + do i = elec_alpha_num_kpts(k)+1, mo_num_per_kpt F(i,i) += level_shift enddo diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index 94508570..6b1fc808 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -475,54 +475,58 @@ END_PROVIDER -BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_complex, (mo_num,mo_num) ] +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_alpha_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] implicit none BEGIN_DOC ! Fock matrix on the MO basis END_DOC - call ao_to_mo_complex(Fock_matrix_ao_alpha_complex,size(Fock_matrix_ao_alpha_complex,1), & - Fock_matrix_mo_alpha_complex,size(Fock_matrix_mo_alpha_complex,1)) + call ao_to_mo_kpts(Fock_matrix_ao_alpha_kpts,size(Fock_matrix_ao_alpha_kpts,1), & + Fock_matrix_mo_alpha_kpts,size(Fock_matrix_mo_alpha_kpts,1)) END_PROVIDER -BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_complex, (mo_num,mo_num) ] +BEGIN_PROVIDER [ complex*16, Fock_matrix_mo_beta_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] implicit none BEGIN_DOC ! Fock matrix on the MO basis END_DOC - call ao_to_mo_complex(Fock_matrix_ao_beta_complex,size(Fock_matrix_ao_beta_complex,1), & - Fock_matrix_mo_beta_complex,size(Fock_matrix_mo_beta_complex,1)) + call ao_to_mo_kpts(Fock_matrix_ao_beta_kpts,size(Fock_matrix_ao_beta_kpts,1), & + Fock_matrix_mo_beta_kpts,size(Fock_matrix_mo_beta_kpts,1)) END_PROVIDER -BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_complex, (ao_num, ao_num) ] +BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_kpts, (ao_num_per_kpt, ao_num_per_kpt,kpt_num) ] implicit none BEGIN_DOC ! Fock matrix in AO basis set END_DOC if(frozen_orb_scf)then - call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & - Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) + call mo_to_ao_kpts(Fock_matrix_mo_kpts,size(Fock_matrix_mo_kpts,1), & + Fock_matrix_ao_kpts,size(Fock_matrix_ao_kpts,1)) else - if ( (elec_alpha_num == elec_beta_num).and. & - (level_shift == 0.) ) & - then - integer :: i,j - do j=1,ao_num - do i=1,ao_num - Fock_matrix_ao_complex(i,j) = Fock_matrix_ao_alpha_complex(i,j) + integer :: k + do k=1,kpt_num + if ( (elec_alpha_num_kpts(k) == elec_beta_num_kpts(k)).and. & + (level_shift == 0.) ) & + then + integer :: i,j + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + Fock_matrix_ao_kpts(i,j,k) = Fock_matrix_ao_alpha_kpts(i,j,k) + enddo enddo - enddo - else - call mo_to_ao_complex(Fock_matrix_mo_complex,size(Fock_matrix_mo_complex,1), & - Fock_matrix_ao_complex,size(Fock_matrix_ao_complex,1)) - endif + else + !call mo_to_ao_complex(Fock_matrix_mo_kpts,size(Fock_matrix_mo_kpts,1), & + call mo_to_ao_kpts(Fock_matrix_mo_kpts,size(Fock_matrix_mo_kpts,1), & + Fock_matrix_ao_kpts,size(Fock_matrix_ao_kpts,1)) + endif + enddo endif END_PROVIDER - BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_complex, (ao_num, ao_num) ] -&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_complex , (ao_num, ao_num) ] + BEGIN_PROVIDER [ complex*16, ao_two_e_integral_alpha_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] +&BEGIN_PROVIDER [ complex*16, ao_two_e_integral_beta_kpts , (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] use map_module implicit none BEGIN_DOC @@ -534,11 +538,11 @@ END_PROVIDER integer :: i0,j0,k0,l0 integer*8 :: p,q complex*16 :: integral, c0 - complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:) - complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:) + complex*16, allocatable :: ao_two_e_integral_alpha_tmp(:,:,:) + complex*16, allocatable :: ao_two_e_integral_beta_tmp(:,:,:) - ao_two_e_integral_alpha_complex = (0.d0,0.d0) - ao_two_e_integral_beta_complex = (0.d0,0.d0) + ao_two_e_integral_alpha_kpts = (0.d0,0.d0) + ao_two_e_integral_beta_kpts = (0.d0,0.d0) PROVIDE ao_two_e_integrals_in_map integer(omp_lock_kind) :: lck(ao_num) @@ -549,19 +553,21 @@ END_PROVIDER double precision, allocatable :: values(:) complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) integer(key_kind) :: key1 + integer :: kpt_i,kpt_j,kpt_k,kpt_l,idx_i,idx_j,idx_k,idx_l !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP kpt_i,kpt_j,kpt_k,kpt_l,idx_i,idx_j,idx_k,idx_l, & !$OMP c0,key1)& - !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex, & - !$OMP ao_integrals_map, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + !$OMP SHARED(ao_num_per_kpt,SCF_density_matrix_ao_alpha_kpts, kpt_num, irp_here, & + !$OMP SCF_density_matrix_ao_beta_kpts, & + !$OMP ao_integrals_map, ao_two_e_integral_alpha_kpts, ao_two_e_integral_beta_kpts) call get_cache_map_n_elements_max(ao_integrals_map,n_elements_max) allocate(keys(n_elements_max), values(n_elements_max)) - allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & - ao_two_e_integral_beta_tmp(ao_num,ao_num)) + allocate(ao_two_e_integral_alpha_tmp(ao_num_per_kpt,ao_num_per_kpt,kpt_num), & + ao_two_e_integral_beta_tmp(ao_num_per_kpt,ao_num_per_kpt,kpt_num)) ao_two_e_integral_alpha_tmp = (0.d0,0.d0) ao_two_e_integral_beta_tmp = (0.d0,0.d0) @@ -587,6 +593,14 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) + kpt_i = (i-1)/kpt_num +1 + kpt_j = (j-1)/kpt_num +1 + kpt_k = (k-1)/kpt_num +1 + kpt_l = (l-1)/kpt_num +1 + idx_i = mod(i,kpt_num) + idx_j = mod(j,kpt_num) + idx_k = mod(k,kpt_num) + idx_l = mod(l,kpt_num) integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -594,13 +608,24 @@ END_PROVIDER !G_a(i,l) -= D_a (k,j)*() !G_b(i,l) -= D_b (k,j)*() - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + if (kpt_l.eq.kpt_j) then + c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral + if(kpt_i.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 + ao_two_e_integral_beta_tmp (idx_i,idx_k,kpt_i) += c0 + endif - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + if (kpt_l.eq.kpt_i) then + if(kpt_j.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral + ao_two_e_integral_beta_tmp (idx_i,idx_l,kpt_i) -= scf_density_matrix_ao_beta_kpts (idx_k,idx_j,kpt_j) * integral + endif enddo else ! real part do k2=1,4 @@ -611,23 +636,42 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) + kpt_i = (i-1)/kpt_num +1 + kpt_j = (j-1)/kpt_num +1 + kpt_k = (k-1)/kpt_num +1 + kpt_l = (l-1)/kpt_num +1 + idx_i = mod(i,kpt_num) + idx_j = mod(j,kpt_num) + idx_k = mod(k,kpt_num) + idx_l = mod(l,kpt_num) integral = values(k1) - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + if (kpt_l.eq.kpt_j) then + c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral + if(kpt_i.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 + ao_two_e_integral_beta_tmp (idx_i,idx_k,kpt_i) += c0 + endif - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + if (kpt_l.eq.kpt_i) then + if(kpt_j.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral + ao_two_e_integral_beta_tmp (idx_i,idx_l,kpt_i) -= scf_density_matrix_ao_beta_kpts (idx_k,idx_j,kpt_j) * integral + endif enddo endif enddo enddo !$OMP END DO NOWAIT !$OMP CRITICAL - ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp - ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + ao_two_e_integral_alpha_kpts += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_kpts += ao_two_e_integral_beta_tmp !$OMP END CRITICAL deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) !$OMP END PARALLEL @@ -636,15 +680,16 @@ END_PROVIDER !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i,j,l,k1,k,integral,ii,jj,kk,ll,i8,keys,values,n_elements_max, & !$OMP n_elements,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp, & + !$OMP kpt_i,kpt_j,kpt_k,kpt_l,idx_i,idx_j,idx_k,idx_l, & !$OMP c0,key1)& - !$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha_complex, & - !$OMP SCF_density_matrix_ao_beta_complex, & - !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_complex, ao_two_e_integral_beta_complex) + !$OMP SHARED(ao_num_per_kpt,SCF_density_matrix_ao_alpha_kpts,kpt_num, irp_here, & + !$OMP SCF_density_matrix_ao_beta_kpts, & + !$OMP ao_integrals_map_2, ao_two_e_integral_alpha_kpts, ao_two_e_integral_beta_kpts) call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) allocate(keys(n_elements_max), values(n_elements_max)) - allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), & - ao_two_e_integral_beta_tmp(ao_num,ao_num)) + allocate(ao_two_e_integral_alpha_tmp(ao_num_per_kpt,ao_num_per_kpt,kpt_num), & + ao_two_e_integral_beta_tmp(ao_num_per_kpt,ao_num_per_kpt,kpt_num)) ao_two_e_integral_alpha_tmp = (0.d0,0.d0) ao_two_e_integral_beta_tmp = (0.d0,0.d0) @@ -669,6 +714,14 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) + kpt_i = (i-1)/kpt_num +1 + kpt_j = (j-1)/kpt_num +1 + kpt_k = (k-1)/kpt_num +1 + kpt_l = (l-1)/kpt_num +1 + idx_i = mod(i,kpt_num) + idx_j = mod(j,kpt_num) + idx_k = mod(k,kpt_num) + idx_l = mod(l,kpt_num) integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -676,13 +729,24 @@ END_PROVIDER !G_a(i,l) -= D_a (k,j)*() !G_b(i,l) -= D_b (k,j)*() - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + if (kpt_l.eq.kpt_j) then + c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral + if(kpt_i.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 + ao_two_e_integral_beta_tmp (idx_i,idx_k,kpt_i) += c0 + endif - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + if (kpt_l.eq.kpt_i) then + if(kpt_j.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral + ao_two_e_integral_beta_tmp (idx_i,idx_l,kpt_i) -= scf_density_matrix_ao_beta_kpts (idx_k,idx_j,kpt_j) * integral + endif enddo else ! real part do k2=1,4 @@ -693,23 +757,42 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) + kpt_i = (i-1)/kpt_num +1 + kpt_j = (j-1)/kpt_num +1 + kpt_k = (k-1)/kpt_num +1 + kpt_l = (l-1)/kpt_num +1 + idx_i = mod(i,kpt_num) + idx_j = mod(j,kpt_num) + idx_k = mod(k,kpt_num) + idx_l = mod(l,kpt_num) integral = values(k1) - c0 = (scf_density_matrix_ao_alpha_complex(l,j)+scf_density_matrix_ao_beta_complex(l,j)) * integral + if (kpt_l.eq.kpt_j) then + c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral + if(kpt_i.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 + ao_two_e_integral_beta_tmp (idx_i,idx_k,kpt_i) += c0 + endif - ao_two_e_integral_alpha_tmp(i,k) += c0 - ao_two_e_integral_beta_tmp (i,k) += c0 - - ao_two_e_integral_alpha_tmp(i,l) -= SCF_density_matrix_ao_alpha_complex(k,j) * integral - ao_two_e_integral_beta_tmp (i,l) -= scf_density_matrix_ao_beta_complex (k,j) * integral + if (kpt_l.eq.kpt_i) then + if(kpt_j.ne.kpt_k) then + print*,'problem in ',irp_here + stop 1 + endif + ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral + ao_two_e_integral_beta_tmp (idx_i,idx_l,kpt_i) -= scf_density_matrix_ao_beta_kpts (idx_k,idx_j,kpt_j) * integral + endif enddo endif enddo enddo !$OMP END DO NOWAIT !$OMP CRITICAL - ao_two_e_integral_alpha_complex += ao_two_e_integral_alpha_tmp - ao_two_e_integral_beta_complex += ao_two_e_integral_beta_tmp + ao_two_e_integral_alpha_kpts += ao_two_e_integral_alpha_tmp + ao_two_e_integral_beta_kpts += ao_two_e_integral_beta_tmp !$OMP END CRITICAL deallocate(keys,values,ao_two_e_integral_alpha_tmp,ao_two_e_integral_beta_tmp) !$OMP END PARALLEL @@ -717,18 +800,20 @@ END_PROVIDER END_PROVIDER - BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_complex, (ao_num, ao_num) ] -&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_complex, (ao_num, ao_num) ] + BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_alpha_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] +&BEGIN_PROVIDER [ complex*16, Fock_matrix_ao_beta_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] implicit none BEGIN_DOC ! Alpha Fock matrix in AO basis set END_DOC - integer :: i,j - do j=1,ao_num - do i=1,ao_num - Fock_matrix_ao_alpha_complex(i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_alpha_complex(i,j) - Fock_matrix_ao_beta_complex (i,j) = ao_one_e_integrals_complex(i,j) + ao_two_e_integral_beta_complex (i,j) + integer :: i,j,k + do k=1,kpt_num + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + Fock_matrix_ao_alpha_kpts(i,j,k) = ao_one_e_integrals_kpts(i,j,k) + ao_two_e_integral_alpha_kpts(i,j,k) + Fock_matrix_ao_beta_kpts (i,j,k) = ao_one_e_integrals_kpts(i,j,k) + ao_two_e_integral_beta_kpts (i,j,k) + enddo enddo enddo diff --git a/src/scf_utils/scf_density_matrix_ao_cplx.irp.f b/src/scf_utils/scf_density_matrix_ao_cplx.irp.f index a6a66863..9726690c 100644 --- a/src/scf_utils/scf_density_matrix_ao_cplx.irp.f +++ b/src/scf_utils/scf_density_matrix_ao_cplx.irp.f @@ -73,3 +73,54 @@ BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_complex, (ao_num,ao_num) ] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_alpha_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! $C.C^t$ over $\alpha$ MOs + END_DOC + + integer :: k + do k=1,kpt_num + call zgemm('N','C',ao_num_per_kpt,ao_num_per_kpt,elec_alpha_num_kpts(k),(1.d0,0.d0), & + mo_coef_kpts(1,1,k), size(mo_coef_kpts,1), & + mo_coef_kpts(1,1,k), size(mo_coef_kpts,1), (0.d0,0.d0), & + scf_density_matrix_ao_alpha_kpts(1,1,k), size(scf_density_matrix_ao_alpha_kpts,1)) + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_beta_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! $C.C^t$ over $\beta$ MOs + END_DOC + + integer :: k + do k=1,kpt_num + call zgemm('N','C',ao_num_per_kpt,ao_num_per_kpt,elec_beta_num_kpts(k),(1.d0,0.d0), & + mo_coef_kpts(1,1,k), size(mo_coef_kpts,1), & + mo_coef_kpts(1,1,k), size(mo_coef_kpts,1), (0.d0,0.d0), & + scf_density_matrix_ao_beta_kpts(1,1,k), size(scf_density_matrix_ao_beta_kpts,1)) + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, scf_density_matrix_ao_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! Sum of $\alpha$ and $\beta$ density matrices + END_DOC + ASSERT (size(scf_density_matrix_ao_kpts,1) == size(scf_density_matrix_ao_alpha_kpts,1)) + if (elec_alpha_num== elec_beta_num) then + scf_density_matrix_ao_kpts = scf_density_matrix_ao_alpha_kpts + scf_density_matrix_ao_alpha_kpts + else + ASSERT (size(scf_density_matrix_ao_kpts,1) == size(scf_density_matrix_ao_beta_kpts ,1)) + scf_density_matrix_ao_kpts = scf_density_matrix_ao_alpha_kpts + scf_density_matrix_ao_beta_kpts + endif + +END_PROVIDER + From a0eb1d34db47b2e5f92ff977201dc268a7049c95 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 18 Mar 2020 16:30:27 -0500 Subject: [PATCH 159/256] scf kpts --- src/mo_basis/EZFIO.cfg | 12 +++++++ src/mo_basis/utils.irp.f | 22 ++++++++----- src/mo_one_e_ints/EZFIO.cfg | 24 ++++++++++++++ src/mo_one_e_ints/kin_mo_ints_cplx.irp.f | 33 +++++++++++++++++++ src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f | 33 +++++++++++++++++++ src/mo_one_e_ints/pot_mo_ints_cplx.irp.f | 31 +++++++++++++++++ .../pot_mo_pseudo_ints_cplx.irp.f | 31 +++++++++++++++++ src/scf_utils/fock_matrix_cplx.irp.f | 2 +- src/scf_utils/huckel_cplx.irp.f | 2 +- 9 files changed, 179 insertions(+), 11 deletions(-) diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index ee915b1c..76ee15e9 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -15,6 +15,12 @@ doc: Complex MO coefficient of the i-th |AO| on the j-th |MO| interface: ezfio size: (2,ao_basis.ao_num,mo_basis.mo_num) +[mo_coef_kpts] +type: double precision +doc: Complex MO coefficient of the i-th |AO| on the j-th |MO| +interface: ezfio +size: (2,ao_basis.ao_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) + [mo_label] type: character*(64) doc: Label characterizing the MOS (Local, Canonical, Natural, *etc*) @@ -26,6 +32,12 @@ doc: |MO| occupation numbers interface: ezfio size: (mo_basis.mo_num) +[mo_occ_kpts] +type: double precision +doc: |MO| occupation numbers +interface: ezfio +size: (mo_basis.mo_num_per_kpt,nuclei.kpt_num) + [mo_class] type: MO_class doc: [ Core | Inactive | Active | Virtual | Deleted ], as defined by :ref:`qp_set_mo_class` diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 5f93bb2f..5d94e853 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -1,8 +1,8 @@ subroutine save_mos implicit none double precision, allocatable :: buffer(:,:) - complex*16, allocatable :: buffer_c(:,:) - integer :: i,j + complex*16, allocatable :: buffer_c(:,:),buffer_k(:,:,:) + integer :: i,j,k !TODO: change this for periodic? ! save real/imag parts of mo_coef_complex ! otherwise need to make sure mo_coef and mo_coef_imag @@ -13,14 +13,18 @@ subroutine save_mos call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then allocate ( buffer_c(ao_num,mo_num)) - buffer_c = (0.d0,0.d0) - do j = 1, mo_num - do i = 1, ao_num - buffer_c(i,j) = mo_coef_complex(i,j) + allocate ( buffer_k(ao_num_per_kpt,mo_num_per_kpt,kpt_num)) + buffer_k = (0.d0,0.d0) + do k=1,kpt_num + do j = 1, mo_num_per_kpt + do i = 1, ao_num_per_kpt + buffer_k(i,j,k) = mo_coef_kpts(i,j,k) + enddo enddo enddo - call ezfio_set_mo_basis_mo_coef_complex(buffer_c) - deallocate (buffer_c) + call ezfio_set_mo_basis_mo_coef_kpts(buffer_k) + deallocate (buffer_k) + call ezfio_set_mo_basis_mo_occ_kpts(mo_occ_kpts) else allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 @@ -31,8 +35,8 @@ subroutine save_mos enddo call ezfio_set_mo_basis_mo_coef(buffer) deallocate (buffer) + call ezfio_set_mo_basis_mo_occ(mo_occ) endif - call ezfio_set_mo_basis_mo_occ(mo_occ) call ezfio_set_mo_basis_mo_class(mo_class) end diff --git a/src/mo_one_e_ints/EZFIO.cfg b/src/mo_one_e_ints/EZFIO.cfg index d70e4d19..bd60ca16 100644 --- a/src/mo_one_e_ints/EZFIO.cfg +++ b/src/mo_one_e_ints/EZFIO.cfg @@ -10,6 +10,12 @@ doc: Complex nucleus-electron integrals in |MO| basis set size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_e_n_kpts] +type: double precision +doc: Complex nucleus-electron integrals in |MO| basis set +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_mo_integrals_e_n] type: Disk_access doc: Read/Write |MO| electron-nucleus attraction integrals from/to disk [ Write | Read | None ] @@ -29,6 +35,12 @@ doc: Complex kinetic energy integrals in |MO| basis set size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_kinetic_kpts] +type: double precision +doc: Complex kinetic energy integrals in |MO| basis set +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_mo_integrals_kinetic] type: Disk_access doc: Read/Write |MO| one-electron kinetic integrals from/to disk [ Write | Read | None ] @@ -48,6 +60,12 @@ doc: Complex pseudopotential integrals in |MO| basis set size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_integrals_pseudo_kpts] +type: double precision +doc: Complex pseudopotential integrals in |MO| basis set +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_mo_integrals_pseudo] type: Disk_access doc: Read/Write |MO| pseudopotential integrals from/to disk [ Write | Read | None ] @@ -67,6 +85,12 @@ doc: Complex one-electron integrals in |MO| basis set size: (2,mo_basis.mo_num,mo_basis.mo_num) interface: ezfio +[mo_one_e_integrals_kpts] +type: double precision +doc: Complex one-electron integrals in |MO| basis set +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) +interface: ezfio + [io_mo_one_e_integrals] type: Disk_access doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ] diff --git a/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f b/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f index 511ccc78..dfef7801 100644 --- a/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints_cplx.irp.f @@ -25,3 +25,36 @@ BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the MO basis + END_DOC + integer :: i,j + + print *, 'Providing MO kinetic integrals' + if (read_mo_integrals_kinetic) then + call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_kpts(mo_kinetic_integrals_kpts) + print *, 'MO kinetic integrals read from disk' + else + print *, 'Providing MO kinetic integrals from AO kinetic integrals' + call ao_to_mo_kpts( & + ao_kinetic_integrals_kpts, & + size(ao_kinetic_integrals_kpts,1), & + mo_kinetic_integrals_kpts, & + size(mo_kinetic_integrals_kpts,1) & + ) + endif + if (write_mo_integrals_kinetic) then + call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_kpts(mo_kinetic_integrals_kpts) + print *, 'MO kinetic integrals written to disk' + endif + +END_PROVIDER + diff --git a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f index d4546af7..7a9568c9 100644 --- a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f @@ -26,3 +26,36 @@ BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_kpts,(mo_num_per_kpt,mo_num_per_kpt,kpt_num)] + implicit none + integer :: i,j,n,l + BEGIN_DOC + ! array of the one-electron Hamiltonian on the |MO| basis : + ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed) + END_DOC + print*,'Providing the one-electron integrals' + + IF (read_mo_one_e_integrals) THEN + call ezfio_get_mo_one_e_ints_mo_one_e_integrals_kpts(mo_one_e_integrals_kpts) + ELSE + mo_one_e_integrals_kpts = mo_integrals_n_e_kpts + mo_kinetic_integrals_kpts + + IF (do_pseudo) THEN + mo_one_e_integrals_kpts += mo_pseudo_integrals_kpts + ENDIF + + ENDIF + + IF (write_mo_one_e_integrals) THEN + call ezfio_set_mo_one_e_ints_mo_one_e_integrals_kpts(mo_one_e_integrals_kpts) + print *, 'MO one-e integrals written to disk' + ENDIF + print*,'Provided the one-electron integrals' + +END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f index 8f9c1660..a9f793d9 100644 --- a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f @@ -25,4 +25,35 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! +BEGIN_PROVIDER [complex*16, mo_integrals_n_e_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Kinetic energy integrals in the MO basis + END_DOC + integer :: i,j + + print *, 'Providing MO N-e integrals' + if (read_mo_integrals_e_n) then + call ezfio_get_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts) + print *, 'MO N-e integrals read from disk' + else + print *, 'Providing MO N-e integrals from AO N-e integrals' + call ao_to_mo_kpts( & + ao_integrals_n_e_kpts, & + size(ao_integrals_n_e_kpts,1), & + mo_integrals_n_e_kpts, & + size(mo_integrals_n_e_kpts,1) & + ) + endif + if (write_mo_integrals_e_n) then + call ezfio_set_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts) + print *, 'MO N-e integrals written to disk' + endif + +END_PROVIDER diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f index 18a4e920..ca71a995 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f @@ -25,4 +25,35 @@ BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)] END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! +BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Pseudopotential integrals in |MO| basis + END_DOC + integer :: i,j + + if (read_mo_integrals_pseudo) then + call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_kpts(mo_pseudo_integrals_kpts) + print *, 'MO pseudopotential integrals read from disk' + else if (do_pseudo) then + call ao_to_mo_kpts( & + ao_pseudo_integrals_kpts, & + size(ao_pseudo_integrals_kpts,1), & + mo_pseudo_integrals_kpts, & + size(mo_pseudo_integrals_kpts,1) & + ) + else + mo_pseudo_integrals_kpts = (0.d0,0.d0) + endif + if (write_mo_integrals_pseudo) then + call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_kpts(mo_pseudo_integrals_kpts) + print *, 'MO pseudopotential integrals written to disk' + endif + +END_PROVIDER diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index 6b1fc808..afa21072 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -543,7 +543,7 @@ END_PROVIDER ao_two_e_integral_alpha_kpts = (0.d0,0.d0) ao_two_e_integral_beta_kpts = (0.d0,0.d0) - PROVIDE ao_two_e_integrals_in_map + PROVIDE ao_two_e_integrals_in_map scf_density_matrix_ao_alpha_kpts scf_density_matrix_ao_beta_kpts integer(omp_lock_kind) :: lck(ao_num) integer(map_size_kind) :: i8 diff --git a/src/scf_utils/huckel_cplx.irp.f b/src/scf_utils/huckel_cplx.irp.f index a41ed831..ec504d14 100644 --- a/src/scf_utils/huckel_cplx.irp.f +++ b/src/scf_utils/huckel_cplx.irp.f @@ -84,7 +84,7 @@ subroutine huckel_guess_kpts !TOUCH fock_matrix_ao_alpha_complex fock_matrix_ao_beta_kpts TOUCH fock_matrix_ao_alpha_kpts fock_matrix_ao_beta_kpts mo_coef_kpts = eigenvectors_fock_matrix_mo_kpts - SOFT_TOUCH mo_coef_complex + SOFT_TOUCH mo_coef_kpts call save_mos deallocate(A) From d0fe9aad4f97fb033602ab28fe4b312d6bb50b73 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 20 Mar 2020 12:22:10 -0500 Subject: [PATCH 160/256] scf kpts --- src/ao_one_e_ints/ao_overlap.irp.f | 108 ++++ src/bitmask/track_orb.irp.f | 104 +++- src/hartree_fock/hf_energy.irp.f | 16 +- src/hartree_fock/scf.irp.f | 3 +- src/mo_basis/utils_cplx.irp.f | 20 +- src/mo_one_e_ints/EZFIO.cfg | 12 + src/mo_one_e_ints/mo_overlap.irp.f | 54 ++ src/mo_one_e_ints/orthonormalize.irp.f | 12 +- src/scf_utils/diagonalize_fock_cplx.irp.f | 4 +- src/scf_utils/diis_cplx.irp.f | 152 +++++ src/scf_utils/fock_matrix.irp.f | 14 +- src/scf_utils/fock_matrix_cplx.irp.f | 80 +-- src/scf_utils/roothaan_hall_scf_cplx.irp.f | 334 +++++++++++ src/utils_complex/MolPyscfToQPkpts.py | 10 +- .../create_ezfio_complex_3idx.py | 553 ++++++++++++------ 15 files changed, 1193 insertions(+), 283 deletions(-) diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 2e1695a7..9877f882 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -209,6 +209,18 @@ BEGIN_PROVIDER [ complex*16, S_inv_complex,(ao_num,ao_num) ] size(ao_overlap_complex,1),ao_num,ao_num,S_inv_complex,size(S_inv_complex,1)) END_PROVIDER +BEGIN_PROVIDER [ complex*16, S_inv_kpts,(ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC +! Inverse of the overlap matrix + END_DOC + integer :: k + do k=1,kpt_num + call get_pseudo_inverse_complex(ao_overlap_kpts(1,1,k), & + size(ao_overlap_kpts,1),ao_num_per_kpt,ao_num_per_kpt,S_inv_kpts(1,1,k),size(S_inv_kpts,1)) + enddo +END_PROVIDER + BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ] BEGIN_DOC @@ -326,6 +338,66 @@ BEGIN_PROVIDER [ complex*16, S_half_inv_complex, (AO_num,AO_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, S_half_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + + BEGIN_DOC +! :math:`X = S^{-1/2}` obtained by SVD + END_DOC + + implicit none + + integer :: num_linear_dependencies + integer :: LDA, LDC + double precision, allocatable :: D(:) + complex*16, allocatable :: U(:,:),Vt(:,:) + integer :: info, i, j, k,kk + double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6 + + LDA = size(ao_overlap_kpts,1) + LDC = size(s_half_inv_kpts,1) + + allocate( & + U(LDC,ao_num_per_kpt), & + Vt(LDA,ao_num_per_kpt), & + D(ao_num_per_kpt)) + + do kk=1,kpt_num + call svd_complex( & + ao_overlap_kpts(1,1,kk),LDA, & + U,LDC, & + D, & + Vt,LDA, & + ao_num_per_kpt,ao_num_per_kpt) + + num_linear_dependencies = 0 + do i=1,ao_num_per_kpt + print*,D(i) + if(abs(D(i)) <= threshold_overlap_AO_eigenvalues) then + D(i) = 0.d0 + num_linear_dependencies += 1 + else + ASSERT (D(i) > 0.d0) + D(i) = 1.d0/sqrt(D(i)) + endif + do j=1,ao_num_per_kpt + S_half_inv_kpts(j,i,kk) = 0.d0 + enddo + enddo + write(*,*) 'linear dependencies, k: ',num_linear_dependencies,', ',kk + + do k=1,ao_num_per_kpt + if(D(k) /= 0.d0) then + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + S_half_inv_kpts(i,j,kk) = S_half_inv_kpts(i,j,kk) + U(i,k)*D(k)*Vt(k,j) + enddo + enddo + endif + enddo + enddo + +END_PROVIDER + BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ] implicit none @@ -395,3 +467,39 @@ BEGIN_PROVIDER [ complex*16, S_half_complex, (ao_num,ao_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, S_half_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! :math:`S^{1/2}` + END_DOC + + integer :: i,j,k,kk + complex*16, allocatable :: U(:,:) + complex*16, allocatable :: Vt(:,:) + double precision, allocatable :: D(:) + + allocate(U(ao_num_per_kpt,ao_num_per_kpt),Vt(ao_num_per_kpt,ao_num_per_kpt),D(ao_num_per_kpt)) + + do kk=1,kpt_num + call svd_complex(ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1),U,size(U,1),D,Vt,size(Vt,1),ao_num_per_kpt,ao_num_per_kpt) + + do i=1,ao_num_per_kpt + D(i) = dsqrt(D(i)) + do j=1,ao_num_per_kpt + S_half_kpts(j,i,kk) = (0.d0,0.d0) + enddo + enddo + + do k=1,ao_num_per_kpt + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + S_half_kpts(i,j,kk) = S_half_kpts(i,j,kk) + U(i,k)*D(k)*Vt(k,j) + enddo + enddo + enddo + enddo + + deallocate(U,Vt,D) + +END_PROVIDER + diff --git a/src/bitmask/track_orb.irp.f b/src/bitmask/track_orb.irp.f index 73bf78f3..9e96cca5 100644 --- a/src/bitmask/track_orb.irp.f +++ b/src/bitmask/track_orb.irp.f @@ -16,6 +16,15 @@ BEGIN_PROVIDER [ complex*16, mo_coef_begin_iteration_complex, (ao_num,mo_num) ] END_DOC END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_coef_begin_iteration_kpts, (ao_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration + ! + ! Useful to track some orbitals + END_DOC +END_PROVIDER + subroutine initialize_mo_coef_begin_iteration implicit none BEGIN_DOC @@ -23,7 +32,8 @@ subroutine initialize_mo_coef_begin_iteration ! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef` END_DOC if (is_complex) then - mo_coef_begin_iteration_complex = mo_coef_complex + !mo_coef_begin_iteration_complex = mo_coef_complex + mo_coef_begin_iteration_kpts = mo_coef_kpts else mo_coef_begin_iteration = mo_coef endif @@ -42,37 +52,71 @@ subroutine reorder_core_orb integer :: i1,i2 if (is_complex) then complex*16, allocatable :: accu_c(:) - allocate(accu(mo_num),accu_c(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) - do i = 1, n_core_orb - iorb = list_core(i) - do j = 1, mo_num - accu(j) = 0.d0 - accu_c(j) = (0.d0,0.d0) - iorder(j) = j - do k = 1, ao_num - do l = 1, ao_num - accu_c(j) += dconjg(mo_coef_begin_iteration_complex(k,iorb)) * & - mo_coef_complex(l,j) * ao_overlap_complex(k,l) - enddo - enddo - accu(j) = -cdabs(accu_c(j)) - enddo - call dsort(accu,iorder,mo_num) - index_core_orb(i) = iorder(1) - enddo + !allocate(accu(mo_num),accu_c(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) + !do i = 1, n_core_orb + ! iorb = list_core(i) + ! do j = 1, mo_num + ! accu(j) = 0.d0 + ! accu_c(j) = (0.d0,0.d0) + ! iorder(j) = j + ! do k = 1, ao_num + ! do l = 1, ao_num + ! accu_c(j) += dconjg(mo_coef_begin_iteration_complex(k,iorb)) * & + ! mo_coef_complex(l,j) * ao_overlap_complex(k,l) + ! enddo + ! enddo + ! accu(j) = -cdabs(accu_c(j)) + ! enddo + ! call dsort(accu,iorder,mo_num) + ! index_core_orb(i) = iorder(1) + !enddo - complex*16 :: x_c - do j = 1, n_core_orb - i1 = list_core(j) - i2 = index_core_orb(j) - do i=1,ao_num - x_c = mo_coef_complex(i,i1) - mo_coef_complex(i,i1) = mo_coef_complex(i,i2) - mo_coef_complex(i,i2) = x_c - enddo - enddo - !call loc_cele_routine + !complex*16 :: x_c + !do j = 1, n_core_orb + ! i1 = list_core(j) + ! i2 = index_core_orb(j) + ! do i=1,ao_num + ! x_c = mo_coef_complex(i,i1) + ! mo_coef_complex(i,i1) = mo_coef_complex(i,i2) + ! mo_coef_complex(i,i2) = x_c + ! enddo + !enddo + !!call loc_cele_routine + !deallocate(accu,accu_c,index_core_orb, iorder) + allocate(accu(mo_num_per_kpt),accu_c(mo_num_per_kpt),index_core_orb(n_core_orb),iorder(mo_num_per_kpt)) + integer :: kk + do kk=1,kpt_num + do i = 1, n_core_orb_kpts(kk) + iorb = list_core_kpts(i,kk) + do j = 1, mo_num_per_kpt + accu(j) = 0.d0 + accu_c(j) = (0.d0,0.d0) + iorder(j) = j + do k = 1, ao_num_per_kpt + do l = 1, ao_num_per_kpt + accu_c(j) += dconjg(mo_coef_begin_iteration_kpts(k,iorb,kk)) * & + mo_coef_kpts(l,j,kk) * ao_overlap_kpts(k,l,kk) + enddo + enddo + accu(j) = -cdabs(accu_c(j)) + enddo + call dsort(accu,iorder,mo_num_per_kpt) + index_core_orb(i) = iorder(1) + enddo + + complex*16 :: x_c + do j = 1, n_core_orb + i1 = list_core_kpts(j,kk) + i2 = index_core_orb(j) + do i=1,ao_num_per_kpt + x_c = mo_coef_kpts(i,i1,kk) + mo_coef_kpts(i,i1,kk) = mo_coef_kpts(i,i2,kk) + mo_coef_kpts(i,i2,kk) = x_c + enddo + enddo + !call loc_cele_routine + enddo deallocate(accu,accu_c,index_core_orb, iorder) else allocate(accu(mo_num),index_core_orb(n_core_orb),iorder(mo_num)) diff --git a/src/hartree_fock/hf_energy.irp.f b/src/hartree_fock/hf_energy.irp.f index 9a5e6d1d..5a68164f 100644 --- a/src/hartree_fock/hf_energy.irp.f +++ b/src/hartree_fock/hf_energy.irp.f @@ -18,7 +18,7 @@ END_PROVIDER BEGIN_DOC ! Hartree-Fock energy containing the nuclear repulsion, and its one- and two-body components. END_DOC - integer :: i,j + integer :: i,j,k hf_energy = nuclear_repulsion hf_two_electron_energy = 0.d0 hf_one_electron_energy = 0.d0 @@ -26,12 +26,14 @@ END_PROVIDER complex*16 :: hf_1e_tmp, hf_2e_tmp hf_1e_tmp = (0.d0,0.d0) hf_2e_tmp = (0.d0,0.d0) - do j=1,ao_num - do i=1,ao_num - hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_complex(i,j) * scf_density_matrix_ao_alpha_complex(j,i) & - +ao_two_e_integral_beta_complex(i,j) * scf_density_matrix_ao_beta_complex(j,i) ) - hf_1e_tmp += ao_one_e_integrals_complex(i,j) * (scf_density_matrix_ao_alpha_complex(j,i) & - + scf_density_matrix_ao_beta_complex (j,i) ) + do k=1,kpt_num + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_kpts(i,j,k) * scf_density_matrix_ao_alpha_kpts(j,i,k) & + +ao_two_e_integral_beta_kpts(i,j,k) * scf_density_matrix_ao_beta_kpts(j,i,k) ) + hf_1e_tmp += ao_one_e_integrals_kpts(i,j,k) * (scf_density_matrix_ao_alpha_kpts(j,i,k) & + + scf_density_matrix_ao_beta_kpts (j,i,k) ) + enddo enddo enddo if (dabs(dimag(hf_2e_tmp)).gt.1.d-10) then diff --git a/src/hartree_fock/scf.irp.f b/src/hartree_fock/scf.irp.f index 9d1671ec..8e438613 100644 --- a/src/hartree_fock/scf.irp.f +++ b/src/hartree_fock/scf.irp.f @@ -102,7 +102,8 @@ subroutine run mo_label = "Orthonormalized" if (is_complex) then - call roothaan_hall_scf_complex + !call roothaan_hall_scf_complex + call roothaan_hall_scf_kpts else call roothaan_hall_scf endif diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index 58230cdd..13327f57 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -52,11 +52,11 @@ subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output) enddo write (6,'(A)') '======== ================' write (6,'(A)') '' - write (6,'(A)') 'Fock Matrix' - write (6,'(A)') '-----------' - do i=1,n - write(*,'(200(E24.15))') A(i,:) - enddo + !write (6,'(A)') 'Fock Matrix' + !write (6,'(A)') '-----------' + !do i=1,n + ! write(*,'(200(E24.15))') A(i,:) + !enddo endif call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) @@ -302,11 +302,11 @@ subroutine mo_as_eigvectors_of_mo_matrix_kpts(matrix,n,m,nk,label,sign,output) enddo write (6,'(A)') '======== ================' write (6,'(A)') '' - write (6,'(A)') 'Fock Matrix' - write (6,'(A)') '-----------' - do i=1,n - write(*,'(200(E24.15))') A(i,:) - enddo + !write (6,'(A)') 'Fock Matrix' + !write (6,'(A)') '-----------' + !do i=1,n + ! write(*,'(200(E24.15))') A(i,:) + !enddo endif call zgemm('N','N',ao_num_per_kpt,m,m,(1.d0,0.d0), & diff --git a/src/mo_one_e_ints/EZFIO.cfg b/src/mo_one_e_ints/EZFIO.cfg index bd60ca16..23b30aba 100644 --- a/src/mo_one_e_ints/EZFIO.cfg +++ b/src/mo_one_e_ints/EZFIO.cfg @@ -47,6 +47,18 @@ doc: Read/Write |MO| one-electron kinetic integrals from/to disk [ Write | Read interface: ezfio,provider,ocaml default: None +[mo_integrals_overlap_kpts] +type: double precision +doc: Complex overlap integrals in |MO| basis set +size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num) +interface: ezfio + +[io_mo_integrals_overlap] +type: Disk_access +doc: Read/Write |MO| one-electron overlap integrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + [mo_integrals_pseudo] type: double precision diff --git a/src/mo_one_e_ints/mo_overlap.irp.f b/src/mo_one_e_ints/mo_overlap.irp.f index 796c9fde..f004e1f4 100644 --- a/src/mo_one_e_ints/mo_overlap.irp.f +++ b/src/mo_one_e_ints/mo_overlap.irp.f @@ -74,3 +74,57 @@ BEGIN_PROVIDER [ complex*16, mo_overlap_complex,(mo_num,mo_num) ] END_PROVIDER +BEGIN_PROVIDER [ complex*16, mo_overlap_kpts,(mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC +! Provider to check that the MOs are indeed orthonormal. + END_DOC + integer :: i,j,n,l,k + integer :: lmax + + print *, 'Providing MO overlap integrals' + if (read_mo_integrals_overlap) then + call ezfio_get_mo_one_e_ints_mo_integrals_overlap_kpts(mo_overlap_kpts) + print *, 'MO overlap integrals read from disk' + else + print *, 'Providing MO overlap integrals from AO overlap integrals' + ! call ao_to_mo_kpts( & + ! ao_kinetic_integrals_kpts, & + ! size(ao_kinetic_integrals_kpts,1), & + ! mo_kinetic_integrals_kpts, & + ! size(mo_kinetic_integrals_kpts,1) & + ! ) + !endif + + + lmax = (ao_num_per_kpt/4) * 4 + !$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(NONE) & + !$OMP PRIVATE(i,j,n,l,k) & + !$OMP SHARED(mo_overlap_kpts,mo_coef_kpts,ao_overlap_kpts, & + !$OMP mo_num_per_kpt,ao_num_per_kpt,lmax,kpt_num) + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i= 1,mo_num_per_kpt + mo_overlap_kpts(i,j,k) = (0.d0,0.d0) + do n = 1, lmax,4 + do l = 1, ao_num_per_kpt + mo_overlap_kpts(i,j,k) = mo_overlap_kpts(i,j,k) + dconjg(mo_coef_kpts(l,i,k)) * & + ( mo_coef_kpts(n ,j,k) * ao_overlap_kpts(l,n ,k) & + + mo_coef_kpts(n+1,j,k) * ao_overlap_kpts(l,n+1,k) & + + mo_coef_kpts(n+2,j,k) * ao_overlap_kpts(l,n+2,k) & + + mo_coef_kpts(n+3,j,k) * ao_overlap_kpts(l,n+3,k) ) + enddo + enddo + do n = lmax+1, ao_num_per_kpt + do l = 1, ao_num_per_kpt + mo_overlap_kpts(i,j,k) = mo_overlap_kpts(i,j,k) + mo_coef_kpts(n,j,k) * & + dconjg(mo_coef_kpts(l,i,k)) * ao_overlap_kpts(l,n,k) + enddo + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + endif +END_PROVIDER + diff --git a/src/mo_one_e_ints/orthonormalize.irp.f b/src/mo_one_e_ints/orthonormalize.irp.f index 11a09b4e..d7949ace 100644 --- a/src/mo_one_e_ints/orthonormalize.irp.f +++ b/src/mo_one_e_ints/orthonormalize.irp.f @@ -1,12 +1,14 @@ subroutine orthonormalize_mos implicit none - integer :: m,p,s + integer :: m,p,s,k if (is_complex) then - m = size(mo_coef_complex,1) - p = size(mo_overlap_complex,1) - call ortho_lowdin_complex(mo_overlap_complex,p,mo_num,mo_coef_complex,m,ao_num) + do k=1,kpt_num + m = size(mo_coef_kpts,1) + p = size(mo_overlap_kpts,1) + call ortho_lowdin_complex(mo_overlap_kpts(1,1,k),p,mo_num_per_kpt,mo_coef_kpts(1,1,k),m,ao_num_per_kpt) + enddo mo_label = 'Orthonormalized' - SOFT_TOUCH mo_coef_complex mo_label + SOFT_TOUCH mo_coef_kpts mo_label else m = size(mo_coef,1) p = size(mo_overlap,1) diff --git a/src/scf_utils/diagonalize_fock_cplx.irp.f b/src/scf_utils/diagonalize_fock_cplx.irp.f index 83d4b00f..82353ed0 100644 --- a/src/scf_utils/diagonalize_fock_cplx.irp.f +++ b/src/scf_utils/diagonalize_fock_cplx.irp.f @@ -72,8 +72,8 @@ BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_kpts, (ao_num_per_kpt,m allocate (diag(mo_num_per_kpt) ) do k=1,kpt_num - do j=1,mo_num - do i=1,mo_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt !F(i,j) = fock_matrix_mo_complex(i,j) F(i,j) = fock_matrix_mo_kpts(i,j,k) enddo diff --git a/src/scf_utils/diis_cplx.irp.f b/src/scf_utils/diis_cplx.irp.f index 721a9751..4a0cdabf 100644 --- a/src/scf_utils/diis_cplx.irp.f +++ b/src/scf_utils/diis_cplx.irp.f @@ -140,3 +140,155 @@ END_PROVIDER deallocate(scratch) END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_AO_kpts, (AO_num_per_kpt, AO_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! Commutator FPS - SPF + END_DOC + complex*16, allocatable :: scratch(:,:) + integer :: k + allocate( & + scratch(ao_num_per_kpt, ao_num_per_kpt) & + ) + + do k=1,kpt_num + + ! Compute FP + + call zgemm('N','N',AO_num_per_kpt,AO_num_per_kpt,AO_num_per_kpt, & + (1.d0,0.d0), & + Fock_Matrix_AO_kpts(1,1,k),Size(Fock_Matrix_AO_kpts,1), & + SCF_Density_Matrix_AO_kpts(1,1,k),Size(SCF_Density_Matrix_AO_kpts,1), & + (0.d0,0.d0), & + scratch,Size(scratch,1)) + + ! Compute FPS + + call zgemm('N','N',AO_num_per_kpt,AO_num_per_kpt,AO_num_per_kpt, & + (1.d0,0.d0), & + scratch,Size(scratch,1), & + AO_Overlap_kpts(1,1,k),Size(AO_Overlap_kpts,1), & + (0.d0,0.d0), & + FPS_SPF_Matrix_AO_kpts(1,1,k),Size(FPS_SPF_Matrix_AO_kpts,1)) + + ! Compute SP + + call zgemm('N','N',AO_num_per_kpt,AO_num_per_kpt,AO_num_per_kpt, & + (1.d0,0.d0), & + AO_Overlap_kpts(1,1,k),Size(AO_Overlap_kpts,1), & + SCF_Density_Matrix_AO_kpts(1,1,k),Size(SCF_Density_Matrix_AO_kpts,1), & + (0.d0,0.d0), & + scratch,Size(scratch,1)) + + ! Compute FPS - SPF + + call zgemm('N','N',AO_num_per_kpt,AO_num_per_kpt,AO_num_per_kpt, & + (-1.d0,0.d0), & + scratch,Size(scratch,1), & + Fock_Matrix_AO_kpts(1,1,k),Size(Fock_Matrix_AO_kpts,1), & + (1.d0,0.d0), & + FPS_SPF_Matrix_AO_kpts(1,1,k),Size(FPS_SPF_Matrix_AO_kpts,1)) + enddo +END_PROVIDER + +BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_MO_kpts, (mo_num_per_kpt, mo_num_per_kpt,kpt_num)] + implicit none + begin_doc +! Commutator FPS - SPF in MO basis + end_doc + call ao_to_mo_kpts(FPS_SPF_Matrix_AO_kpts, size(FPS_SPF_Matrix_AO_kpts,1), & + FPS_SPF_Matrix_MO_kpts, size(FPS_SPF_Matrix_MO_kpts,1)) +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, eigenvalues_fock_matrix_ao_kpts, (ao_num_per_kpt,kpt_num) ] +&BEGIN_PROVIDER [ complex*16, eigenvectors_fock_matrix_ao_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + !TODO: finish this provider; write provider for S_half_inv_complex + BEGIN_DOC + ! Eigenvalues and eigenvectors of the Fock matrix over the AO basis + END_DOC + + implicit none + + double precision, allocatable :: rwork(:) + integer :: lwork,info,lrwork + complex*16, allocatable :: scratch(:,:),Xt(:,:),work(:) + integer :: i,j,k + + + allocate( & + scratch(ao_num_per_kpt,ao_num_per_kpt), & + Xt(ao_num_per_kpt,ao_num_per_kpt) & + ) + + do k=1,kpt_num + ! Calculate Xt + + do i=1,ao_num_per_kpt + do j=1,ao_num_per_kpt +! Xt(i,j) = dconjg(s_half_inv_complex(j,i,k)) + Xt(i,j) = dconjg(S_half_inv_kpts(j,i,k)) + enddo + enddo + + ! Calculate Fock matrix in orthogonal basis: F' = Xt.F.X + + call zgemm('N','N',ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, & + (1.d0,0.d0), & + fock_matrix_ao_kpts(1,1,k),size(fock_matrix_ao_kpts,1), & + s_half_inv_kpts(1,1,k),size(s_half_inv_kpts,1), & + (0.d0,0.d0), & + eigenvectors_fock_matrix_ao_kpts(1,1,k), & + size(eigenvectors_fock_matrix_ao_kpts,1)) + + call zgemm('N','N',ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, & + (1.d0,0.d0), & + Xt,size(Xt,1), & + eigenvectors_fock_matrix_ao_kpts(1,1,k), & + size(eigenvectors_fock_matrix_ao_kpts,1), & + (0.d0,0.d0), & + scratch,size(scratch,1)) + + ! Diagonalize F' to obtain eigenvectors in orthogonal basis C' and eigenvalues + lrwork = 3*ao_num_per_kpt - 2 + allocate(rwork(lrwork), work(1)) + lwork = -1 + + call zheev('V','U',ao_num_per_kpt, & + scratch,size(scratch,1), & + eigenvalues_fock_matrix_ao_kpts(1,k), & + work,lwork,rwork,info) + + lwork = int(work(1)) + deallocate(work) + allocate(work(lwork)) + + call zheev('V','U',ao_num_per_kpt, & + scratch,size(scratch,1), & + eigenvalues_fock_matrix_ao_kpts(1,k), & + work,lwork,rwork,info) + + if(info /= 0) then + print *, irp_here//' failed : ', info + stop 1 + endif + + deallocate(work,rwork) + ! Back-transform eigenvectors: C =X.C' + + call zgemm('N','N',ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, & + (1.d0,0.d0), & + s_half_inv_kpts(1,1,k),size(s_half_inv_kpts,1), & + scratch,size(scratch,1), & + (0.d0,0.d0), & + eigenvectors_fock_matrix_ao_kpts(1,1,k), & + size(eigenvectors_fock_matrix_ao_kpts,1)) + enddo + deallocate(scratch) +END_PROVIDER diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index a77a78fc..efd64be1 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -157,15 +157,17 @@ BEGIN_PROVIDER [ double precision, SCF_energy ] END_DOC SCF_energy = nuclear_repulsion - integer :: i,j + integer :: i,j,k if (is_complex) then complex*16 :: scf_e_tmp scf_e_tmp = dcmplx(SCF_energy,0.d0) - do j=1,ao_num - do i=1,ao_num - scf_e_tmp += 0.5d0 * ( & - (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_alpha_complex(i,j) ) * SCF_density_matrix_ao_alpha_complex(j,i) +& - (ao_one_e_integrals_complex(i,j) + Fock_matrix_ao_beta_complex (i,j) ) * SCF_density_matrix_ao_beta_complex (j,i) ) + do k=1,kpt_num + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + scf_e_tmp += 0.5d0 * ( & + (ao_one_e_integrals_kpts(i,j,k) + Fock_matrix_ao_alpha_kpts(i,j,k) ) * SCF_density_matrix_ao_alpha_kpts(j,i,k) +& + (ao_one_e_integrals_kpts(i,j,k) + Fock_matrix_ao_beta_kpts (i,j,k) ) * SCF_density_matrix_ao_beta_kpts (j,i,k) ) + enddo enddo enddo !TODO: add check for imaginary part? (should be zero) diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index afa21072..cc0dc4af 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -593,14 +593,14 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/kpt_num +1 - kpt_j = (j-1)/kpt_num +1 - kpt_k = (k-1)/kpt_num +1 - kpt_l = (l-1)/kpt_num +1 - idx_i = mod(i,kpt_num) - idx_j = mod(j,kpt_num) - idx_k = mod(k,kpt_num) - idx_l = mod(l,kpt_num) + kpt_i = (i-1)/ao_num_per_kpt +1 + kpt_j = (j-1)/ao_num_per_kpt +1 + kpt_k = (k-1)/ao_num_per_kpt +1 + kpt_l = (l-1)/ao_num_per_kpt +1 + idx_i = mod(i-1,ao_num_per_kpt)+1 + idx_j = mod(j-1,ao_num_per_kpt)+1 + idx_k = mod(k-1,ao_num_per_kpt)+1 + idx_l = mod(l-1,ao_num_per_kpt)+1 integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -611,7 +611,7 @@ END_PROVIDER if (kpt_l.eq.kpt_j) then c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral if(kpt_i.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 @@ -620,7 +620,7 @@ END_PROVIDER if (kpt_l.eq.kpt_i) then if(kpt_j.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral @@ -636,20 +636,20 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/kpt_num +1 - kpt_j = (j-1)/kpt_num +1 - kpt_k = (k-1)/kpt_num +1 - kpt_l = (l-1)/kpt_num +1 - idx_i = mod(i,kpt_num) - idx_j = mod(j,kpt_num) - idx_k = mod(k,kpt_num) - idx_l = mod(l,kpt_num) + kpt_i = (i-1)/ao_num_per_kpt +1 + kpt_j = (j-1)/ao_num_per_kpt +1 + kpt_k = (k-1)/ao_num_per_kpt +1 + kpt_l = (l-1)/ao_num_per_kpt +1 + idx_i = mod(i-1,ao_num_per_kpt)+1 + idx_j = mod(j-1,ao_num_per_kpt)+1 + idx_k = mod(k-1,ao_num_per_kpt)+1 + idx_l = mod(l-1,ao_num_per_kpt)+1 integral = values(k1) if (kpt_l.eq.kpt_j) then c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral if(kpt_i.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 @@ -658,7 +658,7 @@ END_PROVIDER if (kpt_l.eq.kpt_i) then if(kpt_j.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral @@ -714,14 +714,14 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/kpt_num +1 - kpt_j = (j-1)/kpt_num +1 - kpt_k = (k-1)/kpt_num +1 - kpt_l = (l-1)/kpt_num +1 - idx_i = mod(i,kpt_num) - idx_j = mod(j,kpt_num) - idx_k = mod(k,kpt_num) - idx_l = mod(l,kpt_num) + kpt_i = (i-1)/ao_num_per_kpt +1 + kpt_j = (j-1)/ao_num_per_kpt +1 + kpt_k = (k-1)/ao_num_per_kpt +1 + kpt_l = (l-1)/ao_num_per_kpt +1 + idx_i = mod(i-1,ao_num_per_kpt)+1 + idx_j = mod(j-1,ao_num_per_kpt)+1 + idx_k = mod(k-1,ao_num_per_kpt)+1 + idx_l = mod(l-1,ao_num_per_kpt)+1 integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -732,7 +732,7 @@ END_PROVIDER if (kpt_l.eq.kpt_j) then c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral if(kpt_i.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 @@ -741,7 +741,7 @@ END_PROVIDER if (kpt_l.eq.kpt_i) then if(kpt_j.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral @@ -757,20 +757,20 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/kpt_num +1 - kpt_j = (j-1)/kpt_num +1 - kpt_k = (k-1)/kpt_num +1 - kpt_l = (l-1)/kpt_num +1 - idx_i = mod(i,kpt_num) - idx_j = mod(j,kpt_num) - idx_k = mod(k,kpt_num) - idx_l = mod(l,kpt_num) + kpt_i = (i-1)/ao_num_per_kpt +1 + kpt_j = (j-1)/ao_num_per_kpt +1 + kpt_k = (k-1)/ao_num_per_kpt +1 + kpt_l = (l-1)/ao_num_per_kpt +1 + idx_i = mod(i-1,ao_num_per_kpt)+1 + idx_j = mod(j-1,ao_num_per_kpt)+1 + idx_k = mod(k-1,ao_num_per_kpt)+1 + idx_l = mod(l-1,ao_num_per_kpt)+1 integral = values(k1) if (kpt_l.eq.kpt_j) then c0 = (scf_density_matrix_ao_alpha_kpts(idx_l,idx_j,kpt_j)+scf_density_matrix_ao_beta_kpts(idx_l,idx_j,kpt_j))*integral if(kpt_i.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_k,kpt_i) += c0 @@ -779,7 +779,7 @@ END_PROVIDER if (kpt_l.eq.kpt_i) then if(kpt_j.ne.kpt_k) then - print*,'problem in ',irp_here + print*,'problem in ',irp_here,' ikjl: ',kpt_i,kpt_k,kpt_j,kpt_l stop 1 endif ao_two_e_integral_alpha_tmp(idx_i,idx_l,kpt_i) -= SCF_density_matrix_ao_alpha_kpts(idx_k,idx_j,kpt_j) * integral diff --git a/src/scf_utils/roothaan_hall_scf_cplx.irp.f b/src/scf_utils/roothaan_hall_scf_cplx.irp.f index 2a68a282..e074f884 100644 --- a/src/scf_utils/roothaan_hall_scf_cplx.irp.f +++ b/src/scf_utils/roothaan_hall_scf_cplx.irp.f @@ -319,3 +319,337 @@ END_DOC endif end + +!============================================! +! ! +! kpts ! +! ! +!============================================! + +subroutine Roothaan_Hall_SCF_kpts + +BEGIN_DOC +! Roothaan-Hall algorithm for SCF Hartree-Fock calculation +END_DOC + + implicit none + + double precision :: energy_SCF,energy_SCF_previous,Delta_energy_SCF + double precision :: max_error_DIIS,max_error_DIIS_alpha,max_error_DIIS_beta + complex*16, allocatable :: Fock_matrix_DIIS(:,:,:,:),error_matrix_DIIS(:,:,:,:) + + integer :: iteration_SCF,dim_DIIS,index_dim_DIIS + + integer :: i,j,k,kk + logical, external :: qp_stop + complex*16, allocatable :: mo_coef_save(:,:,:) + + PROVIDE ao_md5 mo_occ level_shift + + allocate(mo_coef_save(ao_num_per_kpt,mo_num_per_kpt,kpt_num), & + Fock_matrix_DIIS (ao_num_per_kpt,ao_num_per_kpt,max_dim_DIIS,kpt_num), & + error_matrix_DIIS(ao_num_per_kpt,ao_num_per_kpt,max_dim_DIIS,kpt_num) & + ) + !todo: add kpt_num dim to diis mats? (3 or 4) + call write_time(6) + + print*,'Energy of the guess = ',scf_energy + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + ' N ', 'Energy ', 'Energy diff ', 'DIIS error ', 'Level shift ' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + +! Initialize energies and density matrices + energy_SCF_previous = SCF_energy + Delta_energy_SCF = 1.d0 + iteration_SCF = 0 + dim_DIIS = 0 + max_error_DIIS = 1.d0 + + +! +! Start of main SCF loop +! + !PROVIDE fps_spf_matrix_ao_complex fock_matrix_ao_complex + PROVIDE fps_spf_matrix_ao_kpts fock_matrix_ao_kpts + + do while ( & + ( (max_error_DIIS > threshold_DIIS_nonzero) .or. & + (dabs(Delta_energy_SCF) > thresh_SCF) & + ) .and. (iteration_SCF < n_it_SCF_max) ) + +! Increment cycle number + + iteration_SCF += 1 + if(frozen_orb_scf)then + call initialize_mo_coef_begin_iteration + endif + +! Current size of the DIIS space + + dim_DIIS = min(dim_DIIS+1,max_dim_DIIS) + + if (scf_algorithm == 'DIIS') then + + do kk=1,kpt_num + ! Store Fock and error matrices at each iteration + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + index_dim_DIIS = mod(dim_DIIS-1,max_dim_DIIS)+1 + Fock_matrix_DIIS (i,j,index_dim_DIIS,kk) = fock_matrix_ao_kpts(i,j,kk) + error_matrix_DIIS(i,j,index_dim_DIIS,kk) = fps_spf_matrix_ao_kpts(i,j,kk) + enddo + enddo + + ! Compute the extrapolated Fock matrix + + call extrapolate_fock_matrix_kpts( & + error_matrix_DIIS(1,1,1,kk),Fock_matrix_DIIS(1,1,1,kk), & + Fock_matrix_AO_kpts(1,1,kk),size(Fock_matrix_AO_kpts,1), & + iteration_SCF,dim_DIIS & + ) + enddo + Fock_matrix_AO_alpha_kpts = Fock_matrix_AO_kpts*0.5d0 + Fock_matrix_AO_beta_kpts = Fock_matrix_AO_kpts*0.5d0 + TOUCH Fock_matrix_AO_alpha_kpts Fock_matrix_AO_beta_kpts + + endif + + mo_coef_kpts = eigenvectors_fock_matrix_mo_kpts + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + + TOUCH mo_coef_kpts + +! Calculate error vectors + + max_error_DIIS = maxval(cdabs(FPS_SPF_Matrix_MO_kpts)) + +! SCF energy +! call print_debug_scf_complex + energy_SCF = scf_energy + Delta_Energy_SCF = energy_SCF - energy_SCF_previous + if ( (SCF_algorithm == 'DIIS').and.(Delta_Energy_SCF > 0.d0) ) then + do kk=1,kpt_num + Fock_matrix_AO_kpts(1:ao_num_per_kpt,1:ao_num_per_kpt,kk) = & + Fock_matrix_DIIS (1:ao_num_per_kpt,1:ao_num_per_kpt,index_dim_DIIS,kk) + enddo + Fock_matrix_AO_alpha_kpts = Fock_matrix_AO_kpts*0.5d0 + Fock_matrix_AO_beta_kpts = Fock_matrix_AO_kpts*0.5d0 + TOUCH Fock_matrix_AO_alpha_kpts Fock_matrix_AO_beta_kpts + endif + + double precision :: level_shift_save + level_shift_save = level_shift + mo_coef_save(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) + do while (Delta_energy_SCF > 0.d0) + mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = mo_coef_save + if (level_shift <= .1d0) then + level_shift = 1.d0 + else + level_shift = level_shift * 3.0d0 + endif + TOUCH mo_coef_kpts level_shift + mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = & + eigenvectors_fock_matrix_mo_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + TOUCH mo_coef_kpts + Delta_Energy_SCF = SCF_energy - energy_SCF_previous + energy_SCF = SCF_energy + if (level_shift-level_shift_save > 40.d0) then + level_shift = level_shift_save * 4.d0 + SOFT_TOUCH level_shift + exit + endif + dim_DIIS=0 + enddo + level_shift = level_shift * 0.5d0 + SOFT_TOUCH level_shift + energy_SCF_previous = energy_SCF + +! Print results at the end of each iteration + + write(6,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') & + iteration_SCF, energy_scf, Delta_energy_SCF, max_error_DIIS, level_shift, dim_DIIS + + if (Delta_energy_SCF < 0.d0) then + call save_mos + endif + if (qp_stop()) exit + + enddo + + if (iteration_SCF < n_it_SCF_max) then + mo_label = "Canonical" + endif +! +! End of Main SCF loop +! + + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,*) + + if(.not.frozen_orb_scf)then + call mo_as_eigvectors_of_mo_matrix_kpts(Fock_matrix_mo_kpts,size(Fock_matrix_mo_kpts,1),size(Fock_matrix_mo_kpts,2),size(Fock_matrix_mo_kpts,3),mo_label,1,.true.) + call save_mos + endif + + call write_double(6, Energy_SCF, 'SCF energy') + + call write_time(6) + +end + +subroutine extrapolate_Fock_matrix_kpts( & + error_matrix_DIIS,Fock_matrix_DIIS, & + Fock_matrix_AO_,size_Fock_matrix_AO, & + iteration_SCF,dim_DIIS & + ) + +BEGIN_DOC +! Compute the extrapolated Fock matrix using the DIIS procedure +END_DOC + + implicit none + + complex*16,intent(in) :: Fock_matrix_DIIS(ao_num_per_kpt,ao_num_per_kpt,*),error_matrix_DIIS(ao_num_per_kpt,ao_num_per_kpt,*) + integer,intent(in) :: iteration_SCF, size_Fock_matrix_AO + complex*16,intent(inout):: Fock_matrix_AO_(size_Fock_matrix_AO,ao_num_per_kpt) + integer,intent(inout) :: dim_DIIS + + double precision,allocatable :: B_matrix_DIIS(:,:),X_vector_DIIS(:) + double precision,allocatable :: C_vector_DIIS(:) + double precision :: accum_im, thr_im + complex*16,allocatable :: scratch(:,:) + integer :: i,j,k,i_DIIS,j_DIIS + thr_im = 1.0d-10 + allocate( & + B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), & + X_vector_DIIS(dim_DIIS+1), & + C_vector_DIIS(dim_DIIS+1), & + scratch(ao_num,ao_num) & + ) + +! Compute the matrices B and X + do j=1,dim_DIIS + do i=1,dim_DIIS + + j_DIIS = mod(iteration_SCF-j,max_dim_DIIS)+1 + i_DIIS = mod(iteration_SCF-i,max_dim_DIIS)+1 + +! Compute product of two errors vectors + + call zgemm('N','N',ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, & + (1.d0,0.d0), & + error_matrix_DIIS(1,1,i_DIIS),size(error_matrix_DIIS,1), & + error_matrix_DIIS(1,1,j_DIIS),size(error_matrix_DIIS,1), & + (0.d0,0.d0), & + scratch,size(scratch,1)) + +! Compute Trace + + B_matrix_DIIS(i,j) = 0.d0 + accum_im = 0.d0 + do k=1,ao_num_per_kpt + B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + dble(scratch(k,k)) + accum_im = accum_im + dimag(scratch(k,k)) + enddo + if (dabs(accum_im) .gt. thr_im) then + !stop 'problem with imaginary parts in DIIS B_matrix?' + print*, 'problem with imaginary parts in DIIS B_matrix?',accum_im + endif + enddo + enddo + deallocate(scratch) +! Pad B matrix and build the X matrix + + do i=1,dim_DIIS + B_matrix_DIIS(i,dim_DIIS+1) = -1.d0 + B_matrix_DIIS(dim_DIIS+1,i) = -1.d0 + C_vector_DIIS(i) = 0.d0 + enddo + B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0 + C_vector_DIIS(dim_DIIS+1) = -1.d0 + +! Solve the linear system C = B.X + + integer :: info + integer,allocatable :: ipiv(:) + + allocate( & + ipiv(dim_DIIS+1) & + ) + + double precision, allocatable :: AF(:,:),scratch_d1(:) + allocate (AF(dim_DIIS+1,dim_DIIS+1),scratch_d1(1)) + double precision :: rcond, ferr, berr + integer :: iwork(dim_DIIS+1), lwork + + call dsysvx('N','U',dim_DIIS+1,1, & + B_matrix_DIIS,size(B_matrix_DIIS,1), & + AF, size(AF,1), & + ipiv, & + C_vector_DIIS,size(C_vector_DIIS,1), & + X_vector_DIIS,size(X_vector_DIIS,1), & + rcond, & + ferr, & + berr, & + scratch_d1,-1, & + iwork, & + info & + ) + lwork = int(scratch_d1(1)) + deallocate(scratch_d1) + allocate(scratch_d1(lwork)) + + call dsysvx('N','U',dim_DIIS+1,1, & + B_matrix_DIIS,size(B_matrix_DIIS,1), & + AF, size(AF,1), & + ipiv, & + C_vector_DIIS,size(C_vector_DIIS,1), & + X_vector_DIIS,size(X_vector_DIIS,1), & + rcond, & + ferr, & + berr, & + scratch_d1,size(scratch_d1), & + iwork, & + info & + ) + deallocate(scratch_d1,ipiv) + + if(info < 0) then + stop 'bug in DIIS' + endif + + if (rcond > 1.d-12) then + + ! Compute extrapolated Fock matrix + + + !$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED) if (ao_num_per_kpt > 200) + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + Fock_matrix_AO_(i,j) = (0.d0,0.d0) + enddo + do k=1,dim_DIIS + do i=1,ao_num_per_kpt + Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + & + X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + else + dim_DIIS = 0 + endif + +end diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 55c41181..2f74c089 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -690,7 +690,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) - qph5.create_dataset('mo_basis/mo_coef_complex_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) + qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) @@ -729,6 +729,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic',data=kin_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap',data=ovlp_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=ne_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_kpts',data=kin_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) + qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_kpts',data=ovlp_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) + qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_kpts', data=ne_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) for fname,ints in zip(('S.qp','V.qp','T.qp'), (ovlp_ao, ne_ao, kin_ao)): @@ -757,9 +760,14 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic',data=kin_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap',data=ovlp_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e', data=ne_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + + qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_kpts',data=kin_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) + qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_kpts',data=ovlp_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) + qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_kpts', data=ne_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), (ovlp_mo, ne_mo, kin_mo)): print_kpts_unblocked_upper(ints,fname,thresh_mono) diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 2947b565..ae6be312 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -4,198 +4,389 @@ import h5py import sys import numpy as np -filename = sys.argv[1] -qph5path = sys.argv[2] +fname = sys.argv[1] +qph5name = sys.argv[2] -ezfio.set_file(filename) #qph5=h5py.File(qph5path,'r') - -ezfio.set_nuclei_is_complex(True) - -with h5py.File(qph5path,'r') as qph5: - kpt_num = qph5['nuclei'].attrs['kpt_num'] - nucl_num = qph5['nuclei'].attrs['nucl_num'] - ao_num = qph5['ao_basis'].attrs['ao_num'] - mo_num = qph5['mo_basis'].attrs['mo_num'] - elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] - elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] - -ezfio.set_nuclei_kpt_num(kpt_num) -kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 -ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) - -# don't multiply nuclei by kpt_num -# work in k-space, not in equivalent supercell -nucl_num_per_kpt = nucl_num -ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) - -# these are totals (kpt_num * num_per_kpt) -# need to change if we want to truncate orbital space within pyscf -ezfio.set_ao_basis_ao_num(ao_num) -ezfio.set_mo_basis_mo_num(mo_num) -ezfio.electrons_elec_alpha_num = elec_alpha_num -ezfio.electrons_elec_beta_num = elec_beta_num - - - -##ao_num = mo_num -##Important ! -#import math -#nelec_per_kpt = num_elec // n_kpts -#nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) -#nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) -# -#ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) -#ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) - -#ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) -#ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) - -#ezfio.set_utils_num_kpts(n_kpts) -#ezfio.set_integrals_bielec_df_num(n_aux) - -#(old)Important -#ezfio.set_nuclei_nucl_num(nucl_num) -#ezfio.set_nuclei_nucl_charge([0.]*nucl_num) -#ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) -#ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) - - -with h5py.File(qph5path,'r') as qph5: - nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() - nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() - nucl_label=qph5['nuclei/nucl_label'][()].tolist() - nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] - -ezfio.set_nuclei_nucl_charge(nucl_charge) -ezfio.set_nuclei_nucl_coord(nucl_coord) -ezfio.set_nuclei_nucl_label(nucl_label) - -ezfio.set_nuclei_io_nuclear_repulsion('Read') -ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) - - -########################################## -# # -# Basis # -# # -########################################## - -with h5py.File(qph5path,'r') as qph5: - ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) - ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) - - -#Just need one (can clean this up later) -ao_prim_num_max = 5 - -d = [ [0] *ao_prim_num_max]*ao_num -ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) -ezfio.set_ao_basis_ao_power(d) -ezfio.set_ao_basis_ao_coef(d) -ezfio.set_ao_basis_ao_expo(d) - - - - -########################################## -# # -# MO Coef # -# # -########################################## +def convert_kpts(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(True) - -with h5py.File(qph5path,'r') as qph5: - mo_coef_reim = qph5['mo_basis/mo_coef_complex'][()].tolist() -ezfio.set_mo_basis_mo_coef_complex(mo_coef_reim) -#maybe fix qp so we don't need this? -#ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) - - -########################################## -# # -# Integrals Mono # -# # -########################################## + with h5py.File(qph5path,'r') as qph5: + kpt_num = qph5['nuclei'].attrs['kpt_num'] + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] -with h5py.File(qph5path,'r') as qph5: - if 'ao_one_e_ints' in qph5.keys(): - kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() - ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() - ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() - - ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) - ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) - ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) + ezfio.set_nuclei_kpt_num(kpt_num) + kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 + ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) + + # don't multiply nuclei by kpt_num + # work in k-space, not in equivalent supercell + nucl_num_per_kpt = nucl_num + ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) + + # these are totals (kpt_num * num_per_kpt) + # need to change if we want to truncate orbital space within pyscf + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + + + #Just need one (can clean this up later) + ao_prim_num_max = 5 + + d = [ [0] *ao_prim_num_max]*ao_num + ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) + ezfio.set_ao_basis_ao_power(d) + ezfio.set_ao_basis_ao_coef(d) + ezfio.set_ao_basis_ao_expo(d) + + + + + ########################################## + # # + # MO Coef # + # # + ########################################## - ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') - ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') - ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') - -with h5py.File(qph5path,'r') as qph5: - if 'mo_one_e_ints' in qph5.keys(): - kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic'][()].tolist() - #ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() - ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e'][()].tolist() - - ezfio.set_mo_one_e_ints_mo_integrals_kinetic_complex(kin_mo_reim) - #ezfio.set_mo_one_e_ints_mo_integrals_overlap_complex(ovlp_mo_reim) - #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) - ezfio.set_mo_one_e_ints_mo_integrals_e_n_complex(ne_mo_reim) + with h5py.File(qph5path,'r') as qph5: + mo_coef_kpts = qph5['mo_basis/mo_coef_kpts'][()].tolist() + mo_coef_cplx = qph5['mo_basis/mo_coef_complex'][()].tolist() + ezfio.set_mo_basis_mo_coef_kpts(mo_coef_kpts) + ezfio.set_mo_basis_mo_coef_complex(mo_coef_cplx) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + + ########################################## + # # + # Integrals Mono # + # # + ########################################## - ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') - #ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') - #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') - ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') - -########################################## -# # -# k-points # -# # -########################################## - -with h5py.File(qph5path,'r') as qph5: - kconserv = qph5['nuclei/kconserv'][()].tolist() - -ezfio.set_nuclei_kconserv(kconserv) -ezfio.set_nuclei_io_kconserv('Read') - -########################################## -# # -# Integrals Bi # -# # -########################################## - -# should this be in ao_basis? ao_two_e_ints? -with h5py.File(qph5path,'r') as qph5: - if 'ao_two_e_ints' in qph5.keys(): - df_num = qph5['ao_two_e_ints'].attrs['df_num'] - ezfio.set_ao_two_e_ints_df_num(df_num) - if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): -# dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) -# dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) -# dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() -# ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) - dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() - ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) - ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') - - if 'mo_two_e_ints' in qph5.keys(): - df_num = qph5['ao_two_e_ints'].attrs['df_num'] - ezfio.set_ao_two_e_ints_df_num(df_num) -# dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) -# dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) -# dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() -# ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) - dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() - ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) - ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') - + with h5py.File(qph5path,'r') as qph5: + if 'ao_one_e_ints' in qph5.keys(): + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic_kpts'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap_kpts'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e_kpts'][()].tolist() + + ezfio.set_ao_one_e_ints_ao_integrals_kinetic_kpts(kin_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_overlap_kpts(ovlp_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_n_e_kpts(ne_ao_reim) + + ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + + + with h5py.File(qph5path,'r') as qph5: + if 'mo_one_e_ints' in qph5.keys(): + kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic_kpts'][()].tolist() + ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() + ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e_kpts'][()].tolist() + + ezfio.set_mo_one_e_ints_mo_integrals_kinetic_kpts(kin_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_overlap_kpts(ovlp_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_e_n_kpts(ne_mo_reim) + + ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') + + ########################################## + # # + # k-points # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + kconserv = qph5['nuclei/kconserv'][()].tolist() + + ezfio.set_nuclei_kconserv(kconserv) + ezfio.set_nuclei_io_kconserv('Read') + + ########################################## + # # + # Integrals Bi # + # # + ########################################## + + # should this be in ao_basis? ao_two_e_ints? + with h5py.File(qph5path,'r') as qph5: + if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): + # dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) + # dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) + # dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() + # ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') + + if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + # dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) + # dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) + # dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() + # ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') + + return +def convert_cplx(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(True) + + with h5py.File(qph5path,'r') as qph5: + kpt_num = qph5['nuclei'].attrs['kpt_num'] + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + + ezfio.set_nuclei_kpt_num(kpt_num) + kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 + ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) + + # don't multiply nuclei by kpt_num + # work in k-space, not in equivalent supercell + nucl_num_per_kpt = nucl_num + ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) + + # these are totals (kpt_num * num_per_kpt) + # need to change if we want to truncate orbital space within pyscf + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + + + #Just need one (can clean this up later) + ao_prim_num_max = 5 + + d = [ [0] *ao_prim_num_max]*ao_num + ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) + ezfio.set_ao_basis_ao_power(d) + ezfio.set_ao_basis_ao_coef(d) + ezfio.set_ao_basis_ao_expo(d) + + + + + ########################################## + # # + # MO Coef # + # # + ########################################## + + + with h5py.File(qph5path,'r') as qph5: + mo_coef_reim = qph5['mo_basis/mo_coef_complex'][()].tolist() + ezfio.set_mo_basis_mo_coef_complex(mo_coef_reim) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + + ########################################## + # # + # Integrals Mono # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + if 'ao_one_e_ints' in qph5.keys(): + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() + + ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) + + ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + + + with h5py.File(qph5path,'r') as qph5: + if 'mo_one_e_ints' in qph5.keys(): + kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic'][()].tolist() + #ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() + ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e'][()].tolist() + + ezfio.set_mo_one_e_ints_mo_integrals_kinetic_complex(kin_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_overlap_complex(ovlp_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_e_n_complex(ne_mo_reim) + + ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') + + ########################################## + # # + # k-points # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + kconserv = qph5['nuclei/kconserv'][()].tolist() + + ezfio.set_nuclei_kconserv(kconserv) + ezfio.set_nuclei_io_kconserv('Read') + + ########################################## + # # + # Integrals Bi # + # # + ########################################## + + # should this be in ao_basis? ao_two_e_ints? + with h5py.File(qph5path,'r') as qph5: + if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): + # dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) + # dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) + # dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() + # ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') + + if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + # dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) + # dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) + # dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() + # ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') + + return + #TODO: add check and only do this if ints exist #dfmo_re=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)).tolist() #dfmo_im=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)).tolist() #ezfio.set_mo_two_e_ints_df_mo_integrals_real(dfmo_re) #ezfio.set_mo_two_e_ints_df_mo_integrals_imag(dfmo_im) + +convert_kpts(fname,qph5name) From 2371bdf9a3023cfac1c1b63a1350dea750daf52a Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 20 Mar 2020 14:20:04 -0500 Subject: [PATCH 161/256] kpts diag --- src/mo_one_e_ints/kin_mo_ints.irp.f | 10 +++++++--- src/mo_one_e_ints/mo_one_e_ints.irp.f | 10 +++++++--- src/mo_one_e_ints/pot_mo_ints.irp.f | 10 +++++++--- src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f | 10 +++++++--- 4 files changed, 28 insertions(+), 12 deletions(-) diff --git a/src/mo_one_e_ints/kin_mo_ints.irp.f b/src/mo_one_e_ints/kin_mo_ints.irp.f index b12b39bc..e07ab690 100644 --- a/src/mo_one_e_ints/kin_mo_ints.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints.irp.f @@ -30,9 +30,13 @@ BEGIN_PROVIDER [ double precision, mo_kinetic_integrals_diag,(mo_num)] END_DOC if (is_complex) then - PROVIDE mo_kinetic_integrals_complex - do i=1,mo_num - mo_kinetic_integrals_diag(i) = dble(mo_kinetic_integrals_complex(i,i)) + integer :: k,i_shft + PROVIDE mo_kinetic_integrals_kpts + do k=1,kpt_num + i_shft = (k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_kinetic_integrals_diag(i+i_shft) = dble(mo_kinetic_integrals_kpts(i,i,k)) + enddo enddo else PROVIDE mo_kinetic_integrals diff --git a/src/mo_one_e_ints/mo_one_e_ints.irp.f b/src/mo_one_e_ints/mo_one_e_ints.irp.f index 5e9f4997..78b9a960 100644 --- a/src/mo_one_e_ints/mo_one_e_ints.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints.irp.f @@ -33,9 +33,13 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals_diag,(mo_num)] END_DOC if (is_complex) then - PROVIDE mo_one_e_integrals_complex - do i=1,mo_num - mo_one_e_integrals_diag(i) = dble(mo_one_e_integrals_complex(i,i)) + integer :: k,i_shft + PROVIDE mo_one_e_integrals_kpts + do k=1,kpt_num + i_shft = (k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_one_e_integrals_diag(i+i_shft) = dble(mo_one_e_integrals_kpts(i,i,k)) + enddo enddo else PROVIDE mo_one_e_integrals diff --git a/src/mo_one_e_ints/pot_mo_ints.irp.f b/src/mo_one_e_ints/pot_mo_ints.irp.f index 6682449a..6903d972 100644 --- a/src/mo_one_e_ints/pot_mo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints.irp.f @@ -52,9 +52,13 @@ BEGIN_PROVIDER [ double precision, mo_integrals_n_e_diag,(mo_num)] END_DOC if (is_complex) then - PROVIDE mo_integrals_n_e_complex - do i=1,mo_num - mo_integrals_n_e_diag(i) = dble(mo_integrals_n_e_complex(i,i)) + integer :: k,i_shft + PROVIDE mo_integrals_n_e_kpts + do k=1,kpt_num + i_shft = (k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_integrals_n_e_diag(i+i_shft) = dble(mo_integrals_n_e_kpts(i,i,k)) + enddo enddo else PROVIDE mo_integrals_n_e diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f index f135629a..504d8c02 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f @@ -33,9 +33,13 @@ BEGIN_PROVIDER [ double precision, mo_pseudo_integrals_diag,(mo_num)] END_DOC if (is_complex) then - PROVIDE mo_pseudo_integrals_complex - do i=1,mo_num - mo_pseudo_integrals_diag(i) = dble(mo_pseudo_integrals_complex(i,i)) + integer :: k,i_shft + PROVIDE mo_pseudo_integrals_kpts + do k=1,kpt_num + i_shft = (k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_pseudo_integrals_diag(i+i_shft) = dble(mo_pseudo_integrals_kpts(i,i,k)) + enddo enddo else PROVIDE mo_pseudo_integrals From 8c68369a3bcfca10bf5996b5d59c16cb3b9dd4e7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 23 Mar 2020 08:05:27 -0500 Subject: [PATCH 162/256] debugging --- src/ao_one_e_ints/pot_ao_ints.irp.f | 4 + src/determinants/single_excitations.irp.f | 167 +++++++++++++++++++++- src/mo_guess/pot_mo_ortho_cano_ints.irp.f | 1 + 3 files changed, 167 insertions(+), 5 deletions(-) diff --git a/src/ao_one_e_ints/pot_ao_ints.irp.f b/src/ao_one_e_ints/pot_ao_ints.irp.f index 59ded4fc..5e8e3b0c 100644 --- a/src/ao_one_e_ints/pot_ao_ints.irp.f +++ b/src/ao_one_e_ints/pot_ao_ints.irp.f @@ -112,6 +112,10 @@ BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)] ! ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle` END_DOC + print*,'error: ',irp_here + write(*,*) "test" + ao_integrals_n_e_complex(999,999) = 0.d0 + call abort() if (read_ao_integrals_n_e) then call ezfio_get_ao_one_e_ints_ao_integrals_n_e_complex(ao_integrals_n_e_complex) print *, 'AO N-e integrals read from disk' diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index eb56f19e..d9ca40f0 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -10,10 +10,14 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)] ref_closed_shell_bitmask(i,1) = ref_bitmask(i,1) ref_closed_shell_bitmask(i,2) = ref_bitmask(i,2) enddo - do i0 = elec_beta_num+1, elec_alpha_num - i=occ(i0,1) - call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int) - enddo + if (is_complex) then + do + else + do i0 = elec_beta_num+1, elec_alpha_num + i=occ(i0,1) + call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int) + enddo + endif END_PROVIDER @@ -159,7 +163,11 @@ subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij) end - +!============================================! +! ! +! complex ! +! ! +!============================================! BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_cplx, (mo_num, mo_num) ] implicit none @@ -304,3 +312,152 @@ subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hi end +!============================================! +! ! +! kpts ! +! ! +!============================================! + +BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo_num_per_kpt,kpt_num) ] + implicit none + integer :: i0,j0,i,j,k0,k + integer :: n_occ_ab(2) + integer :: occ(N_int*bit_kind_size,2) + integer :: n_occ_ab_virt(2) + integer :: occ_virt(N_int*bit_kind_size,2) + integer(bit_kind) :: key_test(N_int) + integer(bit_kind) :: key_virt(N_int,2) + complex*16 :: accu + + call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int) + do i = 1, N_int + key_virt(i,1) = full_ijkl_bitmask(i) + key_virt(i,2) = full_ijkl_bitmask(i) + key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1)) + key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2)) + enddo + complex*16, allocatable :: array_coulomb(:),array_exchange(:) + allocate (array_coulomb(mo_num),array_exchange(mo_num)) + call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) + ! docc ---> virt single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + ! + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + ! + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_op_cshell_ref_bitmask_cplx(i,j) = accu + mo_one_e_integrals_complex(i,j) + !fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(fock_op_cshell_ref_bitmask_cplx(i,j)) + enddo + enddo + + ! virt ---> virt single excitations + do i0 = 1, n_occ_ab_virt(1) + i=occ_virt(i0,1) + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + enddo + enddo + + ! docc ---> docc single excitations + do i0 = 1, n_occ_ab(1) + i=occ(i0,1) + do j0 = 1, n_occ_ab(1) + j = occ(j0,1) + call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) + accu = (0.d0,0.d0) + do k0 = 1, n_occ_ab(1) + k = occ(k0,1) + accu += 2.d0 * array_coulomb(k) - array_exchange(k) + enddo + fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) + fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) + enddo + enddo + deallocate(array_coulomb,array_exchange) + +END_PROVIDER + +subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hij) + use bitmasks + implicit none + integer,intent(in) :: h,p,spin + double precision, intent(in) :: phase + integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) + complex*16, intent(out) :: hij + integer(bit_kind) :: differences(N_int,2) + integer(bit_kind) :: hole(N_int,2) + integer(bit_kind) :: partcl(N_int,2) + integer :: occ_hole(N_int*bit_kind_size,2) + integer :: occ_partcl(N_int*bit_kind_size,2) + integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) + integer :: i0,i + complex*16 :: buffer_c(mo_num),buffer_x(mo_num) + do i=1, mo_num + buffer_c(i) = big_array_coulomb_integrals_complex(i,h,p) + buffer_x(i) = big_array_exchange_integrals_complex(i,h,p) + enddo + do i = 1, N_int + differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) + differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) + hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) + hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) + partcl(i,1) = iand(differences(i,1),det_1(i,1)) + partcl(i,2) = iand(differences(i,2),det_1(i,2)) + enddo + call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) + call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) + hij = fock_op_cshell_ref_bitmask_cplx(h,p) + ! holes :: direct terms + do i0 = 1, n_occ_ab_hole(1) + i = occ_hole(i0,1) + hij -= buffer_c(i) + enddo + do i0 = 1, n_occ_ab_hole(2) + i = occ_hole(i0,2) + hij -= buffer_c(i) + enddo + + ! holes :: exchange terms + do i0 = 1, n_occ_ab_hole(spin) + i = occ_hole(i0,spin) + hij += buffer_x(i) + enddo + + ! particles :: direct terms + do i0 = 1, n_occ_ab_partcl(1) + i = occ_partcl(i0,1) + hij += buffer_c(i) + enddo + do i0 = 1, n_occ_ab_partcl(2) + i = occ_partcl(i0,2) + hij += buffer_c(i) + enddo + + ! particles :: exchange terms + do i0 = 1, n_occ_ab_partcl(spin) + i = occ_partcl(i0,spin) + hij -= buffer_x(i) + enddo + hij = hij * phase + +end + diff --git a/src/mo_guess/pot_mo_ortho_cano_ints.irp.f b/src/mo_guess/pot_mo_ortho_cano_ints.irp.f index afbf96ff..1b270aef 100644 --- a/src/mo_guess/pot_mo_ortho_cano_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_cano_ints.irp.f @@ -24,6 +24,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_cano_n_e_ints, (mo_num,mo_num)] END_PROVIDER BEGIN_PROVIDER [complex*16, ao_ortho_cano_n_e_ints_cplx, (mo_num,mo_num)] +!todo: kpts implicit none integer :: i1,j1,i,j complex*16 :: c_i1,c_j1 From 92f321e5941ea7e6441450f6b57cfb80ecea8874 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 24 Mar 2020 09:54:48 -0500 Subject: [PATCH 163/256] ci kpts --- src/determinants/single_excitations.irp.f | 175 +++++++++++++-------- src/mo_two_e_ints/integrals_3_index.irp.f | 37 +++++ src/mo_two_e_ints/map_integrals_cplx.irp.f | 38 +++++ 3 files changed, 181 insertions(+), 69 deletions(-) diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index d9ca40f0..6e394572 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -1,7 +1,7 @@ use bitmasks BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)] implicit none - integer :: i,i0 + integer :: i,i0,k integer :: n_occ_ab(2) integer :: occ(N_int*bit_kind_size,2) call bitstring_to_list_ab(ref_bitmask, occ, n_occ_ab, N_int) @@ -11,18 +11,22 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)] ref_closed_shell_bitmask(i,2) = ref_bitmask(i,2) enddo if (is_complex) then - do + !todo: check this + do k=1,kpt_num + call bitstring_to_list_ab(ref_bitmask_kpts(1,1,k),occ,n_occ_ab,N_int) + do i0=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k) + i=occ(i0,1) + call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int) + enddo + enddo else do i0 = elec_beta_num+1, elec_alpha_num i=occ(i0,1) call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int) enddo endif - - END_PROVIDER - BEGIN_PROVIDER [double precision, fock_op_cshell_ref_bitmask, (mo_num, mo_num) ] implicit none integer :: i0,j0,i,j,k0,k @@ -318,85 +322,117 @@ end ! ! !============================================! +BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask_kpts, (N_int,2,kpt_num)] + implicit none + integer :: i,k + do k = 1, kpt_num + do i = 1, N_int + ref_closed_shell_bitmask_kpts(i,1,k) = iand(ref_closed_shell_bitmask(i,1),kpts_bitmask(i,k)) + ref_closed_shell_bitmask_kpts(i,2,k) = iand(ref_closed_shell_bitmask(i,2),kpts_bitmask(i,k)) + enddo + enddo +END_PROVIDER + BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo_num_per_kpt,kpt_num) ] implicit none - integer :: i0,j0,i,j,k0,k - integer :: n_occ_ab(2) - integer :: occ(N_int*bit_kind_size,2) + integer :: i0,j0,i,j,k0,k,kblock,kvirt + integer :: n_occ_ab(2,kpt_num) + integer :: occ(N_int*bit_kind_size,2,kpt_num) integer :: n_occ_ab_virt(2) integer :: occ_virt(N_int*bit_kind_size,2) integer(bit_kind) :: key_test(N_int) integer(bit_kind) :: key_virt(N_int,2) complex*16 :: accu + complex*16, allocatable :: array_coulomb(:,:),array_exchange(:,:) - call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int) - do i = 1, N_int - key_virt(i,1) = full_ijkl_bitmask(i) - key_virt(i,2) = full_ijkl_bitmask(i) - key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1)) - key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2)) + do kblock = 1,kpt_num + call bitstring_to_list_ab(ref_closed_shell_bitmask_kpts(1,1,kblock), & + occ(1,1,kblock), n_occ_ab(1,kblock), N_int) enddo - complex*16, allocatable :: array_coulomb(:),array_exchange(:) - allocate (array_coulomb(mo_num),array_exchange(mo_num)) - call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) - ! docc ---> virt single excitations - do i0 = 1, n_occ_ab(1) - i=occ(i0,1) - do j0 = 1, n_occ_ab_virt(1) - j = occ_virt(j0,1) - ! - call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) - ! - call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) - accu = (0.d0,0.d0) - do k0 = 1, n_occ_ab(1) - k = occ(k0,1) - accu += 2.d0 * array_coulomb(k) - array_exchange(k) + allocate (array_coulomb(mo_num_per_kpt),array_exchange(mo_num_per_kpt)) + do kblock = 1,kpt_num + ! get virt orbs for this kpt + do i = 1, N_int + key_virt(i,1) = iand(full_ijkl_bitmask(i),kpts_bitmask(i,kblock)) + key_virt(i,2) = iand(full_ijkl_bitmask(i),kpts_bitmask(i,kblock)) + key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask_kpts(i,1,kblock)) + key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask_kpts(i,2,kblock)) enddo - fock_op_cshell_ref_bitmask_cplx(i,j) = accu + mo_one_e_integrals_complex(i,j) - !fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) - fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(fock_op_cshell_ref_bitmask_cplx(i,j)) - enddo - enddo - - ! virt ---> virt single excitations - do i0 = 1, n_occ_ab_virt(1) - i=occ_virt(i0,1) - do j0 = 1, n_occ_ab_virt(1) - j = occ_virt(j0,1) - call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) - call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) - accu = (0.d0,0.d0) - do k0 = 1, n_occ_ab(1) - k = occ(k0,1) - accu += 2.d0 * array_coulomb(k) - array_exchange(k) + call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) + ! docc ---> virt single excitations + do i0 = 1, n_occ_ab(1,kblock) + i=occ(i0,1,kblock) + i_i = mod(i-1,mo_num_per_kpt)+1 + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + i_j = mod(j-1,mo_num_per_kpt)+1 + accu = (0.d0,0.d0) + do kocc = 1,kpt_num + ! + array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + ! + array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + do k0 = 1, n_occ_ab(1,kocc) + k = occ(k0,1,kocc) + i_k = mod(k-1,mo_num_per_kpt)+1 + accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) + enddo + enddo + fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + !fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) + fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + enddo enddo - fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) - fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) - enddo - enddo - - ! docc ---> docc single excitations - do i0 = 1, n_occ_ab(1) - i=occ(i0,1) - do j0 = 1, n_occ_ab(1) - j = occ(j0,1) - call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2) - call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2) - accu = (0.d0,0.d0) - do k0 = 1, n_occ_ab(1) - k = occ(k0,1) - accu += 2.d0 * array_coulomb(k) - array_exchange(k) + + ! virt ---> virt single excitations + do i0 = 1, n_occ_ab_virt(1) + i=occ_virt(i0,1) + i_i = mod(i-1,mo_num_per_kpt)+1 + do j0 = 1, n_occ_ab_virt(1) + j = occ_virt(j0,1) + i_j = mod(j-1,mo_num_per_kpt)+1 + accu = (0.d0,0.d0) + do kocc = 1,kpt_num + array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + do k0 = 1, n_occ_ab(1,kocc) + k = occ(k0,1,kocc) + i_k = mod(k-1,mo_num_per_kpt)+1 + accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) + enddo + enddo + fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + enddo + enddo + + ! docc ---> docc single excitations + do i0 = 1, n_occ_ab(1,kblock) + i=occ(i0,1,kblock) + i_i = mod(i-1,mo_num_per_kpt)+1 + do j0 = 1, n_occ_ab(1,kblock) + j = occ(j0,1,kblock) + i_j = mod(j-1,mo_num_per_kpt)+1 + accu = (0.d0,0.d0) + do kocc = 1,kpt_num + array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock) + do k0 = 1, n_occ_ab(1,kocc) + k = occ(k0,1,kocc) + i_k = mod(k-1,mo_num_per_kpt)+1 + accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) + enddo + enddo + fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + enddo enddo - fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j) - fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i) enddo - enddo deallocate(array_coulomb,array_exchange) END_PROVIDER -subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hij) +subroutine get_single_excitation_from_fock_kpts(det_1,det_2,h,p,spin,phase,hij) use bitmasks implicit none integer,intent(in) :: h,p,spin @@ -411,9 +447,10 @@ subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hi integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) integer :: i0,i complex*16 :: buffer_c(mo_num),buffer_x(mo_num) +! do do i=1, mo_num - buffer_c(i) = big_array_coulomb_integrals_complex(i,h,p) - buffer_x(i) = big_array_exchange_integrals_complex(i,h,p) + buffer_c(i) = big_array_coulomb_integrals_kpts(i,ki,h,p,kp) + buffer_x(i) = big_array_exchange_integrals_kpts(i,ki,h,p,kp) enddo do i = 1, N_int differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) diff --git a/src/mo_two_e_ints/integrals_3_index.irp.f b/src/mo_two_e_ints/integrals_3_index.irp.f index 983e2642..438f4102 100644 --- a/src/mo_two_e_ints/integrals_3_index.irp.f +++ b/src/mo_two_e_ints/integrals_3_index.irp.f @@ -55,3 +55,40 @@ END_PROVIDER END_PROVIDER + BEGIN_PROVIDER [complex*16, big_array_coulomb_integrals_kpts, (mo_num_per_kpt,kpt_num,mo_num_per_kpt, mo_num_per_kpt,kpt_num)] +&BEGIN_PROVIDER [complex*16, big_array_exchange_integrals_kpts,(mo_num_per_kpt,kpt_num,mo_num_per_kpt, mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! big_array_coulomb_integrals(j,kj,i,k,ki) = = (ik|jj) + ! big_array_exchange_integrals(j,kj,i,k,ki) = = (ij|jk) + ! for both of these, i and k must be from same kpt for integral to be nonzero + ! TODO: only loop over half, and assign two elements: + ! b_a_coul_int(j,i,k) = b_a_coul_int(j,k,i)* + ! b_a_exch_int(j,i,k) = b_a_exch_int(j,k,i)* + END_DOC + integer :: i,j,k,l + integer :: ki,kj,kk,kl + complex*16 :: get_two_e_integral_kpts + complex*16 :: integral + + do ki = 1,kpt_num + kk=ki + do k = 1, mo_num_per_kpt + do i = 1, mo_num_per_kpt + do kj = 1,kpt_num + kl=kj + do j = 1, mo_num_per_kpt + l = j + integral = get_two_e_integral_kpts(i,j,k,l,ki,kj,kk,kl,mo_integrals_map,mo_integrals_map_2) + big_array_coulomb_integrals_kpts(j,kj,i,k,ki) = integral + l = j + integral = get_two_e_integral_kpts(i,j,l,k,ki,kj,kl,kk,mo_integrals_map,mo_integrals_map_2) + big_array_exchange_integrals_kpts(j,kj,i,k,ki) = integral + enddo + enddo + enddo + enddo + enddo + +END_PROVIDER + diff --git a/src/mo_two_e_ints/map_integrals_cplx.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f index 66b9e3c0..1db8da3c 100644 --- a/src/mo_two_e_ints/map_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/map_integrals_cplx.irp.f @@ -119,6 +119,25 @@ complex*16 function get_two_e_integral_complex(i,j,k,l,map,map2) get_two_e_integral_complex = tmp end +complex*16 function get_two_e_integral_kpts(i,j,k,l,ki,kj,kk,kl,map,map2) + use map_module + implicit none + BEGIN_DOC + ! Returns one integral in the MO basis + ! TODO: finish this + END_DOC + integer, intent(in) :: i,j,k,l + integer, intent(in) :: ki,kj,kk,kl + type(map_type), intent(inout) :: map,map2 + complex*16 :: get_two_e_integral_complex + complex*16 :: tmp + tmp = get_two_e_integral_complex( i + mo_num_per_kpt*(ki-1), & + j + mo_num_per_kpt*(kj-1), & + k + mo_num_per_kpt*(kk-1), & + l + mo_num_per_kpt*(kl-1), map,map2) + get_two_e_integral_kpts = tmp +end + complex*16 function mo_two_e_integral_complex(i,j,k,l) implicit none BEGIN_DOC @@ -133,6 +152,25 @@ complex*16 function mo_two_e_integral_complex(i,j,k,l) return end +complex*16 function mo_two_e_integral_kpts(i,j,k,l,ki,kj,kk,kl) + implicit none + BEGIN_DOC + ! Returns one integral in the MO basis + END_DOC + integer, intent(in) :: i,j,k,l + integer, intent(in) :: ki,kj,kk,kl + complex*16 :: get_two_e_integral_complex + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_complex + PROVIDE mo_two_e_integrals_in_map + !DIR$ FORCEINLINE + mo_two_e_integral_kpts = get_two_e_integral_complex( & + i + mo_num_per_kpt*(ki-1), & + j + mo_num_per_kpt*(kj-1), & + k + mo_num_per_kpt*(kk-1), & + l + mo_num_per_kpt*(kl-1),mo_integrals_map,mo_integrals_map_2) + return +end + subroutine get_mo_two_e_integrals_complex(j,k,l,sze,out_val,map,map2) use map_module implicit none From e638a640f07ec20383e7a701957893a9b277d6c6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 24 Mar 2020 16:43:04 -0500 Subject: [PATCH 164/256] problem with 1rdm kpts --- src/cipsi/pt2_stoch_routines.irp.f | 3 +- src/davidson/print_e_components.irp.f | 20 +- src/determinants/density_matrix_cplx.irp.f | 382 ++++++++++++++++++++- src/determinants/single_excitations.irp.f | 155 +++++---- src/determinants/slater_rules.irp.f | 3 +- 5 files changed, 482 insertions(+), 81 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 635353c5..918f26ed 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -177,7 +177,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) if (is_complex) then !todo: psi_selectors isn't linked to psi_selectors_coef anymore; should we provide both? - PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_complex pt2_w + !PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_complex pt2_w + PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_kpts pt2_w PROVIDE psi_selectors pt2_u pt2_J pt2_R else PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w diff --git a/src/davidson/print_e_components.irp.f b/src/davidson/print_e_components.irp.f index 9c3caf23..fcea369d 100644 --- a/src/davidson/print_e_components.irp.f +++ b/src/davidson/print_e_components.irp.f @@ -6,7 +6,7 @@ subroutine print_energy_components() integer, save :: ifirst = 0 double precision :: Vee, Ven, Vnn, Vecp, T, f complex*16 :: fc - integer :: i,j,k + integer :: i,j,k,kk Vnn = nuclear_repulsion @@ -20,12 +20,18 @@ subroutine print_energy_components() T = 0.d0 if (is_complex) then - do j=1,mo_num - do i=1,mo_num - fc = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k) - Ven = Ven + dble(fc * mo_integrals_n_e_complex(j,i)) - Vecp = Vecp + dble(fc * mo_pseudo_integrals_complex(j,i)) - T = T + dble(fc * mo_kinetic_integrals_complex(j,i)) + do kk=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + !fc = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k) + !Ven = Ven + dble(fc * mo_integrals_n_e_complex(j,i)) + !Vecp = Vecp + dble(fc * mo_pseudo_integrals_complex(j,i)) + !T = T + dble(fc * mo_kinetic_integrals_complex(j,i)) + fc = one_e_dm_mo_alpha_kpts(i,j,kk,k) + one_e_dm_mo_beta_kpts(i,j,kk,k) + Ven = Ven + dble(fc * mo_integrals_n_e_kpts(j,i,kk)) + Vecp = Vecp + dble(fc * mo_pseudo_integrals_kpts(j,i,kk)) + T = T + dble(fc * mo_kinetic_integrals_kpts(j,i,kk)) + enddo enddo enddo else diff --git a/src/determinants/density_matrix_cplx.irp.f b/src/determinants/density_matrix_cplx.irp.f index 18bae7db..c1b63cf2 100644 --- a/src/determinants/density_matrix_cplx.irp.f +++ b/src/determinants/density_matrix_cplx.irp.f @@ -290,8 +290,8 @@ END_PROVIDER integer :: i,j,k,l complex*16 :: mo_alpha,mo_beta - one_e_dm_ao_alpha = (0.d0,0.d0) - one_e_dm_ao_beta = (0.d0,0.d0) + one_e_dm_ao_alpha_complex = (0.d0,0.d0) + one_e_dm_ao_beta_complex = (0.d0,0.d0) do k = 1, ao_num do l = 1, ao_num do i = 1, mo_num @@ -309,3 +309,381 @@ END_PROVIDER END_PROVIDER +!============================================! +! ! +! kpts ! +! ! +!============================================! + + BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_average_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_average_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! $\alpha$ and $\beta$ one-body density matrix for each state + END_DOC + integer :: i,k + one_e_dm_mo_alpha_average_kpts = (0.d0,0.d0) + one_e_dm_mo_beta_average_kpts = (0.d0,0.d0) + do i = 1,N_states + do k=1,kpt_num + one_e_dm_mo_alpha_average_kpts(:,:,k) += one_e_dm_mo_alpha_kpts(:,:,k,i) * state_average_weight(i) + one_e_dm_mo_beta_average_kpts(:,:,k) += one_e_dm_mo_beta_kpts(:,:,k,i) * state_average_weight(i) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_diff_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,2:N_states) ] + implicit none + BEGIN_DOC + ! Difference of the one-body density matrix with respect to the ground state + END_DOC + integer :: i,j, istate,k + + do istate=2,N_states + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + one_e_dm_mo_diff_kpts(i,j,k,istate) = & + one_e_dm_mo_alpha_kpts(i,j,k,istate) - one_e_dm_mo_alpha_kpts(i,j,k,1) +& + one_e_dm_mo_beta_kpts (i,j,k,istate) - one_e_dm_mo_beta_kpts (i,j,k,1) + enddo + enddo + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_spin_index_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states,2) ] + implicit none + integer :: i,j,k,ispin,istate + ispin = 1 + do istate = 1, N_states + do k=1,kpt_num + do j = 1, mo_num_per_kpt + do i = 1, mo_num_per_kpt + one_e_dm_mo_spin_index_kpts(i,j,k,istate,ispin) = one_e_dm_mo_alpha_kpts(i,j,k,istate) + enddo + enddo + enddo + enddo + + ispin = 2 + do istate = 1, N_states + do k=1,kpt_num + do j = 1, mo_num_per_kpt + do i = 1, mo_num_per_kpt + one_e_dm_mo_spin_index_kpts(i,j,k,istate,ispin) = one_e_dm_mo_beta_kpts(i,j,k,istate) + enddo + enddo + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_dm_dagger_mo_spin_index_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states,2) ] + print*,irp_here,' not implemented for kpts' + stop -1 +! implicit none +! integer :: i,j,ispin,istate +! ispin = 1 +! do istate = 1, N_states +! do j = 1, mo_num +! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_alpha(j,j,istate) +! do i = j+1, mo_num +! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate) +! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate) +! enddo +! enddo +! enddo +! +! ispin = 2 +! do istate = 1, N_states +! do j = 1, mo_num +! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_beta(j,j,istate) +! do i = j+1, mo_num +! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_beta(i,j,istate) +! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_beta(i,j,istate) +! enddo +! enddo +! enddo +! +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) ] + implicit none + BEGIN_DOC + ! $\alpha$ and $\beta$ one-body density matrix for each state + ! $\gamma_{\mu\nu} = \langle\Psi|a_{\nu}^{\dagger}a_{\mu}|\Psi\rangle$ + ! $\gamma_{\mu\nu} = \langle a_{\nu} \Psi|a_{\mu} \Psi\rangle$ + ! $\gamma_{\mu\nu} = \sum_{IJ} c^*_J c_I \langle a_{\nu} I|a_{\mu} J\rangle$ + END_DOC + !todo: implement for kpts + integer :: j,k,l,m,k_a,k_b + integer :: occ(N_int*bit_kind_size,2) + complex*16 :: ck, cl, ckl + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2, degree + integer :: ih1,ip1,kh1,kp1,kk,k_shft,ii + integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int) + integer(bit_kind) :: tmp_det_kpts(N_int,2) + integer :: exc(0:2,2),n_occ(2) + complex*16, allocatable :: tmp_a(:,:,:,:), tmp_b(:,:,:,:) + integer :: krow, kcol, lrow, lcol + + PROVIDE psi_det psi_coef_complex + + one_e_dm_mo_alpha_kpts = (0.d0,0.d0) + one_e_dm_mo_beta_kpts = (0.d0,0.d0) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(j,k,k_a,k_b,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,& + !$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2,ih1,ip1,kh1,kp1,kk,& + !$OMP tmp_det_kpts,k_shft,ii)& + !$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states,elec_alpha_num_kpts, & + !$OMP elec_beta_num_kpts,one_e_dm_mo_alpha_kpts,one_e_dm_mo_beta_kpts,N_det,& + !$OMP mo_num_per_kpt,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns,& + !$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns,& + !$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique,& + !$OMP psi_bilinear_matrix_values_complex, psi_bilinear_matrix_transp_values_complex,& + !$OMP N_det_alpha_unique,N_det_beta_unique,irp_here,kpt_num,kpts_bitmask) + allocate(tmp_a(mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states), tmp_b(mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) ) + tmp_a = (0.d0,0.d0) + !$OMP DO SCHEDULE(dynamic,64) + do k_a=1,N_det + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow) + tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol) + + ! Diagonal part + ! ------------- + + do kk=1,kpt_num + k_shft = (kk-1)*mo_num_per_kpt + do ii=1,N_int + tmp_det_kpts(ii,1) = iand(tmp_det(ii,1),kpts_bitmask(ii,kk)) + tmp_det_kpts(ii,2) = iand(tmp_det(ii,2),kpts_bitmask(ii,kk)) + enddo + call bitstring_to_list_ab(tmp_det_kpts, occ, n_occ, N_int) + do m=1,N_states + ck = cdabs(psi_bilinear_matrix_values_complex(k_a,m)*psi_bilinear_matrix_values_complex(k_a,m)) + !do l=1,elec_alpha_num_kpts(kk) + do l=1,n_occ(1) + j = occ(l,1) - k_shft + tmp_a(j,j,kk,m) += ck + enddo + enddo + enddo + + if (k_a == N_det) cycle + l = k_a+1 + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + ! Fix beta determinant, loop over alphas + do while ( lcol == kcol ) + tmp_det2(:) = psi_det_alpha_unique(:, lrow) + call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int) + if (degree == 1) then + exc = 0 + call get_single_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int) + call decode_exc_spin(exc,h1,p1,h2,p2) + ! h1 occ in k + ! p1 occ in l + ih1 = mod(h1-1,mo_num_per_kpt)+1 + ip1 = mod(p1-1,mo_num_per_kpt)+1 + kh1 = (h1-1)/mo_num_per_kpt + 1 + kp1 = (p1-1)/mo_num_per_kpt + 1 + if (kh1.ne.kp1) then + print *,'problem in: ',irp_here,'a' + print *,' h1 = ',h1 + print *,' p1 = ',p1 + print *,'ih1 = ',ih1 + print *,'ip1 = ',ip1 + print *,'kh1 = ',kh1 + print *,'kp1 = ',kp1 + !call debug_det(tmp_det,N_int) + !call debug_spindet(tmp_det2,N_int) + !call print_spindet(tmp_det2,N_int) + !stop -2 + endif + do m=1,N_states + ckl = dconjg(psi_bilinear_matrix_values_complex(k_a,m))*psi_bilinear_matrix_values_complex(l,m) * phase + tmp_a(ih1,ip1,kh1,m) += dconjg(ckl) + tmp_a(ip1,ih1,kh1,m) += ckl + enddo + endif + l = l+1 + if (l>N_det) exit + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + enddo + + enddo + !$OMP END DO NOWAIT + + !$OMP CRITICAL + one_e_dm_mo_alpha_kpts(:,:,:,:) = one_e_dm_mo_alpha_kpts(:,:,:,:) + tmp_a(:,:,:,:) + !$OMP END CRITICAL + deallocate(tmp_a) + + tmp_b = (0.d0,0.d0) + !$OMP DO SCHEDULE(dynamic,64) + do k_b=1,N_det + krow = psi_bilinear_matrix_transp_rows(k_b) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_transp_columns(k_b) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow) + tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol) + + ! Diagonal part + ! ------------- + + do kk=1,kpt_num + k_shft = (kk-1)*mo_num_per_kpt + do ii=1,N_int + tmp_det_kpts(ii,1) = iand(tmp_det(ii,1),kpts_bitmask(ii,kk)) + tmp_det_kpts(ii,2) = iand(tmp_det(ii,2),kpts_bitmask(ii,kk)) + enddo + call bitstring_to_list_ab(tmp_det_kpts, occ, n_occ, N_int) + do m=1,N_states + ck = cdabs(psi_bilinear_matrix_transp_values_complex(k_b,m)*psi_bilinear_matrix_transp_values_complex(k_b,m)) + do l=1,n_occ(2) + j = occ(l,2) - k_shft + tmp_b(j,j,kk,m) += ck + enddo + enddo + enddo + + if (k_b == N_det) cycle + l = k_b+1 + lrow = psi_bilinear_matrix_transp_rows(l) + lcol = psi_bilinear_matrix_transp_columns(l) + ! Fix beta determinant, loop over alphas + do while ( lrow == krow ) + tmp_det2(:) = psi_det_beta_unique(:, lcol) + call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int) + if (degree == 1) then + exc = 0 + call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int) + call decode_exc_spin(exc,h1,p1,h2,p2) + ih1 = mod(h1-1,mo_num_per_kpt)+1 + ip1 = mod(p1-1,mo_num_per_kpt)+1 + kh1 = (h1-1)/mo_num_per_kpt + 1 + kp1 = (p1-1)/mo_num_per_kpt + 1 + if (kh1.ne.kp1) then + print *,'problem in: ',irp_here,'b' + print *,' h1 = ',h1 + print *,' p1 = ',p1 + print *,'ih1 = ',ih1 + print *,'ip1 = ',ip1 + print *,'kh1 = ',kh1 + print *,'kp1 = ',kp1 + !stop -3 + endif + do m=1,N_states + ckl = dconjg(psi_bilinear_matrix_transp_values_complex(k_b,m))*psi_bilinear_matrix_transp_values_complex(l,m) * phase + tmp_b(ih1,ip1,kh1,m) += dconjg(ckl) + tmp_b(ip1,ih1,kh1,m) += ckl + enddo + endif + l = l+1 + if (l>N_det) exit + lrow = psi_bilinear_matrix_transp_rows(l) + lcol = psi_bilinear_matrix_transp_columns(l) + enddo + + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + one_e_dm_mo_beta_kpts(:,:,:,:) = one_e_dm_mo_beta_kpts(:,:,:,:) + tmp_b(:,:,:,:) + !$OMP END CRITICAL + + deallocate(tmp_b) + !$OMP END PARALLEL + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_dm_mo_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! One-body density matrix + END_DOC + one_e_dm_mo_kpts = one_e_dm_mo_alpha_average_kpts + one_e_dm_mo_beta_average_kpts +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, one_e_spin_density_mo_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! $\rho(\alpha) - \rho(\beta)$ + END_DOC + one_e_spin_density_mo_kpts = one_e_dm_mo_alpha_average_kpts - one_e_dm_mo_beta_average_kpts +END_PROVIDER + + +BEGIN_PROVIDER [ complex*16, one_e_spin_density_ao_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + BEGIN_DOC + ! One body spin density matrix on the |AO| basis : $\rho_{AO}(\alpha) - \rho_{AO}(\beta)$ + ! todo: verify that this is correct for complex + ! equivalent to using mo_to_ao_no_overlap? + END_DOC + implicit none + integer :: i,j,k,l,kk + complex*16 :: dm_mo + + one_e_spin_density_ao_kpts = (0.d0,0.d0) + do kk=1,kpt_num + do k = 1, ao_num_per_kpt + do l = 1, ao_num_per_kpt + do i = 1, mo_num_per_kpt + do j = 1, mo_num_per_kpt + dm_mo = one_e_spin_density_mo_kpts(j,i,kk) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_spin_density_ao_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * dm_mo + + enddo + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ complex*16, one_e_dm_ao_alpha_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] +&BEGIN_PROVIDER [ complex*16, one_e_dm_ao_beta_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ] + BEGIN_DOC + ! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$. + END_DOC + implicit none + integer :: i,j,k,l,kk + complex*16 :: mo_alpha,mo_beta + + one_e_dm_ao_alpha_kpts = (0.d0,0.d0) + one_e_dm_ao_beta_kpts = (0.d0,0.d0) + do kk=1,kpt_num + do k = 1, ao_num_per_kpt + do l = 1, ao_num_per_kpt + do i = 1, mo_num_per_kpt + do j = 1, mo_num_per_kpt + mo_alpha = one_e_dm_mo_alpha_average_kpts(j,i,kk) + mo_beta = one_e_dm_mo_beta_average_kpts(j,i,kk) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_dm_ao_alpha_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * mo_alpha + one_e_dm_ao_beta_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * mo_beta + enddo + enddo + enddo + enddo + enddo + +END_PROVIDER + + diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index 6e394572..044c7d06 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -336,6 +336,7 @@ END_PROVIDER BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo_num_per_kpt,kpt_num) ] implicit none integer :: i0,j0,i,j,k0,k,kblock,kvirt + integer :: i_i, i_j, i_k, kocc integer :: n_occ_ab(2,kpt_num) integer :: occ(N_int*bit_kind_size,2,kpt_num) integer :: n_occ_ab_virt(2) @@ -343,7 +344,7 @@ BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo integer(bit_kind) :: key_test(N_int) integer(bit_kind) :: key_virt(N_int,2) complex*16 :: accu - complex*16, allocatable :: array_coulomb(:,:),array_exchange(:,:) + complex*16, allocatable :: array_coulomb(:),array_exchange(:) do kblock = 1,kpt_num call bitstring_to_list_ab(ref_closed_shell_bitmask_kpts(1,1,kblock), & @@ -378,9 +379,9 @@ BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) enddo enddo - fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) !fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i) - fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) enddo enddo @@ -401,8 +402,8 @@ BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) enddo enddo - fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) - fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) enddo enddo @@ -423,8 +424,8 @@ BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k) enddo enddo - fock_op_cshell_ref_bitmask_cplx(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) - fock_op_cshell_ref_bitmask_cplx(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) + fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock) + fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock)) enddo enddo enddo @@ -432,69 +433,83 @@ BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo END_PROVIDER -subroutine get_single_excitation_from_fock_kpts(det_1,det_2,h,p,spin,phase,hij) - use bitmasks - implicit none - integer,intent(in) :: h,p,spin - double precision, intent(in) :: phase - integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) - complex*16, intent(out) :: hij - integer(bit_kind) :: differences(N_int,2) - integer(bit_kind) :: hole(N_int,2) - integer(bit_kind) :: partcl(N_int,2) - integer :: occ_hole(N_int*bit_kind_size,2) - integer :: occ_partcl(N_int*bit_kind_size,2) - integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) - integer :: i0,i - complex*16 :: buffer_c(mo_num),buffer_x(mo_num) -! do - do i=1, mo_num - buffer_c(i) = big_array_coulomb_integrals_kpts(i,ki,h,p,kp) - buffer_x(i) = big_array_exchange_integrals_kpts(i,ki,h,p,kp) - enddo - do i = 1, N_int - differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) - differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) - hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) - hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) - partcl(i,1) = iand(differences(i,1),det_1(i,1)) - partcl(i,2) = iand(differences(i,2),det_1(i,2)) - enddo - call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) - call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij = fock_op_cshell_ref_bitmask_cplx(h,p) - ! holes :: direct terms - do i0 = 1, n_occ_ab_hole(1) - i = occ_hole(i0,1) - hij -= buffer_c(i) - enddo - do i0 = 1, n_occ_ab_hole(2) - i = occ_hole(i0,2) - hij -= buffer_c(i) - enddo - - ! holes :: exchange terms - do i0 = 1, n_occ_ab_hole(spin) - i = occ_hole(i0,spin) - hij += buffer_x(i) - enddo - - ! particles :: direct terms - do i0 = 1, n_occ_ab_partcl(1) - i = occ_partcl(i0,1) - hij += buffer_c(i) - enddo - do i0 = 1, n_occ_ab_partcl(2) - i = occ_partcl(i0,2) - hij += buffer_c(i) - enddo - - ! particles :: exchange terms - do i0 = 1, n_occ_ab_partcl(spin) - i = occ_partcl(i0,spin) - hij -= buffer_x(i) - enddo - hij = hij * phase +subroutine get_single_excitation_from_fock_kpts(det_1,det_2,ih,ip,spin,phase,hij) + use bitmasks + !called by i_h_j{,_s2,_single_spin}_complex + ! ih, ip are indices in total mo list (not per kpt) + implicit none + integer,intent(in) :: ih,ip,spin + double precision, intent(in) :: phase + integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) + complex*16, intent(out) :: hij + integer(bit_kind) :: differences(N_int,2) + integer(bit_kind) :: hole(N_int,2) + integer(bit_kind) :: partcl(N_int,2) + integer :: occ_hole(N_int*bit_kind_size,2) + integer :: occ_partcl(N_int*bit_kind_size,2) + integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) + integer :: i0,i,h,p + integer :: ki,khp + complex*16 :: buffer_c(mo_num_per_kpt),buffer_x(mo_num_per_kpt) + khp = (ip-1)/mo_num_per_kpt+1 + p = mod(ip-1,mo_num_per_kpt)+1 + h = mod(ih-1,mo_num_per_kpt)+1 + !todo: omp kpts + do ki=1,kpt_num + do i=1, mo_num_per_kpt + ! + buffer_c(i) = big_array_coulomb_integrals_kpts(i,ki,h,p,khp) + ! + buffer_x(i) = big_array_exchange_integrals_kpts(i,ki,h,p,khp) + enddo + do i = 1, N_int + !holes in ref, not in det1 + !part in det1, not in ref + differences(i,1) = iand(xor(det_1(i,1),ref_closed_shell_bitmask(i,1)),kpts_bitmask(i,ki)) + differences(i,2) = iand(xor(det_1(i,2),ref_closed_shell_bitmask(i,2)),kpts_bitmask(i,ki)) + !differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask_kpts(i,1,ki)) + !differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask_kpts(i,2,ki)) + hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask_kpts(i,1,ki)) + hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask_kpts(i,2,ki)) + partcl(i,1) = iand(differences(i,1),det_1(i,1)) + partcl(i,2) = iand(differences(i,2),det_1(i,2)) + enddo + call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) + call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) + hij = fock_op_cshell_ref_bitmask_kpts(h,p,khp) + ! holes :: direct terms + do i0 = 1, n_occ_ab_hole(1) + i = occ_hole(i0,1) - (ki-1)*mo_num_per_kpt + hij -= buffer_c(i) + enddo + do i0 = 1, n_occ_ab_hole(2) + i = occ_hole(i0,2) - (ki-1)*mo_num_per_kpt + hij -= buffer_c(i) + enddo + + ! holes :: exchange terms + do i0 = 1, n_occ_ab_hole(spin) + i = occ_hole(i0,spin) - (ki-1)*mo_num_per_kpt + hij += buffer_x(i) + enddo + + ! particles :: direct terms + do i0 = 1, n_occ_ab_partcl(1) + i = occ_partcl(i0,1) - (ki-1)*mo_num_per_kpt + hij += buffer_c(i) + enddo + do i0 = 1, n_occ_ab_partcl(2) + i = occ_partcl(i0,2) - (ki-1)*mo_num_per_kpt + hij += buffer_c(i) + enddo + + ! particles :: exchange terms + do i0 = 1, n_occ_ab_partcl(spin) + i = occ_partcl(i0,spin) - (ki-1)*mo_num_per_kpt + hij -= buffer_x(i) + enddo + enddo + hij = hij * phase end diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 723f3194..ddd469b1 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2491,7 +2491,8 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) p = exc(1,2,2) spin = 2 endif - call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij) + !call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij) + call get_single_excitation_from_fock_kpts(key_i,key_j,m,p,spin,phase,hij) case (0) hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0) From 9fa523fe6621c7a789b159c67ca058f3826e6c4c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 26 Mar 2020 11:30:15 -0500 Subject: [PATCH 165/256] fixed kpts cipsi --- src/bitmask/bitmasks_routines.irp.f | 31 +++++++++++ src/bitmask/core_inact_act_virt.irp.f | 4 ++ src/cipsi/stochastic_cipsi.irp.f | 1 + src/determinants/density_matrix_cplx.irp.f | 11 ++-- src/determinants/slater_rules.irp.f | 54 ++++++++++++++++++-- src/iterations/print_summary.irp.f | 12 +++++ src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f | 12 +++++ src/nuclei/kconserv_cplx.irp.f | 9 ++++ src/utils_complex/dump_mo_2e_cplx.irp.f | 4 +- src/utils_complex/qp2-pbc-diff.txt | 9 ++++ 10 files changed, 139 insertions(+), 8 deletions(-) diff --git a/src/bitmask/bitmasks_routines.irp.f b/src/bitmask/bitmasks_routines.irp.f index 5c4bf347..8a374e94 100644 --- a/src/bitmask/bitmasks_routines.irp.f +++ b/src/bitmask/bitmasks_routines.irp.f @@ -214,6 +214,37 @@ subroutine print_spindet(string,Nint) end +subroutine debug_single_spindet(string,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Subroutine to print the content of a determinant in '+-' notation and + ! hexadecimal representation. + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: string(Nint) + character*(2048) :: output(1) + call bitstring_to_hexa( output(1), string(1), Nint ) + print *, trim(output(1)) + call print_single_spindet(string,Nint) + +end + +subroutine print_single_spindet(string,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Subroutine to print the content of a determinant using the '+-' notation + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: string(Nint) + character*(2048) :: output(1) + + call bitstring_to_str( output(1), string(1), Nint ) + print *, trim(output(1)) + +end + logical function is_integer_in_string(bite,string,Nint) use bitmasks implicit none diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index 337e275b..5fea3418 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -426,12 +426,16 @@ BEGIN_PROVIDER [ integer(bit_kind), kpts_bitmask , (N_int,kpt_num) ] integer :: k,i,di integer :: tmp_mo_list(mo_num_per_kpt) kpts_bitmask = 0_bit_kind + print*,'kpts bitmask' do k=1,kpt_num di=(k-1)*mo_num_per_kpt do i=1,mo_num_per_kpt tmp_mo_list(i) = i+di enddo call list_to_bitstring( kpts_bitmask(1,k), tmp_mo_list, mo_num_per_kpt, N_int) + !debugging + print*,'k' + call debug_single_spindet(kpts_bitmask(1,k),N_int) enddo END_PROVIDER diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 7a07577a..7c16cd41 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -110,6 +110,7 @@ subroutine run_stochastic_cipsi call write_double(6,correlation_energy_ratio, 'Correlation ratio') call print_summary(psi_energy_with_nucl_rep,pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2) + !call print_debug_fci() call save_energy(psi_energy_with_nucl_rep, rpt2) diff --git a/src/determinants/density_matrix_cplx.irp.f b/src/determinants/density_matrix_cplx.irp.f index c1b63cf2..d7281e76 100644 --- a/src/determinants/density_matrix_cplx.irp.f +++ b/src/determinants/density_matrix_cplx.irp.f @@ -508,9 +508,11 @@ END_PROVIDER print *,'kh1 = ',kh1 print *,'kp1 = ',kp1 !call debug_det(tmp_det,N_int) - !call debug_spindet(tmp_det2,N_int) + call debug_single_spindet(tmp_det(1,1),N_int) + call debug_single_spindet(tmp_det2,N_int) + call debug_single_spindet(tmp_det(1,2),N_int) !call print_spindet(tmp_det2,N_int) - !stop -2 + stop -2 endif do m=1,N_states ckl = dconjg(psi_bilinear_matrix_values_complex(k_a,m))*psi_bilinear_matrix_values_complex(l,m) * phase @@ -587,7 +589,10 @@ END_PROVIDER print *,'ip1 = ',ip1 print *,'kh1 = ',kh1 print *,'kp1 = ',kp1 - !stop -3 + call debug_single_spindet(tmp_det(1,2),N_int) + call debug_single_spindet(tmp_det2,N_int) + call debug_single_spindet(tmp_det(1,1),N_int) + stop -3 endif do m=1,N_states ckl = dconjg(psi_bilinear_matrix_transp_values_complex(k_b,m))*psi_bilinear_matrix_transp_values_complex(l,m) * phase diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index ddd469b1..a4fc267a 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2418,9 +2418,11 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) complex*16 :: get_two_e_integral_complex integer :: m,n,p,q integer :: i,j,k + integer :: ih1,ih2,ip1,ip2,kh1,kh2,kp1,kp2 integer :: occ(Nint*bit_kind_size,2) double precision :: diag_H_mat_elem, phase integer :: n_occ_ab(2) + logical :: is_allowed PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ASSERT (Nint > 0) @@ -2439,11 +2441,38 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) case (2) call get_double_excitation(key_i,key_j,exc,phase,Nint) if (exc(0,1,1) == 1) then + call double_allowed_mo_kpts(exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2),is_allowed) + if (.not.is_allowed) then + hij = (0.d0,0.d0) + return + endif ! Single alpha, single beta if(exc(1,1,1) == exc(1,2,2) )then - hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1 + ih2 = mod(exc(1,1,2)-1,mo_num_per_kpt)+1 + kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1 + kh2 = (exc(1,1,2)-1)/mo_num_per_kpt+1 + ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1 + kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1 + if(kp1.ne.kh2) then + print*,'problem with hij kpts: ',irp_here + stop -4 + endif + hij = phase * big_array_exchange_integrals_kpts(ih1,kh1,ih2,ip1,kp1) + !hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1 + kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1 + ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1 + kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1 + ip2 = mod(exc(1,2,2)-1,mo_num_per_kpt)+1 + kp2 = (exc(1,2,2)-1)/mo_num_per_kpt+1 + if(kp2.ne.kh1) then + print*,'problem with hij kpts: ',irp_here + stop -4 + endif + hij = phase * big_array_exchange_integrals_kpts(ip1,kp1,ih1,ip2,kp2) + !hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else hij = phase*get_two_e_integral_complex( & exc(1,1,1), & @@ -2452,6 +2481,11 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) endif else if (exc(0,1,1) == 2) then + call double_allowed_mo_kpts(exc(1,1,1),exc(2,1,1),exc(1,2,1),exc(2,2,1),is_allowed) + if (.not.is_allowed) then + hij = (0.d0,0.d0) + return + endif ! Double alpha hij = phase*(get_two_e_integral_complex( & exc(1,1,1), & @@ -2464,6 +2498,11 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) exc(2,2,1), & exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) ) else if (exc(0,1,2) == 2) then + call double_allowed_mo_kpts(exc(1,1,2),exc(2,1,2),exc(1,2,2),exc(2,2,2),is_allowed) + if (.not.is_allowed) then + hij = (0.d0,0.d0) + return + endif ! Double beta hij = phase*(get_two_e_integral_complex( & exc(1,1,2), & @@ -2491,6 +2530,11 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) p = exc(1,2,2) spin = 2 endif + !if m,p not from same kpt, single not allowed + if (int((m-1)/mo_num_per_kpt + 1).ne.int((p-1)/mo_num_per_kpt + 1)) then + hij = (0.d0,0.d0) + return + endif !call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij) call get_single_excitation_from_fock_kpts(key_i,key_j,m,p,spin,phase,hij) @@ -2775,10 +2819,12 @@ subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij) integer :: exc(0:2,2) double precision :: phase - PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map + !PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map + PROVIDE big_array_exchange_integrals_kpts mo_two_e_integrals_in_map call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) - call get_single_excitation_from_fock_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) + !call get_single_excitation_from_fock_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) + call get_single_excitation_from_fock_kpts(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij) end subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij) diff --git a/src/iterations/print_summary.irp.f b/src/iterations/print_summary.irp.f index ad87bc8e..87bc28fa 100644 --- a/src/iterations/print_summary.irp.f +++ b/src/iterations/print_summary.irp.f @@ -102,3 +102,15 @@ subroutine print_summary(e_,pt2_,error_,variance_,norm_,n_det_,n_occ_pattern_,n_ end subroutine +subroutine print_debug_fci + implicit none + integer :: i + do i=1,n_det + print'(2((F25.15),2X))',psi_coef_complex(i,1) + call debug_det(psi_det(1,1,i),n_int) + enddo + print*,'hamiltonian' + do i=1,n_det + print '(1000(F25.15))',h_matrix_all_dets_complex(i,:) + enddo +end subroutine diff --git a/src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f b/src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f index 632ff591..8b96c498 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_cplx.irp.f @@ -1,4 +1,16 @@ +subroutine double_allowed_mo_kpts(h1,h2,p1,p2,is_allowed) + implicit none + integer, intent(in) :: h1,h2,p1,p2 + logical, intent(out) :: is_allowed + integer :: kh1,kh2,kp1,kp2 + + kh1 = (h1-1)/mo_num_per_kpt+1 + kh2 = (h2-1)/mo_num_per_kpt+1 + kp1 = (p1-1)/mo_num_per_kpt+1 + kp2 = (p2-1)/mo_num_per_kpt+1 + call double_allowed_kpts(kh1,kh2,kp1,kp2,is_allowed) +end subroutine subroutine add_integrals_to_map_complex(mask_ijkl) use map_module diff --git a/src/nuclei/kconserv_cplx.irp.f b/src/nuclei/kconserv_cplx.irp.f index 8978ed9b..616ba779 100644 --- a/src/nuclei/kconserv_cplx.irp.f +++ b/src/nuclei/kconserv_cplx.irp.f @@ -29,3 +29,12 @@ BEGIN_PROVIDER [integer, kconserv, (kpt_num,kpt_num,kpt_num)] print *, 'kconserv written to disk' endif END_PROVIDER + +subroutine double_allowed_kpts(kh1,kh2,kp1,kp2,is_allowed) + implicit none + integer, intent(in) :: kh1,kh2,kp1,kp2 + logical, intent(out) :: is_allowed + + is_allowed = (kconserv(kh1,kh2,kp1) == kp2) +end subroutine + diff --git a/src/utils_complex/dump_mo_2e_cplx.irp.f b/src/utils_complex/dump_mo_2e_cplx.irp.f index 80dba969..44bb706d 100644 --- a/src/utils_complex/dump_mo_2e_cplx.irp.f +++ b/src/utils_complex/dump_mo_2e_cplx.irp.f @@ -15,7 +15,9 @@ subroutine run do k=1,mo_num do l=1,mo_num tmp_cmplx = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) - print'(4(I4),2(E23.15))',i,j,k,l,tmp_cmplx + if (cdabs(tmp_cmplx).gt. 1d-12) then + print'(4(I4),2(E23.15))',i,j,k,l,tmp_cmplx + endif enddo enddo enddo diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index e7345240..8148248c 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/src/utils_complex/qp2-pbc-diff.txt @@ -1,4 +1,13 @@ +kpts: + changed matrices to block diagonal (1-e ints, fock, 1rdm) + double_allowed_mo_kpts(h1,h2,p1,p2,is_allowed) + {h,p}{1,2} indices in total mo_num (not per kpt) + double_allowed_kpts(kh1,kh2,kp1,kp2,is_allowed) + k{h,p}{1,2} k-point indices + + only allow momentum-conserving excitations + todo: change everything to be blocked by kpt From 437846e4d2253f6d20609912afe05088076683d2 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 26 Mar 2020 11:46:32 -0500 Subject: [PATCH 166/256] printing --- src/bitmask/core_inact_act_virt.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index 5fea3418..d2efef89 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -434,7 +434,7 @@ BEGIN_PROVIDER [ integer(bit_kind), kpts_bitmask , (N_int,kpt_num) ] enddo call list_to_bitstring( kpts_bitmask(1,k), tmp_mo_list, mo_num_per_kpt, N_int) !debugging - print*,'k' + print*,'k = ',k call debug_single_spindet(kpts_bitmask(1,k),N_int) enddo END_PROVIDER From 9ddd8f5e7d42813999125eaa72cb22e5d3cd86a5 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 26 Mar 2020 15:36:15 -0500 Subject: [PATCH 167/256] explicit types --- src/determinants/spindeterminants.irp.f | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f index 028122ec..62db470b 100644 --- a/src/determinants/spindeterminants.irp.f +++ b/src/determinants/spindeterminants.irp.f @@ -416,6 +416,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ] use bitmasks PROVIDE psi_bilinear_matrix_rows + integer :: k,l do k=1,N_det do l=1,N_states psi_bilinear_matrix_values(k,l) = psi_coef(k,l) @@ -429,6 +430,7 @@ END_PROVIDER BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_values_complex, (N_det,N_states) ] use bitmasks PROVIDE psi_bilinear_matrix_rows + integer :: k,l do k=1,N_det do l=1,N_states psi_bilinear_matrix_values_complex(k,l) = psi_coef_complex(k,l) From 2845b1c8ea7a1e97e49309022614d19467c03469 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 26 Mar 2020 16:46:52 -0500 Subject: [PATCH 168/256] fixed mpi double include --- src/davidson/davidson_parallel.irp.f | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index 128f3156..a7168297 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -105,6 +105,9 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, ! integer, external :: zmq_get_dvector integer, external :: zmq_get_dmatrix integer, external :: zmq_get_cdmatrix + IRP_IF MPI + include 'mpif.h' + IRP_ENDIF if (is_complex) then complex*16, allocatable :: v_tc(:,:), s_tc(:,:), u_tc(:,:) @@ -140,7 +143,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, enddo IRP_IF MPI - include 'mpif.h' +! include 'mpif.h' call broadcast_chunks_complex_double(u_tc,size(u_tc,kind=8)) IRP_ENDIF @@ -202,7 +205,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, enddo IRP_IF MPI - include 'mpif.h' + !include 'mpif.h' call broadcast_chunks_double(u_t,size(u_t,kind=8)) IRP_ENDIF From 4a31254d6b1dae53c7efad6d0e4f3396e271c819 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 27 Mar 2020 11:29:24 -0500 Subject: [PATCH 169/256] fixed AO/MO mistake in bitmask --- src/bitmask/bitmasks.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index 75421967..d8580e63 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -85,7 +85,7 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)] kpt=1 korb=1 do i=1,elec_alpha_num - occ(i) = korb + (kpt-1) * ao_num_per_kpt + occ(i) = korb + (kpt-1) * mo_num_per_kpt kpt += 1 if (kpt > kpt_num) then kpt = 1 From 1277f78d72facd6b7ea97ebf579701f17029db37 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 31 Mar 2020 14:20:20 -0500 Subject: [PATCH 170/256] updated converter --- src/utils_complex/MolPyscfToQPkpts.py | 87 +++++++++++-------- .../create_ezfio_complex_3idx.py | 2 +- 2 files changed, 53 insertions(+), 36 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 2f74c089..78d94999 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -553,14 +553,25 @@ def df_ao_to_mo_test(j3ao,mo_coef): np.einsum('mij,ik,jl->mkl',j3ao[idx2_tri((ki,kj))],mo_coef[ki].conj(),mo_coef[kj]) for ki,kj in product(range(Nk),repeat=2) if (ki>=kj)]) +def pyscf2QP2_mo(cell,mf,kpts,kmesh=None,cas_idx=None, int_threshold = 1E-8,qph5path='qpdat.h5'): + pyscf2QP2(cell,mf,kpts,kmesh,cas_idx,int_threshold,qph5path, + print_ao_ints_df=False, + print_mo_ints_df=True, + print_ao_ints_mono=False, + print_mo_ints_mono=True) + return + + def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, + qph5path = 'qpdat.h5', print_ao_ints_bi=False, print_mo_ints_bi=False, print_ao_ints_df=True, print_mo_ints_df=False, print_ao_ints_mono=True, - print_mo_ints_mono=False): + print_mo_ints_mono=False, + print_debug=False): ''' kpts = List of kpoints coordinates. Cannot be null, for gamma is other script kmesh = Mesh of kpoints (optional) @@ -582,7 +593,7 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, thresh_mono = int_threshold - qph5path = 'qpdat.h5' +# qph5path = 'qpdat.h5' # create hdf5 file, delete old data if exists with h5py.File(qph5path,'w') as qph5: qph5.create_group('nuclei') @@ -685,14 +696,15 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c') mo_coef_blocked=block_diag(*mo_k) mo_coef_blocked_f = block_diag(*mo_coef_f) - qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) - qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) - qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) - qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + #qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) + #qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) + #qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) + #qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) - print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) + if print_debug: + print_kpts_unblocked(mo_k,'C.qp',mo_coef_threshold) ########################################## # # @@ -719,23 +731,24 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ovlp_ao_blocked_f = block_diag(*ovlp_ao_f) ne_ao_blocked_f = block_diag(*ne_ao_f) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) - qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic',data=kin_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) - qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap',data=ovlp_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) - qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=ne_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic',data=kin_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap',data=ovlp_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) + #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=ne_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_kpts',data=kin_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_kpts',data=ovlp_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_kpts', data=ne_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) - for fname,ints in zip(('S.qp','V.qp','T.qp'), - (ovlp_ao, ne_ao, kin_ao)): - print_kpts_unblocked_upper(ints,fname,thresh_mono) + if print_debug: + for fname,ints in zip(('S.qp','V.qp','T.qp'), + (ovlp_ao, ne_ao, kin_ao)): + print_kpts_unblocked_upper(ints,fname,thresh_mono) if print_mo_ints_mono: kin_mo = ao_to_mo_1e(kin_ao,mo_k) @@ -754,23 +767,24 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, kin_mo_blocked_f = block_diag(*kin_mo_f) ovlp_mo_blocked_f = block_diag(*ovlp_mo_f) ne_mo_blocked_f = block_diag(*ne_mo_f) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) - qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) - qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) - qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic',data=kin_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) - qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap',data=ovlp_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) - qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e', data=ne_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic',data=kin_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap',data=ovlp_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) + #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e', data=ne_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_kpts',data=kin_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_kpts',data=ovlp_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_kpts', data=ne_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) - for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), - (ovlp_mo, ne_mo, kin_mo)): - print_kpts_unblocked_upper(ints,fname,thresh_mono) + if print_debug: + for fname,ints in zip(('S.mo.qp','V.mo.qp','T.mo.qp'), + (ovlp_mo, ne_mo, kin_mo)): + print_kpts_unblocked_upper(ints,fname,thresh_mono) ########################################## @@ -784,8 +798,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, with h5py.File(qph5path,'a') as qph5: kcon_f_phys = np.array(kconserv.transpose((1,2,0)),order='c') qph5.create_dataset('nuclei/kconserv',data=kcon_f_phys+1) - - print_kcon_chem_to_phys(kconserv,'K.qp') + + if print_debug: + print_kcon_chem_to_phys(kconserv,'K.qp') ########################################## # # @@ -805,7 +820,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) if print_ao_ints_df: - print_df(j3arr,'D.qp',bielec_int_threshold) + if print_debug: + print_df(j3arr,'D.qp',bielec_int_threshold) with h5py.File(qph5path,'a') as qph5: #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) @@ -817,7 +833,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, j3mo = df_ao_to_mo(j3arr,mo_k) j3mo_new = df_ao_to_mo_new(j3ao_new,mo_k) - print_df(j3mo,'D.mo.qp',bielec_int_threshold) + if print_debug: + print_df(j3mo,'D.mo.qp',bielec_int_threshold) with h5py.File(qph5path,'a') as qph5: #qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=j3mo.transpose((2,3,1,0)).real) diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index ae6be312..0360cfe8 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -139,7 +139,7 @@ def convert_kpts(filename,qph5path): with h5py.File(qph5path,'r') as qph5: if 'mo_one_e_ints' in qph5.keys(): kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic_kpts'][()].tolist() - ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() + ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap_kpts'][()].tolist() ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e_kpts'][()].tolist() ezfio.set_mo_one_e_ints_mo_integrals_kinetic_kpts(kin_mo_reim) From 1efe61efd0855569b104d6fa07c048bb67275050 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 31 Mar 2020 14:24:32 -0500 Subject: [PATCH 171/256] nexus script to generate pyscf input with twists --- src/utils_complex/generate_pyscf_twists.py | 244 +++++++++++++++++++++ 1 file changed, 244 insertions(+) create mode 100644 src/utils_complex/generate_pyscf_twists.py diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py new file mode 100644 index 00000000..78f2467f --- /dev/null +++ b/src/utils_complex/generate_pyscf_twists.py @@ -0,0 +1,244 @@ +#! /usr/bin/env python + +from nexus import settings,job,run_project,obj +from nexus import generate_physical_system +from nexus import generate_pyscf +import spglib +import numpy as np +import os + +settings( + results = '', + sleep = 3, + machine = 'ws8', + generate_only=1, + ) + +solid_tmp_file = './.tmp_solid_template.py' +jobparams={} +jobparams['dfname'] = 'df_ints.h5' +jobparams['chkname'] = 'diamond.chk' +jobparams['dftype'] = 'GDF' +jobparams['auxbasis'] = 'weigend' +jobparams['xc'] = 'b3lyp' + +show_kmap = True + +pyscf_job = job(cores=1,serial=True) + +cell_types = [ + 'diamond_8_real', +# 'diamond_8_comp', + ] + +cell_info = obj( + diamond_8_real = obj( +# tiling = [[ 1, -1, 1], +# [ 1, 1, -1], +# [-1, 1, 1]], + tiling = (2,2,2), + kgrid = (6,6,6), + ), + ) + +a = 3.37316115 +axes = np.array([[a,a,0],[0,a,a],[a,0,a]]) +elem = ['C','C'] +pos = [[0,0,0],[a/2,a/2,a/2]] + +scf_info = obj( + basis = 'bfd-vdz', + ecp = 'bfd', + drop_exponent = 0.1, + verbose = 5, + ) + +tempstr = """ +#!/usr/bin/env python + +''' +Gamma point post-HF calculation needs only real integrals. +Methods implemented in finite-size system can be directly used here without +any modification. +''' + +import numpy as np +from pyscf import lib +from pyscf.pbc import gto, scf, dft +from pyscf import gto as Mgto +from pyscf.pbc import df +from pyscf.pbc import ao2mo +from pyscf.pbc import tools +from pyscf.pbc.tools.pbc import super_cell +from functools import reduce +import scipy.linalg as la +import os + +restart = False + +$system + +$twistinfo + +pwd_top = os.path.dirname(os.path.realpath(__file__)) +for i in range(2,3): + jobdir=pwd_top + '/twist-{:02d}/'.format(i) + if not restart: + os.mkdir(jobdir) + os.chdir(jobdir) + sp_twist=supTwist[i] + kpts_i=allkpts[i] + print("i ",i, kpts_i) + supcell=cell + mydf = df.$dftype(supcell,kpts_i) + mydf.auxbasis = '$auxbasis' + dfpath = jobdir+'$dfname' + if not restart: + mydf._cderi_to_save = dfpath # new + mydf.build() # new + #end if + mf = scf.KROKS(supcell,kpts_i).density_fit() + mf.xc='$xc' + + mf.tol = 1e-10 + + mf.exxdiv = 'ewald' + mf.with_df = mydf + chkpath = jobdir + '$chkname' + mf.chkfile = chkpath + mf.with_df._cderi = dfpath + if restart: + dm = mf.from_chk(chkpath) # restart + e_scf=mf.kernel(dm) # restart + else: + e_scf=mf.kernel() # new + #end if + + with open('e_scf','w') as ener: + ener.write('%s\n' % (e_scf)) + print('e_scf',e_scf) + + #title="S8-twist%s"%i + #### generated conversion text ### + #from PyscfToQmcpack import savetoqmcpack + #savetoqmcpack(cell,mf,title=title,kmesh=kmesh,kpts=kpts_i,sp_twist=sp_twist) + + mycas = list(range(0,30)) + #title="S8-Cas30-twist%s"%i + #### generated conversion text ### + #from PyscfToQmcpack import savetoqmcpack + #savetoqmcpack(cell,mf,title=title,kmesh=kmesh,kpts=kpts_i,sp_twist=sp_twist, cas_idx=mycas) + #### end generated conversion text ### + + from MolPyscfToQPkpts import pyscf2QP2 + pyscf2QP2(supcell,mf,kpts=kpts_i,int_threshold = 1E-15,cas_idx=mycas) + print('Done for Tw%s'%i) + os.chdir(pwd_top) + +""" + +#replace $dfname with df_ints.h5 +#replace $chkname with checkpoint file name +#$dftype is GDF, MDF, etc. +#$auxbasis weigend? +#$xc b3lyp +#$twistinfo + + +for cell_type in cell_types: + cell_tiling = cell_info[cell_type].tiling + cell_kgrid = cell_info[cell_type].kgrid + + diamond = generate_physical_system( +# axes = ''' +# 3.37316115 3.37316115 0.00000000 +# 0.00000000 3.37316115 3.37316115 +# 3.37316115 0.00000000 3.37316115''', +# elem_pos = ''' +# C 0.00000000 0.00000000 0.00000000 +# C 1.686580575 1.686580575 1.686580575''', + axes = axes, + elem = elem, + pos = pos, + units = 'B', + tiling = cell_tiling, + kgrid = cell_kgrid, + kshift = (0,0,0), + C = 4, + symm_kgrid=True, + ) + + + jobparams['twistinfo'] = '' + if show_kmap: + print (cell_type) + print ('===============================') + s = diamond.structure.copy() + kmap = s.kmap() + + print ('supercell kpoints/twists') + jobparams['twistinfo']+='# supercell kpoints/twists\n' + jobparams['twistinfo']+='supTwist=array([\n' + for i,k in enumerate(s.kpoints): + print (' ',i,k) + jobparams['twistinfo']+=(str(list(k))+',\n') + #end for + jobparams['twistinfo']+='])\n' + + print ('primitive cell kpoints') + # this should already be written by nexus as part of $system + #jobparams['twistinfo']+='# primitive cell kpoints\n') + #jobparams['twistinfo']+='orig=array([\n' + for i,k in enumerate(s.folded_structure.kpoints): + print (' ',i,k) + #jobparams['twistinfo']+=(str(list(k))+',\n') + #end for + #jobparams['twistinfo']+='])\n' + + jobparams['twistinfo']+='# mapping from supercell to primitive cell k-points\n' + jobparams['twistinfo']+='mymap=array([\n' + for kmapkey in kmap.sorted_keys(): + jobparams['twistinfo']+=(str(list(kmap[kmapkey]))+',\n') + jobparams['twistinfo']+='])\n' + print ('mapping from supercell to primitive cell k-points') + print (kmap) + + #jobparams['twistinfo']+=('allkpts=array(list(map(lambda xs: list(map(lambda x: orig[x], xs)), mymap)))\n') + jobparams['twistinfo']+=('allkpts=array(list(map(lambda xs: list(map(lambda x: kpts[x], xs)), mymap)))\n') + jobparams['twistinfo']+=('kweights=array('+str(list(s.kweights))+')\n') + #end if + + tmp_template = tempstr + for key in jobparams.keys(): + tmp_template = tmp_template.replace('$'+key,jobparams[key]) + + if os.path.isfile(solid_tmp_file): + raise Exception(solid_tmp_file,'solid_tmp_file already exists: delete file and try again') + with open(solid_tmp_file,'w') as stmp: + stmp.write(tmp_template) + + scf = generate_pyscf( + identifier = 'scf', + path = cell_type, + job = pyscf_job, + template = solid_tmp_file, + system = diamond, + cell = scf_info, +# cell = obj( +# basis = 'bfd-vtz', +# ecp = 'bfd', +# drop_exponent = 0.1, +# verbose = 5, +# ), + save_qmc = True , + ) + if os.path.isfile(solid_tmp_file): + os.remove(solid_tmp_file) + +#end for + +#if show_kmap: +# exit() +#end if + +run_project() From ee40465648a2b937a2a95b3e013bf74a728c5861 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 31 Mar 2020 14:32:26 -0500 Subject: [PATCH 172/256] kpt loop range in nexus script --- src/utils_complex/generate_pyscf_twists.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py index 78f2467f..0f05d52a 100644 --- a/src/utils_complex/generate_pyscf_twists.py +++ b/src/utils_complex/generate_pyscf_twists.py @@ -81,7 +81,7 @@ $system $twistinfo pwd_top = os.path.dirname(os.path.realpath(__file__)) -for i in range(2,3): +for i in range(len(allkpts)): jobdir=pwd_top + '/twist-{:02d}/'.format(i) if not restart: os.mkdir(jobdir) From 5fee067556c329f1cd2f49ec86bd98e021fd6bef Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 31 Mar 2020 14:38:23 -0500 Subject: [PATCH 173/256] escape newline in nexus script --- src/utils_complex/generate_pyscf_twists.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py index 0f05d52a..ba29a59f 100644 --- a/src/utils_complex/generate_pyscf_twists.py +++ b/src/utils_complex/generate_pyscf_twists.py @@ -115,7 +115,7 @@ for i in range(len(allkpts)): #end if with open('e_scf','w') as ener: - ener.write('%s\n' % (e_scf)) + ener.write('%s\\n' % (e_scf)) print('e_scf',e_scf) #title="S8-twist%s"%i From 338f9ca2f8199ffce08dac91a7a5c09e41142465 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 1 Apr 2020 19:45:39 -0500 Subject: [PATCH 174/256] updated nexus converter --- src/utils_complex/generate_pyscf_twists.py | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py index ba29a59f..4d1495d7 100644 --- a/src/utils_complex/generate_pyscf_twists.py +++ b/src/utils_complex/generate_pyscf_twists.py @@ -185,23 +185,28 @@ for cell_type in cell_types: #end for jobparams['twistinfo']+='])\n' - print ('primitive cell kpoints') + #print ('primitive cell kpoints') # this should already be written by nexus as part of $system #jobparams['twistinfo']+='# primitive cell kpoints\n') #jobparams['twistinfo']+='orig=array([\n' - for i,k in enumerate(s.folded_structure.kpoints): - print (' ',i,k) + #for i,k in enumerate(s.folded_structure.kpoints): + #print (' ',i,k) #jobparams['twistinfo']+=(str(list(k))+',\n') #end for #jobparams['twistinfo']+='])\n' jobparams['twistinfo']+='# mapping from supercell to primitive cell k-points\n' jobparams['twistinfo']+='mymap=array([\n' - for kmapkey in kmap.sorted_keys(): - jobparams['twistinfo']+=(str(list(kmap[kmapkey]))+',\n') + if kmap is None: + for i in range(len(s.kpoints)): + jobparams['twistinfo']+=('['+str(i)+'],\n') + else: + for kmapkey in kmap.sorted_keys(): + jobparams['twistinfo']+=(str(list(kmap[kmapkey]))+',\n') jobparams['twistinfo']+='])\n' print ('mapping from supercell to primitive cell k-points') - print (kmap) + if kmap is not None: + print (kmap) #jobparams['twistinfo']+=('allkpts=array(list(map(lambda xs: list(map(lambda x: orig[x], xs)), mymap)))\n') jobparams['twistinfo']+=('allkpts=array(list(map(lambda xs: list(map(lambda x: kpts[x], xs)), mymap)))\n') From 1e2a8455d324357a74d251939ea081332be5bfda Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 2 Apr 2020 10:04:54 -0500 Subject: [PATCH 175/256] converter fixes --- src/utils_complex/MolPyscfToQPkpts.py | 18 ++++++++++-------- src/utils_complex/generate_pyscf_twists.py | 15 +++++++++------ 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 78d94999..b7fddf5b 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -544,7 +544,7 @@ def df_ao_to_mo_new(j3ao,mo_coef): Nk = mo_coef.shape[0] return np.array([ np.einsum('mji,ik,jl->mlk',j3ao[idx2_tri((ki,kj))],mo_coef[ki].conj(),mo_coef[kj]) - for ki,kj in product(range(Nk),repeat=2) if (ki>=kj)]) + for ki,kj in product(range(Nk),repeat=2) if (ki>=kj)],dtype=np.complex128) def df_ao_to_mo_test(j3ao,mo_coef): from itertools import product @@ -693,13 +693,15 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, with h5py.File(qph5path,'a') as qph5: # k,mo,ao(,2) - mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c') + mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c',dtype=np.complex128) mo_coef_blocked=block_diag(*mo_k) mo_coef_blocked_f = block_diag(*mo_coef_f) #qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) #qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) #qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) #qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) + print(mo_coef_f.dtype) + print(mo_coef_blocked_f.dtype) qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) @@ -723,9 +725,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ovlp_ao_blocked=block_diag(*ovlp_ao) ne_ao_blocked=block_diag(*ne_ao) - kin_ao_f = np.array(kin_ao.transpose((0,2,1)),order='c') - ovlp_ao_f = np.array(ovlp_ao.transpose((0,2,1)),order='c') - ne_ao_f = np.array(ne_ao.transpose((0,2,1)),order='c') + kin_ao_f = np.array(kin_ao.transpose((0,2,1)),order='c',dtype=np.complex128) + ovlp_ao_f = np.array(ovlp_ao.transpose((0,2,1)),order='c',dtype=np.complex128) + ne_ao_f = np.array(ne_ao.transpose((0,2,1)),order='c',dtype=np.complex128) kin_ao_blocked_f = block_diag(*kin_ao_f) ovlp_ao_blocked_f = block_diag(*ovlp_ao_f) @@ -760,9 +762,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ne_mo_blocked=block_diag(*ne_mo) with h5py.File(qph5path,'a') as qph5: - kin_mo_f = np.array(kin_mo.transpose((0,2,1)),order='c') - ovlp_mo_f = np.array(ovlp_mo.transpose((0,2,1)),order='c') - ne_mo_f = np.array(ne_mo.transpose((0,2,1)),order='c') + kin_mo_f = np.array(kin_mo.transpose((0,2,1)),order='c',dtype=np.complex128) + ovlp_mo_f = np.array(ovlp_mo.transpose((0,2,1)),order='c',dtype=np.complex128) + ne_mo_f = np.array(ne_mo.transpose((0,2,1)),order='c',dtype=np.complex128) kin_mo_blocked_f = block_diag(*kin_mo_f) ovlp_mo_blocked_f = block_diag(*ovlp_mo_f) diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py index 4d1495d7..f6f9be95 100644 --- a/src/utils_complex/generate_pyscf_twists.py +++ b/src/utils_complex/generate_pyscf_twists.py @@ -36,8 +36,8 @@ cell_info = obj( # tiling = [[ 1, -1, 1], # [ 1, 1, -1], # [-1, 1, 1]], - tiling = (2,2,2), - kgrid = (6,6,6), + tiling = (1,1,1), + kgrid = (12,12,12), ), ) @@ -196,14 +196,17 @@ for cell_type in cell_types: #jobparams['twistinfo']+='])\n' jobparams['twistinfo']+='# mapping from supercell to primitive cell k-points\n' - jobparams['twistinfo']+='mymap=array([\n' + if kmap is None: - for i in range(len(s.kpoints)): - jobparams['twistinfo']+=('['+str(i)+'],\n') + nkpts = str(len(s.kpoints)) + jobparams['twistinfo']+='mymap=np.arange('+nkpts+').reshape(('+nkpts+',1))\n' + #for i in range(len(s.kpoints)): + # jobparams['twistinfo']+=('['+str(i)+'],\n') else: + jobparams['twistinfo']+='mymap=array([\n' for kmapkey in kmap.sorted_keys(): jobparams['twistinfo']+=(str(list(kmap[kmapkey]))+',\n') - jobparams['twistinfo']+='])\n' + jobparams['twistinfo']+='])\n' print ('mapping from supercell to primitive cell k-points') if kmap is not None: print (kmap) From b2a928f0221a055cd4fb7e1ea44bfdf8cea41c58 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 3 Apr 2020 10:23:35 -0500 Subject: [PATCH 176/256] fixed complex dist davidson (zmq) --- src/cipsi/slave_cipsi.irp.f | 2 +- src/davidson/davidson_parallel.irp.f | 62 ++++++++++++++++------------ src/zmq/put_get.irp.f | 3 ++ 3 files changed, 40 insertions(+), 27 deletions(-) diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index 5e77e7f6..eaa64673 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -16,7 +16,7 @@ end subroutine provide_everything if (is_complex) then PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag - PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context + PROVIDE pt2_e0_denominator mo_num_per_kpt N_int ci_energy mpi_master zmq_state zmq_context PROVIDE psi_det psi_coef_complex threshold_generators state_average_weight PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym else diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index a7168297..8981e3f3 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -139,7 +139,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, do while (zmq_get_cdmatrix(zmq_to_qp_run_socket, worker_id, 'u_tc', u_tc, ni, nj, size(u_tc,kind=8)) == -1) print *, 'mpi_rank, N_states_diag, N_det' print *, mpi_rank, N_states_diag, N_det - stop 'u_t' + stop 'u_tc' enddo IRP_IF MPI @@ -737,21 +737,26 @@ subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, sz = (imax-imin+1)*N_states_diag rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push task_id' + if(rc /= 4) stop 'davidson_push_results_complex failed to push task_id' rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push imin' + if(rc /= 4) stop 'davidson_push_results_complex failed to push imin' rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push imax' + if(rc /= 4) stop 'davidson_push_results_complex failed to push imax' !todo: double sz for complex? (done) rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE) - if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' + if(rc8 /= 8_8*sz*2) then + print*,irp_here,' rc8 = ',rc8 + print*,irp_here,' sz = ',sz + print*,'rc8 /= sz*8' + stop 'davidson_push_results_complex failed to push vt' + endif !todo: double sz for complex? (done) rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0) - if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' + if(rc8 /= 8_8*sz*2) stop 'davidson_push_results_complex failed to push st' ! Activate is zmq_socket_push is a REQ IRP_IF ZMQ_PUSH @@ -790,21 +795,26 @@ subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, i sz = (imax-imin+1)*N_states_diag rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push task_id' + if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push task_id' rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push imin' + if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push imin' rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE) - if(rc /= 4) stop 'davidson_push_results failed to push imax' + if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push imax' !todo: double sz for complex? (done) rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE) - if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt' + if(rc8 /= 8_8*sz*2) then + print*,irp_here,' rc8 = ',rc8 + print*,irp_here,' sz = ',sz + print*,'rc8 /= sz*8' + stop 'davidson_push_results_async_send_complex failed to push vt' + endif !todo: double sz for complex? (done) rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0) - if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st' + if(rc8 /= 8_8*sz*2) stop 'davidson_push_results_async_send_complex failed to push st' end subroutine @@ -837,11 +847,11 @@ subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, !todo: double sz for complex? (done) rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz*2, 0) - if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t' + if(rc8 /= 8*sz*2) stop 'davidson_pull_results_complex failed to pull v_t' !todo: double sz for complex? (done) rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz*2, 0) - if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t' + if(rc8 /= 8*sz*2) stop 'davidson_pull_results_complex failed to pull s_t' ! Activate if zmq_socket_pull is a REP IRP_IF ZMQ_PUSH @@ -906,8 +916,8 @@ end subroutine subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) !todo: maybe make separate zmq_put_psi_complex? - print*,irp_here,' not implemented for complex' - stop -1 + !print*,irp_here,' not implemented for complex' + !stop -1 use omp_lib use bitmasks use f77_zmq @@ -926,8 +936,8 @@ subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) complex*16, intent(inout) :: u_0(sze,N_st) integer :: i,j,k integer :: ithread - complex*16, allocatable :: u_t(:,:) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t + complex*16, allocatable :: u_tc(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_tc integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique PROVIDE psi_bilinear_matrix_transp_values_complex psi_bilinear_matrix_values_complex psi_bilinear_matrix_columns_loc @@ -986,7 +996,7 @@ subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) ipos=1 endif - allocate(u_t(N_st,N_det)) + allocate(u_tc(N_st,N_det)) do k=1,N_st call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) enddo @@ -994,8 +1004,8 @@ subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) call cdtranspose( & u_0, & size(u_0, 1), & - u_t, & - size(u_t, 1), & + u_tc, & + size(u_tc, 1), & N_det, N_st) @@ -1008,20 +1018,20 @@ subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze) integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag integer, external :: zmq_put_cdmatrix - if (size(u_t) < 8388608) then - ni = size(u_t) + if (size(u_tc,kind=8) < 8388608_8) then + ni = size(u_tc) nj = 1 else ni = 8388608 - nj = size(u_t)/8388608 + 1 + nj = int(size(u_tc,kind=8)/8388608_8,4) + 1 endif ! Warning : dimensions are modified for efficiency, It is OK since we get the ! full matrix - if (zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, 'u_t', u_t, ni, nj, size(u_t,kind=8)) == -1) then - stop 'Unable to put u_t on ZMQ server' + if (zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, 'u_tc', u_tc, ni, nj, size(u_tc,kind=8)) == -1) then + stop 'Unable to put u_tc on ZMQ server' endif - deallocate(u_t) + deallocate(u_tc) integer, external :: zmq_set_running if (zmq_set_running(zmq_to_qp_run_socket) == -1) then diff --git a/src/zmq/put_get.irp.f b/src/zmq/put_get.irp.f index 3985721d..4669d0f6 100644 --- a/src/zmq/put_get.irp.f +++ b/src/zmq/put_get.irp.f @@ -540,6 +540,9 @@ integer function zmq_get_cdmatrix(zmq_to_qp_run_socket, worker_id, name, x, size endif rc = f77_zmq_recv8(zmq_to_qp_run_socket,x(1,j),ni*8_8*2,0) + !print *,irp_here, 'rc = ',rc + !print *,irp_here, 'ni = ',ni + !print *,irp_here, ' j = ',j if (rc /= ni*8_8*2) then print *, irp_here, 'rc /= size_x1*8*2 : ', trim(name) print *, irp_here, ' received: ', rc From cea311077c3081009aaa76e788769a1a700a65f1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 3 Apr 2020 10:24:06 -0500 Subject: [PATCH 177/256] more information printed in case of error --- src/determinants/slater_rules.irp.f | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index a4fc267a..e9b9aca9 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2456,6 +2456,9 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1 if(kp1.ne.kh2) then print*,'problem with hij kpts: ',irp_here + print*,is_allowed + print*,exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2) + print*,ih1,kh1,ih2,kh2,ip1,kp1 stop -4 endif hij = phase * big_array_exchange_integrals_kpts(ih1,kh1,ih2,ip1,kp1) @@ -2469,7 +2472,10 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) kp2 = (exc(1,2,2)-1)/mo_num_per_kpt+1 if(kp2.ne.kh1) then print*,'problem with hij kpts: ',irp_here - stop -4 + print*,is_allowed + print*,exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2) + print*,ip1,kp1,ip2,kp2,ih1,kh1 + stop -5 endif hij = phase * big_array_exchange_integrals_kpts(ip1,kp1,ih1,ip2,kp2) !hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) From b7493137624432e6ea1b1770c8ee7275699af3c0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 3 Apr 2020 14:49:11 -0500 Subject: [PATCH 178/256] started kpts nos --- src/determinants/density_matrix.irp.f | 73 ++++++++++++---------- src/mo_basis/utils.irp.f | 6 +- src/mo_basis/utils_cplx.irp.f | 65 +++++++++++-------- src/scf_utils/roothaan_hall_scf_cplx.irp.f | 2 +- 4 files changed, 83 insertions(+), 63 deletions(-) diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index e645c390..7d9bf873 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -248,44 +248,49 @@ BEGIN_PROVIDER [ double precision, one_e_spin_density_mo, (mo_num,mo_num) ] END_PROVIDER subroutine set_natural_mos - implicit none - BEGIN_DOC - ! Set natural orbitals, obtained by diagonalization of the one-body density matrix - ! in the |MO| basis - END_DOC - character*(64) :: label - double precision, allocatable :: tmp(:,:) + implicit none + BEGIN_DOC + ! Set natural orbitals, obtained by diagonalization of the one-body density matrix + ! in the |MO| basis + END_DOC + character*(64) :: label + double precision, allocatable :: tmp(:,:) - label = "Natural" - integer :: i,j,iorb,jorb - if (is_complex) then - do i = 1, n_virt_orb - iorb = list_virt(i) - do j = 1, n_core_inact_act_orb - jorb = list_core_inact_act(j) - if(cdabs(one_e_dm_mo_complex(iorb,jorb)).ne. 0.d0)then - print*,'AHAHAH' - print*,iorb,jorb,one_e_dm_mo_complex(iorb,jorb) - stop - endif - enddo + label = "Natural" + integer :: i,j,iorb,jorb,k + if (is_complex) then + !todo: implement for kpts + do k=1,kpt_num + do i = 1, n_virt_orb_kpts(k) + iorb = list_virt_kpts(i,k) + do j = 1, n_core_inact_act_orb_kpts(k) + jorb = list_core_inact_act_kpts(j,k) + if(cdabs(one_e_dm_mo_kpts(iorb,jorb,k)).ne. 0.d0)then + print*,'AHAHAH' + print*,iorb,jorb,k,one_e_dm_mo_kpts(iorb,jorb,k) + stop + endif + enddo + enddo enddo - call mo_as_svd_vectors_of_mo_matrix_eig_complex(one_e_dm_mo_complex,size(one_e_dm_mo_complex,1),mo_num,mo_num,mo_occ,label) - else +! call mo_as_svd_vectors_of_mo_matrix_eig_complex(one_e_dm_mo_complex,size(one_e_dm_mo_complex,1),mo_num,mo_num,mo_occ,label) + call mo_as_svd_vectors_of_mo_matrix_eig_kpts(one_e_dm_mo_kpts,size(one_e_dm_mo_kpts,1),mo_num_per_kpt,mo_num_per_kpt,kpt_num,mo_occ_kpts,label) + soft_touch mo_occ_kpts + else do i = 1, n_virt_orb - iorb = list_virt(i) - do j = 1, n_core_inact_act_orb - jorb = list_core_inact_act(j) - if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then - print*,'AHAHAH' - print*,iorb,jorb,one_e_dm_mo(iorb,jorb) - stop - endif - enddo + iorb = list_virt(i) + do j = 1, n_core_inact_act_orb + jorb = list_core_inact_act(j) + if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then + print*,'AHAHAH' + print*,iorb,jorb,one_e_dm_mo(iorb,jorb) + stop + endif + enddo enddo - call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label) - endif - soft_touch mo_occ + call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label) + soft_touch mo_occ + endif end subroutine save_natural_mos diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 5d94e853..b4ccddb6 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -12,7 +12,7 @@ subroutine save_mos call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then - allocate ( buffer_c(ao_num,mo_num)) + !allocate ( buffer_c(ao_num,mo_num)) allocate ( buffer_k(ao_num_per_kpt,mo_num_per_kpt,kpt_num)) buffer_k = (0.d0,0.d0) do k=1,kpt_num @@ -53,6 +53,8 @@ subroutine save_mos_no_occ !call ezfio_set_mo_basis_mo_label(mo_label) !call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then + print*,irp_here, ' not implemented for kpts' + stop -1 allocate ( buffer_c(ao_num,mo_num)) buffer_c = (0.d0,0.d0) do j = 1, mo_num @@ -88,6 +90,8 @@ subroutine save_mos_truncated(n) call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then + print*,irp_here, ' not implemented for kpts' + stop -1 allocate ( buffer_c(ao_num,mo_num)) buffer_c = (0.d0,0.d0) do j = 1, n diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index 13327f57..5ca82213 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -384,63 +384,74 @@ subroutine mo_as_svd_vectors_of_mo_matrix_kpts(matrix,lda,m,n,label) end -subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,eig,label) +subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,nk,eig,label) !TODO: implement - print *, irp_here, ' not implemented for kpts' - stop 1 + !print *, irp_here, ' not implemented for kpts' + !stop 1 implicit none - integer,intent(in) :: lda,m,n + integer,intent(in) :: lda,m,n,nk character*(64), intent(in) :: label - complex*16, intent(in) :: matrix(lda,n) - double precision, intent(out) :: eig(m) + complex*16, intent(in) :: matrix(lda,n,nk) + double precision, intent(out) :: eig(m,nk) - integer :: i,j + integer :: i,j,k double precision :: accu double precision, allocatable :: D(:) complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:), work(:) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A call write_time(6) - if (m /= mo_num) then - print *, irp_here, ': Error : m/= mo_num' + if (m /= mo_num_per_kpt) then + print *, irp_here, ': Error : m/= mo_num_per_kpt' stop 1 endif - allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n)) + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num_per_kpt,m),D(m),Vt(lda,n)) + + do k=1,nk + do j=1,n + do i=1,m + A(i,j) = matrix(i,j,k) + enddo + enddo + mo_coef_new = mo_coef_kpts(1,1,k) + + call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + + + + call zgemm('N','N',ao_num_per_kpt,m,m, & + (1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),& + (0.d0,0.d0),mo_coef_kpts(1,1,k),size(mo_coef_kpts,1)) - do j=1,n do i=1,m - A(i,j) = matrix(i,j) + eig(i,k) = D(i) enddo enddo - mo_coef_new = mo_coef_complex - call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) + deallocate(A,mo_coef_new,U,Vt,D) write (6,'(A)') 'MOs are now **'//trim(label)//'**' write (6,'(A)') '' - write (6,'(A)') 'Eigenvalues' + write (6,'(A)') 'Eigenvalues ' write (6,'(A)') '-----------' write (6,'(A)') '' write (6,'(A)') '======== ================ ================' write (6,'(A)') ' MO Eigenvalue Cumulative ' write (6,'(A)') '======== ================ ================' - - accu = 0.d0 - do i=1,m - accu = accu + D(i) - write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu + + do k=1,nk + accu = 0.d0 + do i=1,m + accu = accu + eig(i,k) + write (6,'(I8,1X,F16.10,1X,F16.10)') i,eig(i,k), accu + enddo + write (6,'(A)') '-------- ---------------- ----------------' enddo write (6,'(A)') '======== ================ ================' write (6,'(A)') '' - call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1)) - - do i=1,m - eig(i) = D(i) - enddo - - deallocate(A,mo_coef_new,U,Vt,D) call write_time(6) mo_label = label diff --git a/src/scf_utils/roothaan_hall_scf_cplx.irp.f b/src/scf_utils/roothaan_hall_scf_cplx.irp.f index e074f884..87c33cb5 100644 --- a/src/scf_utils/roothaan_hall_scf_cplx.irp.f +++ b/src/scf_utils/roothaan_hall_scf_cplx.irp.f @@ -344,7 +344,7 @@ END_DOC logical, external :: qp_stop complex*16, allocatable :: mo_coef_save(:,:,:) - PROVIDE ao_md5 mo_occ level_shift + PROVIDE ao_md5 mo_occ_kpts level_shift allocate(mo_coef_save(ao_num_per_kpt,mo_num_per_kpt,kpt_num), & Fock_matrix_DIIS (ao_num_per_kpt,ao_num_per_kpt,max_dim_DIIS,kpt_num), & From 13995ab02b7f0b7bceedfe420612546a47d42ca2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 6 Apr 2020 00:37:52 +0200 Subject: [PATCH 179/256] Clean ZMQ termination --- ocaml/TaskServer.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 6f2d01f7..92a6f5ca 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -885,7 +885,9 @@ let run ~port = Zmq.Socket.send pair_socket @@ string_of_pub_state Stopped; Thread.join pub_thread; - Zmq.Socket.close rep_socket + Zmq.Socket.close pair_socket; + Zmq.Socket.close rep_socket; + Zmq.Context.terminate zmq_context From f011ca845ee333804751ef641aa770a4514cbe63 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 6 Apr 2020 00:03:59 +0200 Subject: [PATCH 180/256] fixed mo_coef_complex_kpts --- config/ifort_avx.cfg | 2 +- src/cipsi/pt2_stoch_routines.irp.f | 39 +++++++++++++++-------------- src/cipsi/run_selection_slave.irp.f | 11 ++++++++ src/cipsi/selection.irp.f | 8 +++--- src/mo_basis/mos_cplx.irp.f | 13 +++++++--- 5 files changed, 46 insertions(+), 27 deletions(-) diff --git a/config/ifort_avx.cfg b/config/ifort_avx.cfg index d3fcd1f0..56f1651d 100644 --- a/config/ifort_avx.cfg +++ b/config/ifort_avx.cfg @@ -32,7 +32,7 @@ OPENMP : 1 ; Append OpenMP flags # [OPT] FC : -traceback -FCFLAGS : -xAVX -O2 -ip -ftz -g +FCFLAGS : -mavx -O2 -ip -ftz -g # Profiling flags ################# diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 918f26ed..f05b64f0 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -11,7 +11,7 @@ END_PROVIDER implicit none logical, external :: testTeethBuilding integer :: i,j - pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2 + pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2 pt2_n_tasks_max = min(pt2_n_tasks_max,1+N_det_generators/10000) call write_int(6,pt2_n_tasks_max,'pt2_n_tasks_max') @@ -96,7 +96,7 @@ logical function testTeethBuilding(minF, N) do u0 = tilde_cW(n0) r = tilde_cW(n0 + minF) - Wt = (1d0 - u0) * f + Wt = (1d0 - u0) * f if (dabs(Wt) <= 1.d-3) then exit endif @@ -123,6 +123,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer, intent(in) :: N_in +! integer, intent(inout) :: N_in double precision, intent(in) :: relative_error, E(N_states) double precision, intent(out) :: pt2(N_states),error(N_states) double precision, intent(out) :: variance(N_states),norm(N_states) @@ -152,7 +153,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) PROVIDE psi_occ_pattern_hii det_to_occ_pattern endif - if (N_det <= max(4,N_states)) then + if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then pt2=0.d0 variance=0.d0 norm=0.d0 @@ -324,7 +325,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' print '(A)', '========== ================= =========== =============== =============== =================' - PROVIDE global_selection_buffer + PROVIDE global_selection_buffer !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & !$OMP PRIVATE(i) i = omp_get_thread_num() @@ -374,7 +375,7 @@ subroutine pt2_slave_inproc(i) implicit none integer, intent(in) :: i - PROVIDE global_selection_buffer + PROVIDE global_selection_buffer call run_pt2_slave(1,i,pt2_e0_denominator) end @@ -556,8 +557,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc print*,'PB !!!' print*,'If you see this, send an email to Anthony scemama with the following content' print*,irp_here - print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max - stop -1 + print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max + stop -1 endif if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then stop 'PT2: Unable to delete tasks (send)' @@ -568,7 +569,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc print*,'If you see this, send an email to Anthony scemama with the following content' print*,irp_here print*,'i,index(i),size(ei,2) = ',i,index(i),size(ei,2) - stop -1 + stop -1 endif eI(1:N_states, index(i)) += eI_task(1:N_states,i) vI(1:N_states, index(i)) += vI_task(1:N_states,i) @@ -759,25 +760,25 @@ END_PROVIDER double precision, allocatable :: tilde_w(:), tilde_cW(:) double precision :: r, tooth_width integer, external :: pt2_find_sample - + double precision :: rss double precision, external :: memory_of_double, memory_of_int rss = memory_of_double(2*N_det_generators+1) call check_mem(rss,irp_here) - + if (N_det_generators == 1) then - + pt2_w(1) = 1.d0 pt2_cw(1) = 1.d0 pt2_u_0 = 1.d0 pt2_W_T = 0.d0 pt2_n_0(1) = 0 pt2_n_0(2) = 1 - + else - + allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) - + tilde_cW(0) = 0d0 if (is_complex) then @@ -795,9 +796,9 @@ END_PROVIDER do i=N_det_generators,1,-1 norm += tilde_w(i) enddo - + tilde_w(:) = tilde_w(:) / norm - + tilde_cW(0) = -1.d0 do i=1,N_det_generators tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) @@ -818,13 +819,13 @@ END_PROVIDER stop -1 end if end do - + do t=2, pt2_N_teeth r = pt2_u_0 + pt2_W_T * dble(t-1) pt2_n_0(t) = pt2_find_sample(r, tilde_cW) end do pt2_n_0(pt2_N_teeth+1) = N_det_generators - + pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1)) do t=1, pt2_N_teeth tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) @@ -836,7 +837,7 @@ END_PROVIDER pt2_w(i) = tilde_w(i) * pt2_w_t / tooth_width end do end do - + pt2_cW(0) = 0d0 do i=1,N_det_generators pt2_cW(i) = pt2_cW(i-1) + pt2_w(i) diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index e5d86202..9b87b6ba 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -104,6 +104,17 @@ subroutine run_selection_slave(thread,iproc,energy) ctask = ctask + 1 end do + if(ctask > 0) then + call sort_selection_buffer(buf) +! call merge_selection_buffers(buf,buf2) + call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask) +! buf%mini = buf2%mini + pt2(:) = 0d0 + variance(:) = 0d0 + norm(:) = 0d0 + buf%cur = 0 + end if + ctask = 0 integer, external :: disconnect_from_taskserver if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 29cbc2d9..f11775f8 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -52,7 +52,7 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st) rpt2(k) = pt2(k)/(1.d0 + norm(k)) enddo - avg = sum(rpt2(1:N_st)) / dble(N_st) + avg = sum(rpt2(1:N_st)) / dble(N_st) - 1.d-32 ! Avoid future division by zero do k=1,N_st element = exp(dt*(rpt2(k)/avg -1.d0)) element = min(1.5d0 , element) @@ -61,7 +61,7 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st) pt2_match_weight(k) = product(memo_pt2(k,:)) enddo - avg = sum(variance(1:N_st)) / dble(N_st) + avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero do k=1,N_st element = exp(dt*(variance(k)/avg -1.d0)) element = min(1.5d0 , element) @@ -356,7 +356,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d i = psi_bilinear_matrix_rows(l_a) if (nt + exc_degree(i) <= 4) then ! don't keep anything more than 4-fold total exc idx = psi_det_sorted_order(psi_bilinear_matrix_order(l_a)) - if (psi_average_norm_contrib_sorted(idx) > 1.d-12) then + if (psi_average_norm_contrib_sorted(idx) > 0.d0) then indices(k) = idx k=k+1 endif @@ -397,7 +397,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d idx = psi_det_sorted_order( & psi_bilinear_matrix_order( & psi_bilinear_matrix_transp_order(l_a))) - if (psi_average_norm_contrib_sorted(idx) > 1.d-12) then + if (psi_average_norm_contrib_sorted(idx) > 0.d0) then indices(k) = idx k=k+1 endif diff --git a/src/mo_basis/mos_cplx.irp.f b/src/mo_basis/mos_cplx.irp.f index e25e7717..c88441b7 100644 --- a/src/mo_basis/mos_cplx.irp.f +++ b/src/mo_basis/mos_cplx.irp.f @@ -81,12 +81,19 @@ BEGIN_PROVIDER [ complex*16, mo_coef_complex_kpts, (ao_num_per_kpt, mo_num_per_k integer :: i,j,k, mo_shft, ao_shft mo_coef_complex_kpts = (0.d0,0.d0) + ! do k=1,kpt_num + ! mo_shft = (k-1)*mo_num_per_kpt + ! ao_shft = (k-1)*ao_num_per_kpt + ! do i=1,mo_num_per_kpt + ! do j=1,ao_num_per_kpt + ! mo_coef_complex_kpts(j,i,k) = mo_coef_complex(j+ao_shft,i+mo_shft) + ! enddo + ! enddo + ! enddo do k=1,kpt_num - mo_shft = (k-1)*mo_num_per_kpt - ao_shft = (k-1)*ao_num_per_kpt do i=1,mo_num_per_kpt do j=1,ao_num_per_kpt - mo_coef_complex_kpts(j,i,k) = mo_coef_complex(j+ao_shft,i+mo_shft) + mo_coef_complex_kpts(j,i,k) = mo_coef_kpts(j,i,k) enddo enddo enddo From f32dc836a808996c4343e2e1b6994d38f9427390 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 7 Apr 2020 13:26:15 -0500 Subject: [PATCH 181/256] fixed array assignment for complex nos --- src/determinants/density_matrix.irp.f | 9 +++++++++ src/mo_basis/mos_cplx.irp.f | 2 +- src/mo_basis/utils.irp.f | 27 ++++++++++++++++++++++++--- src/mo_basis/utils_cplx.irp.f | 7 ++++++- src/tools/save_natorb.irp.f | 1 + 5 files changed, 41 insertions(+), 5 deletions(-) diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 7d9bf873..ac3157e4 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -259,6 +259,7 @@ subroutine set_natural_mos label = "Natural" integer :: i,j,iorb,jorb,k if (is_complex) then + !todo: implement for kpts do k=1,kpt_num do i = 1, n_virt_orb_kpts(k) @@ -273,6 +274,14 @@ subroutine set_natural_mos enddo enddo enddo + !print*,'1RDM' + !do k=1,kpt_num + ! do j=1,mo_num_per_kpt + ! do i=1,mo_num_per_kpt + ! print'(3(I5),2(E25.15))',i,j,k,one_e_dm_mo_kpts(i,j,k) + ! enddo + ! enddo + !enddo ! call mo_as_svd_vectors_of_mo_matrix_eig_complex(one_e_dm_mo_complex,size(one_e_dm_mo_complex,1),mo_num,mo_num,mo_occ,label) call mo_as_svd_vectors_of_mo_matrix_eig_kpts(one_e_dm_mo_kpts,size(one_e_dm_mo_kpts,1),mo_num_per_kpt,mo_num_per_kpt,kpt_num,mo_occ_kpts,label) soft_touch mo_occ_kpts diff --git a/src/mo_basis/mos_cplx.irp.f b/src/mo_basis/mos_cplx.irp.f index c88441b7..fb90d807 100644 --- a/src/mo_basis/mos_cplx.irp.f +++ b/src/mo_basis/mos_cplx.irp.f @@ -228,7 +228,7 @@ BEGIN_PROVIDER [ complex*16, mo_coef_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_ if (mpi_master) then ! Coefs - call ezfio_has_mo_basis_mo_coef_complex(exists) + call ezfio_has_mo_basis_mo_coef_kpts(exists) endif IRP_IF MPI_DEBUG print *, irp_here, mpi_rank diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index b4ccddb6..9409447c 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -2,7 +2,7 @@ subroutine save_mos implicit none double precision, allocatable :: buffer(:,:) complex*16, allocatable :: buffer_c(:,:),buffer_k(:,:,:) - integer :: i,j,k + integer :: i,j,k,ishft,jshft !TODO: change this for periodic? ! save real/imag parts of mo_coef_complex ! otherwise need to make sure mo_coef and mo_coef_imag @@ -12,19 +12,40 @@ subroutine save_mos call ezfio_set_mo_basis_mo_label(mo_label) call ezfio_set_mo_basis_ao_md5(ao_md5) if (is_complex) then - !allocate ( buffer_c(ao_num,mo_num)) + allocate ( buffer_c(ao_num,mo_num)) allocate ( buffer_k(ao_num_per_kpt,mo_num_per_kpt,kpt_num)) buffer_k = (0.d0,0.d0) do k=1,kpt_num do j = 1, mo_num_per_kpt do i = 1, ao_num_per_kpt buffer_k(i,j,k) = mo_coef_kpts(i,j,k) + !print*,i,j,k,buffer_k(i,j,k) + enddo + enddo + enddo + buffer_c = (0.d0,0.d0) + do k=1,kpt_num + ishft = (k-1)*ao_num_per_kpt + jshft = (k-1)*mo_num_per_kpt + do j=1,mo_num_per_kpt + do i=1,ao_num_per_kpt + buffer_c(i+ishft,j+jshft) = buffer_k(i,j,k) enddo enddo enddo call ezfio_set_mo_basis_mo_coef_kpts(buffer_k) - deallocate (buffer_k) + call ezfio_set_mo_basis_mo_coef_complex(buffer_c) + + deallocate (buffer_k,buffer_c) + mo_occ = 0.d0 + do k=1,kpt_num + ishft=(k-1)*mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_occ(i+ishft)=mo_occ_kpts(i,k) + enddo + enddo call ezfio_set_mo_basis_mo_occ_kpts(mo_occ_kpts) + call ezfio_set_mo_basis_mo_occ(mo_occ) else allocate ( buffer(ao_num,mo_num) ) buffer = 0.d0 diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index 5ca82213..936d09cc 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -415,7 +415,7 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,nk,eig,label) A(i,j) = matrix(i,j,k) enddo enddo - mo_coef_new = mo_coef_kpts(1,1,k) + mo_coef_new(1:ao_num_per_kpt,1:m) = mo_coef_kpts(1:ao_num_per_kpt,1:m,k) call svd_complex(A,lda,U,lda,D,Vt,lda,m,n) @@ -428,6 +428,11 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,nk,eig,label) do i=1,m eig(i,k) = D(i) enddo + !do j=1,mo_num_per_kpt + ! do i=1,mo_num_per_kpt + ! print'(3(I5),2(E25.15))',i,j,k,mo_coef_kpts(i,j,k) + ! enddo + !enddo enddo deallocate(A,mo_coef_new,U,Vt,D) diff --git a/src/tools/save_natorb.irp.f b/src/tools/save_natorb.irp.f index 88b28f06..d4a7f5df 100644 --- a/src/tools/save_natorb.irp.f +++ b/src/tools/save_natorb.irp.f @@ -17,6 +17,7 @@ program save_natorb call save_natural_mos call save_ref_determinant call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('None') + call ezfio_set_mo_two_e_ints_io_df_mo_integrals('None') call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('None') call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('None') call ezfio_set_mo_one_e_ints_io_mo_integrals_e_n('None') From b41e556b9dc00240f4ebb0fed14cbabe27e09820 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 7 Apr 2020 14:28:32 -0500 Subject: [PATCH 182/256] added provider for total ref bitmask energy (with nuc. repulsion) --- src/cipsi/cipsi.irp.f | 2 +- src/cipsi/stochastic_cipsi.irp.f | 2 +- src/determinants/ref_bitmask.irp.f | 3 ++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f index e4089cfc..731a73ef 100644 --- a/src/cipsi/cipsi.irp.f +++ b/src/cipsi/cipsi.irp.f @@ -44,7 +44,7 @@ subroutine run_cipsi if (has) then call ezfio_get_hartree_fock_energy(hf_energy_ref) else - hf_energy_ref = ref_bitmask_energy + hf_energy_ref = ref_bitmask_energy_with_nucl_rep endif if (N_det > N_det_max) then diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 7c16cd41..01b65d2e 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -47,7 +47,7 @@ subroutine run_stochastic_cipsi if (has) then call ezfio_get_hartree_fock_energy(hf_energy_ref) else - hf_energy_ref = ref_bitmask_energy + hf_energy_ref = ref_bitmask_energy_with_nucl_rep endif if (N_det > N_det_max) then diff --git a/src/determinants/ref_bitmask.irp.f b/src/determinants/ref_bitmask.irp.f index 675ef5b6..d53be414 100644 --- a/src/determinants/ref_bitmask.irp.f +++ b/src/determinants/ref_bitmask.irp.f @@ -6,6 +6,7 @@ &BEGIN_PROVIDER [ double precision, ref_bitmask_energy_ab ] &BEGIN_PROVIDER [ double precision, ref_bitmask_energy_bb ] &BEGIN_PROVIDER [ double precision, ref_bitmask_energy_aa ] +&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_with_nucl_rep ] use bitmasks implicit none @@ -80,7 +81,7 @@ enddo ref_bitmask_energy_bb = ref_bitmask_energy_bb * 0.5d0 - + ref_bitmask_energy_with_nucl_rep = ref_bitmask_energy + nuclear_repulsion END_PROVIDER From 16d3f8b6d0b0ab1ecd505693e1a13351a453d0ed Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 8 Apr 2020 11:12:27 -0500 Subject: [PATCH 183/256] debugging --- src/utils_complex/debug_mo_map.irp.f | 136 +++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 src/utils_complex/debug_mo_map.irp.f diff --git a/src/utils_complex/debug_mo_map.irp.f b/src/utils_complex/debug_mo_map.irp.f new file mode 100644 index 00000000..be593214 --- /dev/null +++ b/src/utils_complex/debug_mo_map.irp.f @@ -0,0 +1,136 @@ +program debug_mo_map + call run +end + +subroutine run + use map_module + implicit none + BEGIN_DOC + ! Alpha and Beta Fock matrices in AO basis set + END_DOC + !TODO: finish implementing this: see complex qp1 (different mapping) + + integer :: i,j,k,l,k1,r,s + integer :: i0,j0,k0,l0 + integer*8 :: p,q + complex*16 :: integral, c0 + + PROVIDE mo_two_e_integrals_in_map + + integer(omp_lock_kind) :: lck(ao_num) + integer(map_size_kind) :: i8 + integer :: ii(4), jj(4), kk(4), ll(4), k2 + integer(cache_map_size_kind) :: n_elements_max, n_elements + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + complex*16, parameter :: i_sign(4) = (/(0.d0,1.d0),(0.d0,1.d0),(0.d0,-1.d0),(0.d0,-1.d0)/) + integer(key_kind) :: key1 + +! call get_cache_map_n_elements_max(mo_integrals_map,n_elements_max) +! allocate(keys(n_elements_max), values(n_elements_max)) + + print*,' map_size1 = ',mo_integrals_map%map_size + print*,'n_elements1 = ',mo_integrals_map%n_elements + + do i8=0_8,mo_integrals_map%map_size + print*,' cache1 idx = ',i8 + print*,' map_size = ',mo_integrals_map%map(i8)%map_size + print*,' n_elements = ',mo_integrals_map%map(i8)%n_elements + enddo + + + print*,' map_size2 = ',mo_integrals_map_2%map_size + print*,'n_elements2 = ',mo_integrals_map_2%n_elements + + do i8=0_8,mo_integrals_map_2%map_size + print*,' cache2 idx = ',i8 + print*,' map_size = ',mo_integrals_map_2%map(i8)%map_size + print*,' n_elements = ',mo_integrals_map_2%map(i8)%n_elements + enddo +! do i8=0_8,mo_integrals_map%map_size +! n_elements = n_elements_max +! call get_cache_map(ao_integrals_map,i8,keys,values,n_elements) +! do k1=1,n_elements +! ! get original key +! ! reverse of 2*key (imag part) and 2*key-1 (real part) +! key1 = shiftr(keys(k1)+1,1) +! +! call two_e_integrals_index_reverse_complex_1(ii,jj,kk,ll,key1) +! ! i<=k, j<=l, ik<=jl +! ! ijkl, jilk, klij*, lkji* +! +! if (shiftl(key1,1)==keys(k1)) then !imaginary part (even) +! do k2=1,4 +! if (ii(k2)==0) then +! cycle +! endif +! i = ii(k2) +! j = jj(k2) +! k = kk(k2) +! l = ll(k2) +! print'((A),4(I4),1(E15.7),2(I4),2(E9.1))','imag1 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) +! +! !G_a(i,k) += D_{ab}(l,j)*() +! !G_b(i,k) += D_{ab}(l,j)*() +! !G_a(i,l) -= D_a (k,j)*() +! !G_b(i,l) -= D_b (k,j)*() +! +! enddo +! else ! real part +! do k2=1,4 +! if (ii(k2)==0) then +! cycle +! endif +! i = ii(k2) +! j = jj(k2) +! k = kk(k2) +! l = ll(k2) +! print'((A),4(I4),1(E15.7),2(I4))','real1 ',i,j,k,l,values(k1),k1,k2 +! enddo +! endif +! enddo +! enddo +! deallocate(keys,values) +! +! +! call get_cache_map_n_elements_max(ao_integrals_map_2,n_elements_max) +! allocate(keys(n_elements_max), values(n_elements_max)) +! +! do i8=0_8,ao_integrals_map_2%map_size +! n_elements = n_elements_max +! call get_cache_map(ao_integrals_map_2,i8,keys,values,n_elements) +! do k1=1,n_elements +! ! get original key +! ! reverse of 2*key (imag part) and 2*key-1 (real part) +! key1 = shiftr(keys(k1)+1,1) +! +! call two_e_integrals_index_reverse_complex_2(ii,jj,kk,ll,key1) +! ! i>=k, j<=l, ik<=jl +! ! ijkl, jilk, klij*, lkji* +! if (shiftl(key1,1)==keys(k1)) then !imaginary part +! do k2=1,4 +! if (ii(k2)==0) then +! cycle +! endif +! i = ii(k2) +! j = jj(k2) +! k = kk(k2) +! l = ll(k2) +! print'((A),4(I4),1(E15.7),2(I4),2(E9.1))','imag2 ',i,j,k,l,values(k1),k1,k2,i_sign(k2) +! enddo +! else ! real part +! do k2=1,4 +! if (ii(k2)==0) then +! cycle +! endif +! i = ii(k2) +! j = jj(k2) +! k = kk(k2) +! l = ll(k2) +! print'((A),4(I4),1(E15.7),2(I4))','real2 ',i,j,k,l,values(k1),k1,k2 +! enddo +! endif +! enddo +! enddo +! deallocate(keys,values) +end From 0d50e067bdf085310b0eb87160a6a900584d82bb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Apr 2020 13:32:37 -0500 Subject: [PATCH 184/256] fixed incorrect function call --- src/cipsi/selection.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index f11775f8..c349dfbf 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2793,7 +2793,7 @@ subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp h2 = p(1,2) do p1=1, mo_num if(bannedOrb(p1, 1)) cycle - call get_mo_two_e_integrals_complex(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map) + call get_mo_two_e_integrals_complex(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) do p2=1, mo_num if(bannedOrb(p2,2)) cycle if(banned(p1, p2, bant)) cycle ! rentable? From a00266d1b908e7b4eb265c8245821add08fd0d62 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Apr 2020 14:16:57 -0500 Subject: [PATCH 185/256] get_ints_kpts --- src/mo_two_e_ints/map_integrals_cplx.irp.f | 50 ++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/src/mo_two_e_ints/map_integrals_cplx.irp.f b/src/mo_two_e_ints/map_integrals_cplx.irp.f index 1db8da3c..5be8fd3c 100644 --- a/src/mo_two_e_ints/map_integrals_cplx.irp.f +++ b/src/mo_two_e_ints/map_integrals_cplx.irp.f @@ -217,6 +217,56 @@ subroutine get_mo_two_e_integrals_complex(j,k,l,sze,out_val,map,map2) enddo end +subroutine get_mo_two_e_integrals_kpts(j,ij,kj,k,ik,kk,l,il,kl,sze,out_val,map,map2) + use map_module + implicit none + BEGIN_DOC + ! Returns multiple integrals in the MO basis, all + ! i for j,k,l fixed. + END_DOC + integer, intent(in) :: j,k,l, ij,ik,il, kj,kk,kl, sze + complex*16, intent(out) :: out_val(sze) + type(map_type), intent(inout) :: map,map2 + integer :: i + complex*16, external :: get_two_e_integral_complex_simple + complex*16, external :: mo_two_e_integral_kpts + + integer :: ki,imin0 + integer :: ii, ii0 + integer*8 :: ii_8, ii0_8 + complex(integral_kind) :: tmp + integer(key_kind) :: i1, idx + integer(key_kind) :: p,q,r,s,i2 + PROVIDE mo_two_e_integrals_in_map mo_integrals_cache_complex + +!DEBUG +! do i=1,sze +! out_val(i) = get_two_e_integral_complex(i,j,k,l,map,map2) +! enddo +! return +!DEBUG + + ki = kconserv(kk,kl,kj) + imin0 = (ki-1)*mo_num_per_kpt + ii0 = l-mo_integrals_cache_min + ii0 = ior(ii0, k-mo_integrals_cache_min) + ii0 = ior(ii0, j-mo_integrals_cache_min) + + ii0_8 = int(l,8)-mo_integrals_cache_min_8 + ii0_8 = ior( shiftl(ii0_8,7), int(k,8)-mo_integrals_cache_min_8) + ii0_8 = ior( shiftl(ii0_8,7), int(j,8)-mo_integrals_cache_min_8) + + do i=1,sze + ii = ior(ii0, i+imin0-mo_integrals_cache_min) + if (iand(ii, -128) == 0) then + ii_8 = ior( shiftl(ii0_8,7), int(i+imin0,8)-mo_integrals_cache_min_8) + out_val(i) = mo_integrals_cache_complex(ii_8) + else + out_val(i) = get_two_e_integral_complex_simple(i+imin0,j,k,l,map,map2) + endif + enddo +end + !subroutine get_mo_two_e_integrals_ij_complex(k,l,sze,out_array,map) ! use map_module ! implicit none From 29752ccb6053533e46a383ca8103c0e474e3fdbe Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 13 Apr 2020 14:23:12 -0500 Subject: [PATCH 186/256] ban excitations that don't conserve momentum --- src/cipsi/selection.irp.f | 52 ++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index c349dfbf..05a09645 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -269,6 +269,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d type(selection_buffer), intent(inout) :: buf integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,sze + integer :: kh1,kh2,kpt12,kk1,kk2,ik01,ik02,ik1,ik2 integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) logical :: fullMatch, ok @@ -511,12 +512,13 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d maskInd = maskInd_save h1 = hole_list(i1,s1) -!todo kpt1 = (h1-1)/mo_num_per_kpt + 1 +!todo: kpts + kh1 = (h1-1)/mo_num_per_kpt + 1 ! pmask is i_generator det with bit at h1 set to zero call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) negMask = not(pmask) - +! ! see set definitions above interesting(0) = 0 fullinteresting(0) = 0 @@ -674,31 +676,31 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d if (is_complex) then !============================================================= !!todo use this once kpts are implemented -! kpt2 = (h2-1)/mo_num_per_kpt + 1 -! kpt12 = kconserv(kpt1,kpt2,1) -! ! mask is gen_i with (h1,s1),(h2,s2) removed -! call apply_hole(pmask, s2,h2, mask, ok, N_int) -! banned = .true. -! ! only allow excitations that conserve momentum -! do kk1=1,kpt_num -! ! equivalent to kk2 = kconserv(kpt1,kpt2,kk1) -! kk2 = kconserv(kpt12,1,kk1) -! ik01 = (kk1-1) * mo_num_per_kpt + 1 !first mo in kk1 -! ik02 = (kk2-1) * mo_num_per_kpt + 1 !first mo in kk2 -! do ik1 = ik01, ik01 + mo_num_per_kpt - 1 !loop over mos in kk1 -! do ik2 = ik02, ik02 + mo_num_per_kpt - 1 !loop over mos in kk2 -! ! depending on sp, might not need both of these? -! ! sp=1 (a,a) or sp=2 (b,b): only use banned(:,:,1) -! ! sp=3 (a,b): banned(alpha,beta,1) is transpose of banned(beta,alpha,2) -! banned(ik1,ik2,1) = .false. -! banned(ik1,ik2,2) = .false. -! enddo -! enddo -! enddo -!============================================================= + kh2 = (h2-1)/mo_num_per_kpt + 1 + kpt12 = kconserv(kh1,kh2,1) ! mask is gen_i with (h1,s1),(h2,s2) removed call apply_hole(pmask, s2,h2, mask, ok, N_int) - banned = .false. + banned = .true. + ! only allow excitations that conserve momentum + do kk1=1,kpt_num + ! equivalent to kk2 = kconserv(kh1,kh2,kk1) + kk2 = kconserv(kpt12,1,kk1) + ik01 = (kk1-1) * mo_num_per_kpt + 1 !first mo in kk1 + ik02 = (kk2-1) * mo_num_per_kpt + 1 !first mo in kk2 + do ik1 = ik01, ik01 + mo_num_per_kpt - 1 !loop over mos in kk1 + do ik2 = ik02, ik02 + mo_num_per_kpt - 1 !loop over mos in kk2 + ! depending on sp, might not need both of these? + ! sp=1 (a,a) or sp=2 (b,b): only use banned(:,:,1) + ! sp=3 (a,b): banned(alpha,beta,1) is transpose of banned(beta,alpha,2) + banned(ik1,ik2,1) = .false. + banned(ik1,ik2,2) = .false. + enddo + enddo + enddo +!============================================================= +! ! mask is gen_i with (h1,s1),(h2,s2) removed +! call apply_hole(pmask, s2,h2, mask, ok, N_int) +! banned = .false. !============================================================= else call apply_hole(pmask, s2,h2, mask, ok, N_int) From 12e9c88d71fa949280e3165b5583eb2951b47f58 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 16 Apr 2020 09:06:29 -0500 Subject: [PATCH 187/256] fixed array size --- src/davidson/diagonalize_ci.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 740640c3..a72b3040 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -383,7 +383,7 @@ END_PROVIDER deallocate(s2_eigvalues) else call lapack_diag_complex(eigenvalues,eigenvectors, & - H_matrix_all_dets_complex,size(H_matrix_all_dets,1),N_det) + H_matrix_all_dets_complex,size(H_matrix_all_dets_complex,1),N_det) ci_electronic_energy_complex(:) = 0.d0 call u_0_S2_u_0_complex(ci_s2_complex,eigenvectors,N_det,psi_det,N_int,& min(N_det,N_states_diag),size(eigenvectors,1)) From 8479bed7a554875eabb2611085be5f04c3d6c5c7 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Apr 2020 09:48:19 -0500 Subject: [PATCH 188/256] working on molecule converter --- src/utils_complex/MolPyscfToQPkpts.py | 175 +++++++++++++++++++++++++- 1 file changed, 174 insertions(+), 1 deletion(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index b7fddf5b..75bcd7fc 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -650,7 +650,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, qph5['mo_basis'].attrs['mo_num']=Nk*nmo qph5['ao_basis'].attrs['ao_num']=Nk*nao - qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis + #qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis + qph5['ao_basis'].attrs['ao_basis']="dummy basis" qph5.create_dataset('ao_basis/ao_nucl',data=Nk*ao_nucl) @@ -848,3 +849,175 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if (print_mo_ints_bi): print_mo_bi(mf,kconserv,'W.mo.qp',cas_idx,bielec_int_threshold) return + +def xyzcount(s): + return list(map(s.count,['x','y','z'])) + +def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, + qph5path = 'qpdat.h5', + norm='sp', + print_debug=False): + ''' + cas_idx = List of active MOs. If not specified all MOs are actives + int_threshold = The integral will be not printed in they are bellow that + norm should be one of 'sp', 'all', or None + ''' + + import h5py + + mol = mf.mol + nao_c = mol.nao_cart() + + mo_coef_threshold = int_threshold + ovlp_threshold = int_threshold + kin_threshold = int_threshold + ne_threshold = int_threshold + bielec_int_threshold = int_threshold + thresh_mono = int_threshold + + +# qph5path = 'qpdat.h5' + # create hdf5 file, delete old data if exists + with h5py.File(qph5path,'w') as qph5: + qph5.create_group('nuclei') + qph5.create_group('electrons') + qph5.create_group('ao_basis') + qph5.create_group('mo_basis') + + if mf.mol.cart: + mo_coeff = mf.mo_coeff + else: + c2s = mol.cart2sph_coeff(normalized=norm) + #c2s = mol.cart2sph_coeff(normalized='sp') + #c2s = mol.cart2sph_coeff(normalized='all') + #c2s = mol.cart2sph_coeff(normalized=None) + mo_coeff = np.dot(c2s,mf.mo_coeff) + # Mo_coeff actif + mo_c = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) + e_c = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) + + nao, nmo = mo_c.shape + + print("n active MOs", nmo) + print("n AOs", nao) + assert nao==nao_c, "wrong number of AOs" + + ########################################## + # # + # Nuclei # + # # + ########################################## + + natom = mol.natm + print('n_atom', natom) + + atom_xyz = mol.atom_coords(unit='Bohr') + #if not(mol.unit.startswith(('B','b','au','AU'))): + # from pyscf.data.nist import BOHR + # atom_xyz /= BOHR # always convert to au + + with h5py.File(qph5path,'a') as qph5: + qph5['nuclei'].attrs['nucl_num']=natom + qph5.create_dataset('nuclei/nucl_coord',data=atom_xyz) + qph5.create_dataset('nuclei/nucl_charge',data=mol.atom_charges()) + + strtype=h5py.special_dtype(vlen=str) + atom_dset=qph5.create_dataset('nuclei/nucl_label',(natom,),dtype=strtype) + for i in range(natom): + atom_dset[i] = mol.atom_pure_symbol(i) + + ########################################## + # # + # Basis # + # # + ########################################## + + # nucleus on which each AO is centered + ao_nucl=[i[0] for i in mf.mol.ao_labels(fmt=False,base=1)] + + + nprim_max = 0 + for iatom, (sh0,sh1,ao0,ao1) in enumerate(mol.aoslice_by_atom()): + for ib in range(sh0,sh1): # sets of contracted exponents + nprim = mol.bas_nprim(ib) + if (nprim > nprim_max): + nprim_max = nprim + + qp_prim_num = np.zeros((nao),dtype=int) + qp_coef = np.zeros((nao,nprim_max)) + qp_expo = np.zeros((nao,nprim_max)) + qp_nucl = np.zeros((nao),dtype=int) + qp_pwr = np.zeros((nao,3),dtype=int) + + clabels = mol.cart_labels(fmt=False) + + tmp_idx=0 + for iatom, (sh0,sh1,ao0,ao1) in enumerate(mol.aoslice_by_atom()): + # shell start,end; AO start,end (sph or cart) for each atom + for ib in range(sh0,sh1): # sets of contracted exponents + l = mol.bas_angular(ib) # angular momentum + nprim = mol.bas_nprim(ib) # numer of primitives + es = mol.bas_exp(ib) # exponents + cs = mol.bas_ctr_coeff(ib) # coeffs + nctr = mol.bas_nctr(ib) # number of contractions + print(iatom,ib,l,nprim,nctr,tmp_idx) + for ic in range(nctr): # sets of contraction coeffs + for nfunc in range(((l+1)*(l+2))//2): # always use cart for qp ao basis? + qp_expo[tmp_idx,:nprim] = es[:] + qp_coef[tmp_idx,:nprim] = cs[:,ic] + qp_nucl[tmp_idx] = iatom + 1 + qp_pwr[tmp_idx,:] = xyzcount(clabels[tmp_idx][3]) + qp_prim_num[tmp_idx] = nprim + tmp_idx += 1 + + with h5py.File(qph5path,'a') as qph5: + qph5['mo_basis'].attrs['mo_num']=nmo + qph5['ao_basis'].attrs['ao_num']=nao + + #qph5['ao_basis'].attrs['ao_basis']=mf.cell.basis + qph5['ao_basis'].attrs['ao_basis']="dummy basis" + + qph5.create_dataset('ao_basis/ao_nucl',data=qp_nucl) + qph5.create_dataset('ao_basis/ao_prim_num',data=qp_prim_num) + qph5.create_dataset('ao_basis/ao_expo',data=qp_expo.T) + qph5.create_dataset('ao_basis/ao_coef',data=qp_coef.T) + qph5.create_dataset('ao_basis/ao_power',data=qp_pwr.T) + + ########################################## + # # + # Electrons # + # # + ########################################## + + nelec = mol.nelectron + neleca,nelecb = mol.nelec + + print('num_elec', nelec) + + with h5py.File(qph5path,'a') as qph5: + qph5['electrons'].attrs['elec_alpha_num']=neleca + qph5['electrons'].attrs['elec_beta_num']=nelecb + + ########################################## + # # + # Nuclear Repulsion # + # # + ########################################## + + e_nuc = mol.energy_nuc() + + print('nucl_repul', e_nuc) + + with h5py.File(qph5path,'a') as qph5: + qph5['nuclei'].attrs['nuclear_repulsion']=e_nuc + + ########################################## + # # + # MO Coef # + # # + ########################################## + + with h5py.File(qph5path,'a') as qph5: + qph5.create_dataset('mo_basis/mo_coef',data=mo_c.T) + + return From 882dd0f2b16c8b7cf524ce04e5b6d2b2290ab8cc Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Apr 2020 09:52:28 -0500 Subject: [PATCH 189/256] selection d1 simplification --- src/cipsi/selection.irp.f | 269 +++++++++++++++++++++++++++++++------- 1 file changed, 220 insertions(+), 49 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 05a09645..e09f00c1 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2520,16 +2520,23 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + integer :: kp1,ip1, kp2,ip2, khfix,ihfix, kputi,iputi, kputj,iputj, putj0 + integer :: kpfix, ipfix, puti0 + integer :: kputi1,kputi2,puti01,puti02 + integer :: ii0 + integer, parameter :: turn2(2) = (/2,1/) integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer :: bant - complex*16, allocatable :: hij_cache(:,:) + complex*16, allocatable :: hij_cache(:,:),hij_cache2(:,:) complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) + complex*16 :: tmp_row_kpts(N_states, mo_num), tmp_row2_kpts(N_states, mo_num) + complex*16 :: tmp_row_kpts2(N_states, mo_num_per_kpt), tmp_row2_kpts2(N_states,mo_num_per_kpt) PROVIDE mo_integrals_map N_int allocate (lbanned(mo_num, 2)) - allocate (hij_cache(mo_num,2)) + allocate (hij_cache(mo_num,2),hij_cache2(mo_num_per_kpt,2)) lbanned = bannedOrb do i=1, p(0,1) @@ -2552,42 +2559,96 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp hfix = h(1,ma) p1 = p(1,ma) p2 = p(2,ma) + kputi = (puti-1)/mo_num_per_kpt + 1 + khfix = (hfix-1)/mo_num_per_kpt + 1 + kp1 = (p1-1)/mo_num_per_kpt + 1 + kp2 = (p2-1)/mo_num_per_kpt + 1 + iputi = mod(puti-1,mo_num_per_kpt) + 1 + ihfix = mod(hfix-1,mo_num_per_kpt) + 1 + ip1 = mod(p1-1, mo_num_per_kpt) + 1 + ip2 = mod(p2-1, mo_num_per_kpt) + 1 + if(.not. bannedOrb(puti, mi)) then - call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) - call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) tmp_row = (0.d0,0.d0) - do putj=1, hfix-1 + tmp_row_kpts2 = (0.d0,0.d0) + kputj = kconserv(kp1,kp2,khfix) + putj0 = (kputj-1)*mo_num_per_kpt + !do putj=1, hfix-1 + ! if(lbanned(putj, ma)) cycle + ! if(banned(putj, puti,bant)) cycle + ! hij = hij_cache(putj,1) - hij_cache(putj,2) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + ! enddo + ! endif + !end do + !do putj=hfix+1, mo_num + ! if(lbanned(putj, ma)) cycle + ! if(banned(putj, puti,bant)) cycle + ! hij = hij_cache(putj,2) - hij_cache(putj,1) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + ! enddo + ! endif + !end do + !=========================== + ! begin kpts testing + do putj = putj0+1, hfix-1 + iputj = putj-putj0 if(lbanned(putj, ma)) cycle if(banned(putj, puti,bant)) cycle - hij = hij_cache(putj,1) - hij_cache(putj,2) + hij = hij_cache2(iputj,1) - hij_cache2(iputj,2) if (hij /= (0.d0,0.d0)) then hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) !DIR$ LOOP COUNT AVG(4) do k=1,N_states - tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + !tmp_row_kpts(k,putj) = tmp_row_kpts(k,putj) + hij * coefs(k) + tmp_row_kpts2(k,iputj) = tmp_row_kpts2(k,iputj) + hij * coefs(k) enddo endif end do - do putj=hfix+1, mo_num + do putj = hfix+1,putj0+mo_num_per_kpt + iputj = putj - putj0 if(lbanned(putj, ma)) cycle if(banned(putj, puti,bant)) cycle - hij = hij_cache(putj,2) - hij_cache(putj,1) + hij = hij_cache2(iputj,2) - hij_cache2(iputj,1) if (hij /= (0.d0,0.d0)) then hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) !DIR$ LOOP COUNT AVG(4) do k=1,N_states - tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + !tmp_row_kpts(k,putj) = tmp_row_kpts(k,putj) + hij * coefs(k) + tmp_row_kpts2(k,iputj) = tmp_row_kpts2(k,iputj) + hij * coefs(k) enddo endif end do - + ! end kpts testing + !=========================================================== + !print*,'tmp_row_k,tmp_row' + !do ii0=1,mo_num + ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG, ',ii0,hfix,p1,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + !enddo + !=========================================================== if(ma == 1) then - mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + !mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & + tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) else - do l=1,mo_num + do l=1,mo_num_per_kpt !DIR$ LOOP COUNT AVG(4) do k=1,N_states - mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + mat(k,puti,l+putj0) = mat(k,puti,l+putj0) + tmp_row_kpts2(k,l) enddo enddo end if @@ -2595,52 +2656,162 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp !MOVE MI pfix = p(1,mi) - tmp_row = (0.d0,0.d0) - tmp_row2 = (0.d0,0.d0) - call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) - call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + kpfix = (pfix-1)/mo_num_per_kpt + 1 + ipfix = mod(pfix-1,mo_num_per_kpt) + 1 + !tmp_row = (0.d0,0.d0) + !tmp_row2 = (0.d0,0.d0) + !tmp_row_kpts = (0.d0,0.d0) + !tmp_row2_kpts = (0.d0,0.d0) + tmp_row_kpts2 = (0.d0,0.d0) + tmp_row2_kpts2 = (0.d0,0.d0) + !call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) putj = p1 - do puti=1,mo_num !HOT - if(lbanned(puti,mi)) cycle - !p1 fixed + !============ + !begin ref + !do puti=1,mo_num !HOT + ! if(lbanned(puti,mi)) cycle + ! !p1 fixed + ! putj = p1 + ! if(.not. banned(putj,puti,bant)) then + ! hij = hij_cache(puti,2) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if +! ! enddo +! ! + ! putj = p2 +! ! do puti=1,mo_num !HOT + ! if(.not. banned(putj,puti,bant)) then + ! hij = hij_cache(puti,1) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + ! do k=1,N_states + ! tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if + !end do + !end ref + !=================== + !begin kpts + if (kp1.eq.kp2) then + !if (.False.) then + kputi1 = kconserv(kpfix,kp1,khfix) + kputi2 = kputi1 + puti01 = (kputi1-1)*mo_num_per_kpt + puti02 = puti01 + do iputi=1,mo_num_per_kpt !HOT + puti = puti01 + iputi + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache2(iputi,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row_kpts2(k,iputi) = tmp_row_kpts2(k,iputi) + hij * coefs(k) + !tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache2(iputi,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2_kpts2(k,iputi) = tmp_row2_kpts2(k,iputi) + hij * coefs(k) + !tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + else !kp1.ne.kp2 + kputi2 = kconserv(kpfix,kp2,khfix) + puti02 = (kputi2-1)*mo_num_per_kpt putj = p1 - if(.not. banned(putj,puti,bant)) then - hij = hij_cache(puti,2) - if (hij /= (0.d0,0.d0)) then - hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) - !DIR$ LOOP COUNT AVG(4) - do k=1,N_states - tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) - enddo - endif - end if -! enddo -! + do iputi=1,mo_num_per_kpt !HOT + puti = puti02 + iputi + if(lbanned(puti,mi)) cycle + !p1 fixed + if(.not. banned(putj,puti,bant)) then + hij = hij_cache2(iputi,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row_kpts2(k,iputi) = tmp_row_kpts2(k,iputi) + hij * coefs(k) + !tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) + enddo + endif + end if + enddo +! putj = p2 -! do puti=1,mo_num !HOT - if(.not. banned(putj,puti,bant)) then - hij = hij_cache(puti,1) - if (hij /= (0.d0,0.d0)) then - hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) - do k=1,N_states - tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) - enddo - endif - end if - end do + kputi1 = kconserv(kpfix,kp1,khfix) + puti01 = (kputi1-1)*mo_num_per_kpt + do iputi=1,mo_num_per_kpt !HOT + puti = puti01 + iputi + if(lbanned(puti,mi)) cycle + if(.not. banned(putj,puti,bant)) then + hij = hij_cache2(iputi,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2_kpts2(k,iputi) = tmp_row2_kpts2(k,iputi) + hij * coefs(k) + !tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + endif + !end kpts + !=================== + !test printing + !print'((A),5(I5))','kpt info1: ',kconserv(kpfix,kp2,khfix),khfix,kpfix,kp2,kputi2 + !print'((A),5(I5))','kpt info2: ',kconserv(kpfix,kp1,khfix),khfix,kpfix,kp1,kputi1 + !do ii0=1,mo_num + ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + !! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + ! if (cdabs(tmp_row2_kpts(1,ii0)-tmp_row2(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2a, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + !! else if ((cdabs(tmp_row2_kpts(1,ii0))+cdabs(tmp_row2(1,ii0))).gt.1.d-12) then + !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2b, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + ! endif + !enddo + !=================== if(mi == 1) then - mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) - mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) + !mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) + !mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) + mat(:,puti02+1:puti02+mo_num_per_kpt,p1) = mat(:,puti02+1:puti02+mo_num_per_kpt,p1) + tmp_row_kpts2(:,:) + mat(:,puti01+1:puti01+mo_num_per_kpt,p2) = mat(:,puti01+1:puti01+mo_num_per_kpt,p2) + tmp_row2_kpts2(:,:) else - do l=1,mo_num + do l=1,mo_num_per_kpt !DIR$ LOOP COUNT AVG(4) do k=1,N_states - mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) - mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + mat(k,p1,l+puti02) = mat(k,p1,l+puti02) + tmp_row_kpts2(k,l) + mat(k,p2,l+puti01) = mat(k,p2,l+puti01) + tmp_row2_kpts2(k,l) enddo enddo end if + !todo: kpts okay up to this point in get_d1_complex else ! sp /= 3 From 735e4d591b91ab7d5863064290028087f93520f1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 24 Apr 2020 12:18:40 -0500 Subject: [PATCH 190/256] testing get_d1 --- src/cipsi/selection.irp.f | 190 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 190 insertions(+) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index e09f00c1..96fd0249 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2533,6 +2533,7 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) complex*16 :: tmp_row_kpts(N_states, mo_num), tmp_row2_kpts(N_states, mo_num) complex*16 :: tmp_row_kpts2(N_states, mo_num_per_kpt), tmp_row2_kpts2(N_states,mo_num_per_kpt) + complex*16 :: tmp_mat1(N_states,mo_num,mo_num), tmp_mat2(N_states,mo_num,mo_num) PROVIDE mo_integrals_map N_int allocate (lbanned(mo_num, 2)) @@ -2821,9 +2822,23 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp puti = p(i, ma) p1 = p(turn3(1,i), ma) p2 = p(turn3(2,i), ma) + kputi = (puti-1)/mo_num_per_kpt + 1 + khfix = (hfix-1)/mo_num_per_kpt + 1 + kp1 = (p1-1)/mo_num_per_kpt + 1 + kp2 = (p2-1)/mo_num_per_kpt + 1 + iputi = mod(puti-1,mo_num_per_kpt) + 1 + ihfix = mod(hfix-1,mo_num_per_kpt) + 1 + ip1 = mod(p1-1, mo_num_per_kpt) + 1 + ip2 = mod(p2-1, mo_num_per_kpt) + 1 call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) tmp_row = (0.d0,0.d0) + !tmp_row_kpts = (0.d0,0.d0) + tmp_row_kpts2 = (0.d0,0.d0) + !=================== + !begin ref do putj=1,hfix-1 if(banned(putj,puti,1)) cycle if(lbanned(putj,ma)) cycle @@ -2842,7 +2857,89 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) endif end do + !end ref + !================= + !begin kpts + kputj = kconserv(kp1,kp2,khfix) + putj0 = (kputj-1)*mo_num_per_kpt + do putj = putj0+1,hfix-1 + iputj = putj - putj0 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache2(iputj,1) - hij_cache2(iputj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:) + tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:) + endif + end do + do putj=hfix+1,putj0+mo_num_per_kpt + iputj = putj - putj0 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache2(iputj,2) - hij_cache2(iputj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:) + tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:) + endif + end do + !end kpts + !do ii0=1,mo_num + ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + !! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + !enddo + !================= + tmp_mat1 = (0.d0,0.d0) + tmp_mat2 = (0.d0,0.d0) + tmp_mat1(:, :puti-1, puti) = tmp_mat1(:, :puti-1, puti) + tmp_row(:,:puti-1) + do l=puti,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat1(k, puti, l) = tmp_mat1(k, puti,l) + tmp_row(k,l) + enddo + enddo + !================= + if (kputj.lt.kputi) then + tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = & + tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & + tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) + else if (kputj.gt.kputi) then + do l=1,mo_num_per_kpt + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l) + enddo + enddo + else !kputj == kputi + tmp_mat2(1:N_states,putj0+1:puti-1,puti) = & + tmp_mat2(1:N_states,putj0+1:puti-1,puti) + & + tmp_row_kpts2(1:N_states,1:iputi-1) + do l=iputi,mo_num_per_kpt + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l) + enddo + enddo + endif + !================= + do k=1,N_states + do l=1,mo_num + do ii0=1,mo_num + if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then + print'((A),6(I5),2(2(E25.15),2X))','WarNInG 3a, ',k,l,ii0,hfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) + ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + endif + enddo + enddo + enddo + + !================= mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1) do l=puti,mo_num !DIR$ LOOP COUNT AVG(4) @@ -2850,16 +2947,54 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l) enddo enddo + !!================= + !!todo: check for iputi=1,2 + !if (kputj.lt.kputi) then + ! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = & + ! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & + ! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) + !else if (kputj.gt.kputi) then + ! do l=1,mo_num_per_kpt + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l) + ! enddo + ! enddo + !else !kputj == kputi + ! mat(1:N_states,putj0+1:puti-1,puti) = & + ! mat(1:N_states,putj0+1:puti-1,puti) + & + ! tmp_row_kpts2(1:N_states,1:iputi-1) + ! do l=iputi,mo_num_per_kpt + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l) + ! enddo + ! enddo + !endif end do else hfix = h(1,mi) pfix = p(1,mi) p1 = p(1,ma) p2 = p(2,ma) + kpfix = (pfix-1)/mo_num_per_kpt + 1 + khfix = (hfix-1)/mo_num_per_kpt + 1 + kp1 = (p1-1)/mo_num_per_kpt + 1 + kp2 = (p2-1)/mo_num_per_kpt + 1 + ipfix = mod(pfix-1,mo_num_per_kpt) + 1 + ihfix = mod(hfix-1,mo_num_per_kpt) + 1 + ip1 = mod(p1-1, mo_num_per_kpt) + 1 + ip2 = mod(p2-1, mo_num_per_kpt) + 1 tmp_row = (0.d0,0.d0) tmp_row2 = (0.d0,0.d0) + !tmp_row_kpts = (0.d0,0.d0) + !tmp_row2_kpts = (0.d0,0.d0) call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) + !=============== + !begin ref putj = p2 do puti=1,mo_num if(lbanned(puti,ma)) cycle @@ -2886,6 +3021,61 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp endif end if end do + !end ref + !=============== + !begin kpts + !todo: combine if kp1==kp2 + ! putj = p2 + ! kputi1 = kconserv(kp1,kpfix,khfix) + ! puti01 = (kputi1-1)*mo_num_per_kpt + ! do iputi=1,mo_num_per_kpt + ! puti = puti01 + iputi + ! if(lbanned(puti,ma)) cycle + ! if(.not. banned(puti,putj,1)) then + ! hij = hij_cache2(iputi,1) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if + ! enddo + ! putj = p1 + ! kputi2 = kconserv(kp2,kpfix,khfix) + ! puti02 = (kputi2-1)*mo_num_per_kpt + ! do iputi=1,mo_num_per_kpt + ! puti = puti02 + iputi + ! if(lbanned(puti,ma)) cycle + ! if(.not. banned(puti,putj,1)) then + ! hij = hij_cache2(iputi,2) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + ! do k=1,N_states + ! tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if + ! end do + ! !end kpts + ! !=============== + ! !test printing + ! !print'((A),5(I5))','kpt info1: ',kconserv(kpfix,kp2,khfix),khfix,kpfix,kp2,kputi2 + ! !print'((A),5(I5))','kpt info2: ',kconserv(kpfix,kp1,khfix),khfix,kpfix,kp1,kputi1 + ! do ii0=1,mo_num + ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,p1,pfix,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + ! if (cdabs(tmp_row2_kpts(1,ii0)-tmp_row2(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2a, ',ii0,hfix,p2,pfix,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + ! ! else if ((cdabs(tmp_row2_kpts(1,ii0))+cdabs(tmp_row2(1,ii0))).gt.1.d-12) then + ! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2b, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + ! endif + ! enddo + !=================== mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1) do l=p2,mo_num !DIR$ LOOP COUNT AVG(4) From 3baf71974dab34e1a4d24b3b6fd843c285b2244c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Apr 2020 14:32:40 -0500 Subject: [PATCH 191/256] separate d1 kpts --- src/cipsi/d1_new.irp.f | 714 ++++++++++++++++++++++++++++++++++++++ src/cipsi/d1_old.irp.f | 263 ++++++++++++++ src/cipsi/selection.irp.f | 638 ++++++++++++++++++++++++++-------- 3 files changed, 1473 insertions(+), 142 deletions(-) create mode 100644 src/cipsi/d1_new.irp.f create mode 100644 src/cipsi/d1_old.irp.f diff --git a/src/cipsi/d1_new.irp.f b/src/cipsi/d1_new.irp.f new file mode 100644 index 00000000..f9a7b7f9 --- /dev/null +++ b/src/cipsi/d1_new.irp.f @@ -0,0 +1,714 @@ +subroutine get_d1_kpts_new(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: indices should be okay for complex? + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + + integer :: kp1,ip1, kp2,ip2, khfix,ihfix, kputi,iputi, kputj,iputj, putj0 + integer :: kpfix, ipfix, puti0 + integer :: kputi1,kputi2,puti01,puti02 + integer :: ii0 + + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + complex*16, allocatable :: hij_cache(:,:),hij_cache2(:,:) + complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) + complex*16 :: tmp_row_kpts(N_states, mo_num), tmp_row2_kpts(N_states, mo_num) + complex*16 :: tmp_row_kpts2(N_states, mo_num_per_kpt), tmp_row2_kpts2(N_states,mo_num_per_kpt) + complex*16 :: tmp_mat1(N_states,mo_num,mo_num), tmp_mat2(N_states,mo_num,mo_num) + PROVIDE mo_integrals_map N_int + + allocate (lbanned(mo_num, 2)) + allocate (hij_cache(mo_num,2),hij_cache2(mo_num_per_kpt,2)) + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) +! kputi = (puti-1)/mo_num_per_kpt + 1 +! khfix = (hfix-1)/mo_num_per_kpt + 1 +! kp1 = (p1-1)/mo_num_per_kpt + 1 +! kp2 = (p2-1)/mo_num_per_kpt + 1 +! iputi = mod(puti-1,mo_num_per_kpt) + 1 +! ihfix = mod(hfix-1,mo_num_per_kpt) + 1 +! ip1 = mod(p1-1, mo_num_per_kpt) + 1 +! ip2 = mod(p2-1, mo_num_per_kpt) + 1 + + if(.not. bannedOrb(puti, mi)) then + !================== + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !================== +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) +! tmp_row_kpts2 = (0.d0,0.d0) +! kputj = kconserv(kp1,kp2,khfix) +! putj0 = (kputj-1)*mo_num_per_kpt + !================== + do putj=1, hfix-1 + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + do putj=hfix+1, mo_num + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + !=========================== + ! begin kpts testing +! do putj = putj0+1, hfix-1 +! iputj = putj-putj0 +! if(lbanned(putj, ma)) cycle +! if(banned(putj, puti,bant)) cycle +! hij = hij_cache2(iputj,1) - hij_cache2(iputj,2) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! !tmp_row_kpts(k,putj) = tmp_row_kpts(k,putj) + hij * coefs(k) +! tmp_row_kpts2(k,iputj) = tmp_row_kpts2(k,iputj) + hij * coefs(k) +! enddo +! endif +! end do +! do putj = hfix+1,putj0+mo_num_per_kpt +! iputj = putj - putj0 +! if(lbanned(putj, ma)) cycle +! if(banned(putj, puti,bant)) cycle +! hij = hij_cache2(iputj,2) - hij_cache2(iputj,1) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! !tmp_row_kpts(k,putj) = tmp_row_kpts(k,putj) + hij * coefs(k) +! tmp_row_kpts2(k,iputj) = tmp_row_kpts2(k,iputj) + hij * coefs(k) +! enddo +! endif +! end do +! ! end kpts testing +! !=========================================================== +! !print*,'tmp_row_k,tmp_row' +! !do ii0=1,mo_num +! ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG, ',ii0,hfix,p1,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! ! endif +! !enddo +! !=========================================================== +! tmp_mat1 = (0.d0,0.d0) +! tmp_mat2 = (0.d0,0.d0) + !=========================================================== + if(ma == 1) then + !=========================================================== +! tmp_mat1(1:N_states,1:mo_num,puti) = tmp_mat1(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) +! tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & +! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) +! !=========================================================== + mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) +! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & +! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) + else + !=========================================================== +! do l=1,mo_num +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat1(k,puti,l) = tmp_mat1(k,puti,l) + tmp_row(k,l) +! enddo +! enddo +! do l=1,mo_num_per_kpt +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat2(k,puti,l+putj0) = tmp_mat2(k,puti,l+putj0) + tmp_row_kpts2(k,l) +! enddo +! enddo + !=========================================================== + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + enddo + enddo + !do l=1,mo_num_per_kpt + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k,puti,l+putj0) = mat(k,puti,l+putj0) + tmp_row_kpts2(k,l) + ! enddo + !enddo + end if + !=========================================================== + !do k=1,N_states + ! do l=1,mo_num + ! do ii0=1,mo_num + ! if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then + ! print'((A),6(I5),2(2(E25.15),2X))','WarNInG 4a, ',k,l,ii0,hfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) + ! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + ! enddo + ! enddo + !enddo + !=========================================================== + end if + + !MOVE MI + pfix = p(1,mi) +! kpfix = (pfix-1)/mo_num_per_kpt + 1 +! ipfix = mod(pfix-1,mo_num_per_kpt) + 1 + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) +! !tmp_row_kpts = (0.d0,0.d0) +! !tmp_row2_kpts = (0.d0,0.d0) +! tmp_row_kpts2 = (0.d0,0.d0) +! tmp_row2_kpts2 = (0.d0,0.d0) + !=========================================================== + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !=========================================================== +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) + putj = p1 + !============ + !begin ref + do puti=1,mo_num !HOT + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do +! !end ref +! !=================== +! !begin kpts +! if (kp1.eq.kp2) then +! !if (.False.) then +! kputi1 = kconserv(kpfix,kp1,khfix) +! kputi2 = kputi1 +! puti01 = (kputi1-1)*mo_num_per_kpt +! puti02 = puti01 +! do iputi=1,mo_num_per_kpt !HOT +! puti = puti01 + iputi +! if(lbanned(puti,mi)) cycle +! !p1 fixed +! putj = p1 +! if(.not. banned(putj,puti,bant)) then +! hij = hij_cache2(iputi,2) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_row_kpts2(k,iputi) = tmp_row_kpts2(k,iputi) + hij * coefs(k) +! !tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) +! enddo +! endif +! end if +!! enddo +!! +! putj = p2 +!! do puti=1,mo_num !HOT +! if(.not. banned(putj,puti,bant)) then +! hij = hij_cache2(iputi,1) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) +! do k=1,N_states +! tmp_row2_kpts2(k,iputi) = tmp_row2_kpts2(k,iputi) + hij * coefs(k) +! !tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) +! enddo +! endif +! end if +! end do +! else !kp1.ne.kp2 +! kputi2 = kconserv(kpfix,kp2,khfix) +! puti02 = (kputi2-1)*mo_num_per_kpt +! putj = p1 +! do iputi=1,mo_num_per_kpt !HOT +! puti = puti02 + iputi +! if(lbanned(puti,mi)) cycle +! !p1 fixed +! if(.not. banned(putj,puti,bant)) then +! hij = hij_cache2(iputi,2) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_row_kpts2(k,iputi) = tmp_row_kpts2(k,iputi) + hij * coefs(k) +! !tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) +! enddo +! endif +! end if +! enddo +!! +! putj = p2 +! kputi1 = kconserv(kpfix,kp1,khfix) +! puti01 = (kputi1-1)*mo_num_per_kpt +! do iputi=1,mo_num_per_kpt !HOT +! puti = puti01 + iputi +! if(lbanned(puti,mi)) cycle +! if(.not. banned(putj,puti,bant)) then +! hij = hij_cache2(iputi,1) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) +! do k=1,N_states +! tmp_row2_kpts2(k,iputi) = tmp_row2_kpts2(k,iputi) + hij * coefs(k) +! !tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) +! enddo +! endif +! end if +! end do +! endif +! !end kpts +! !=================== +! !test printing +! !print'((A),5(I5))','kpt info1: ',kconserv(kpfix,kp2,khfix),khfix,kpfix,kp2,kputi2 +! !print'((A),5(I5))','kpt info2: ',kconserv(kpfix,kp1,khfix),khfix,kpfix,kp1,kputi1 +! !do ii0=1,mo_num +! ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! !! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then +! !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! ! endif +! ! if (cdabs(tmp_row2_kpts(1,ii0)-tmp_row2(1,ii0)).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2a, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) +! !! else if ((cdabs(tmp_row2_kpts(1,ii0))+cdabs(tmp_row2(1,ii0))).gt.1.d-12) then +! !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2b, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) +! ! endif +! !enddo +! !=================== +! +! tmp_mat1 = (0.d0,0.d0) +! tmp_mat2 = (0.d0,0.d0) + if(mi == 1) then +! !=================== +! tmp_mat1(:,:,p1) = tmp_mat1(:,:,p1) + tmp_row(:,:) +! tmp_mat1(:,:,p2) = tmp_mat1(:,:,p2) + tmp_row2(:,:) +! tmp_mat2(:,puti02+1:puti02+mo_num_per_kpt,p1) = tmp_mat2(:,puti02+1:puti02+mo_num_per_kpt,p1) + tmp_row_kpts2(:,:) +! tmp_mat2(:,puti01+1:puti01+mo_num_per_kpt,p2) = tmp_mat2(:,puti01+1:puti01+mo_num_per_kpt,p2) + tmp_row2_kpts2(:,:) +! !=================== + mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) + mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) +! mat(:,puti02+1:puti02+mo_num_per_kpt,p1) = mat(:,puti02+1:puti02+mo_num_per_kpt,p1) + tmp_row_kpts2(:,:) +! mat(:,puti01+1:puti01+mo_num_per_kpt,p2) = mat(:,puti01+1:puti01+mo_num_per_kpt,p2) + tmp_row2_kpts2(:,:) + else + !=================== +! do l=1,mo_num +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat1(k,p1,l) = tmp_mat1(k,p1,l) + tmp_row(k,l) +! tmp_mat1(k,p2,l) = tmp_mat1(k,p2,l) + tmp_row2(k,l) +! enddo +! enddo +! do l=1,mo_num_per_kpt +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat2(k,p1,l+puti02) = tmp_mat2(k,p1,l+puti02) + tmp_row_kpts2(k,l) +! tmp_mat2(k,p2,l+puti01) = tmp_mat2(k,p2,l+puti01) + tmp_row2_kpts2(k,l) +! enddo +! enddo + !=================== + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) + mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + enddo + enddo +! do l=1,mo_num_per_kpt +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! mat(k,p1,l+puti02) = mat(k,p1,l+puti02) + tmp_row_kpts2(k,l) +! mat(k,p2,l+puti01) = mat(k,p2,l+puti01) + tmp_row2_kpts2(k,l) +! enddo +! enddo + end if + !=========================================================== +! do k=1,N_states +! do l=1,mo_num +! do ii0=1,mo_num +! if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then +! print'((A),7(I5),2(2(E25.15),2X))','WarNInG 5a, ',k,l,ii0,hfix,pfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) +! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! endif +! enddo +! enddo +! enddo + !=========================================================== + !todo: kpts okay up to this point in get_d1_complex + + else ! sp /= 3 + + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) +! kputi = (puti-1)/mo_num_per_kpt + 1 +! khfix = (hfix-1)/mo_num_per_kpt + 1 +! kp1 = (p1-1)/mo_num_per_kpt + 1 +! kp2 = (p2-1)/mo_num_per_kpt + 1 +! iputi = mod(puti-1,mo_num_per_kpt) + 1 +! ihfix = mod(hfix-1,mo_num_per_kpt) + 1 +! ip1 = mod(p1-1, mo_num_per_kpt) + 1 +! ip2 = mod(p2-1, mo_num_per_kpt) + 1 + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) +! call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) + !tmp_row_kpts = (0.d0,0.d0) +! tmp_row_kpts2 = (0.d0,0.d0) + !=================== + !begin ref + do putj=1,hfix-1 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + do putj=hfix+1,mo_num + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + !end ref + !================= + !begin kpts +! kputj = kconserv(kp1,kp2,khfix) +! putj0 = (kputj-1)*mo_num_per_kpt +! do putj = putj0+1,hfix-1 +! iputj = putj - putj0 +! if(banned(putj,puti,1)) cycle +! if(lbanned(putj,ma)) cycle +! hij = hij_cache2(iputj,1) - hij_cache2(iputj,2) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) +! !tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:) +! tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:) +! endif +! end do +! do putj=hfix+1,putj0+mo_num_per_kpt +! iputj = putj - putj0 +! if(banned(putj,puti,1)) cycle +! if(lbanned(putj,ma)) cycle +! hij = hij_cache2(iputj,2) - hij_cache2(iputj,1) +! if (hij /= (0.d0,0.d0)) then +! hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) +! !tmp_row_kpts(:,putj) = tmp_row_kpts(:,putj) + hij * coefs(:) +! tmp_row_kpts2(:,iputj) = tmp_row_kpts2(:,iputj) + hij * coefs(:) +! endif +! end do +! +! !end kpts +! !do ii0=1,mo_num +! ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! !! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then +! !! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! ! endif +! !enddo +! !================= +! tmp_mat1 = (0.d0,0.d0) +! tmp_mat2 = (0.d0,0.d0) +! tmp_mat1(:, :puti-1, puti) = tmp_mat1(:, :puti-1, puti) + tmp_row(:,:puti-1) +! do l=puti,mo_num +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat1(k, puti, l) = tmp_mat1(k, puti,l) + tmp_row(k,l) +! enddo +! enddo +! !================= +! if (kputj.lt.kputi) then +! tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = & +! tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & +! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) +! else if (kputj.gt.kputi) then +! do l=1,mo_num_per_kpt +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l) +! enddo +! enddo +! else !kputj == kputi +! tmp_mat2(1:N_states,putj0+1:puti-1,puti) = & +! tmp_mat2(1:N_states,putj0+1:puti-1,puti) + & +! tmp_row_kpts2(1:N_states,1:iputi-1) +! do l=iputi,mo_num_per_kpt +! !DIR$ LOOP COUNT AVG(4) +! do k=1,N_states +! tmp_mat2(k, puti, l+putj0) = tmp_mat2(k, puti,l+putj0) + tmp_row_kpts2(k,l) +! enddo +! enddo +! endif +! !================= +! do k=1,N_states +! do l=1,mo_num +! do ii0=1,mo_num +! if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then +! print'((A),6(I5),2(2(E25.15),2X))','WarNInG 3a, ',k,l,ii0,hfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) +! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then +! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) +! endif +! enddo +! enddo +! enddo + + !================= + mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1) + do l=puti,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l) + enddo + enddo + !!================= + !!todo: check for iputi=1,2 + !if (kputj.lt.kputi) then + ! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = & + ! mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & + ! tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) + !else if (kputj.gt.kputi) then + ! do l=1,mo_num_per_kpt + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l) + ! enddo + ! enddo + !else !kputj == kputi + ! mat(1:N_states,putj0+1:puti-1,puti) = & + ! mat(1:N_states,putj0+1:puti-1,puti) + & + ! tmp_row_kpts2(1:N_states,1:iputi-1) + ! do l=iputi,mo_num_per_kpt + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k, puti, l+putj0) = mat(k, puti,l+putj0) + tmp_row_kpts2(k,l) + ! enddo + ! enddo + !endif + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) +! kpfix = (pfix-1)/mo_num_per_kpt + 1 +! khfix = (hfix-1)/mo_num_per_kpt + 1 +! kp1 = (p1-1)/mo_num_per_kpt + 1 +! kp2 = (p2-1)/mo_num_per_kpt + 1 +! ipfix = mod(pfix-1,mo_num_per_kpt) + 1 +! ihfix = mod(hfix-1,mo_num_per_kpt) + 1 +! ip1 = mod(p1-1, mo_num_per_kpt) + 1 +! ip2 = mod(p2-1, mo_num_per_kpt) + 1 + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + !tmp_row_kpts = (0.d0,0.d0) + !tmp_row2_kpts = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) + !call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,pfix,ipfix,kpfix,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) + !=============== + !begin ref + putj = p2 + do puti=1,mo_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + !end ref + !=============== + !begin kpts + !todo: combine if kp1==kp2 + ! putj = p2 + ! kputi1 = kconserv(kp1,kpfix,khfix) + ! puti01 = (kputi1-1)*mo_num_per_kpt + ! do iputi=1,mo_num_per_kpt + ! puti = puti01 + iputi + ! if(lbanned(puti,ma)) cycle + ! if(.not. banned(puti,putj,1)) then + ! hij = hij_cache2(iputi,1) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! tmp_row_kpts(k,puti) = tmp_row_kpts(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if + ! enddo + ! putj = p1 + ! kputi2 = kconserv(kp2,kpfix,khfix) + ! puti02 = (kputi2-1)*mo_num_per_kpt + ! do iputi=1,mo_num_per_kpt + ! puti = puti02 + iputi + ! if(lbanned(puti,ma)) cycle + ! if(.not. banned(puti,putj,1)) then + ! hij = hij_cache2(iputi,2) + ! if (hij /= (0.d0,0.d0)) then + ! hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + ! do k=1,N_states + ! tmp_row2_kpts(k,puti) = tmp_row2_kpts(k,puti) + hij * coefs(k) + ! enddo + ! endif + ! end if + ! end do + ! !end kpts + ! !=============== + ! !test printing + ! !print'((A),5(I5))','kpt info1: ',kconserv(kpfix,kp2,khfix),khfix,kpfix,kp2,kputi2 + ! !print'((A),5(I5))','kpt info2: ',kconserv(kpfix,kp1,khfix),khfix,kpfix,kp1,kputi1 + ! do ii0=1,mo_num + ! if (cdabs(tmp_row_kpts(1,ii0)-tmp_row(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1a, ',ii0,hfix,p1,pfix,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + ! endif + ! if (cdabs(tmp_row2_kpts(1,ii0)-tmp_row2(1,ii0)).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2a, ',ii0,hfix,p2,pfix,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + ! ! else if ((cdabs(tmp_row2_kpts(1,ii0))+cdabs(tmp_row2(1,ii0))).gt.1.d-12) then + ! ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 2b, ',ii0,hfix,pfix,p1,tmp_row2_kpts(1,ii0),tmp_row2(1,ii0) + ! endif + ! enddo + !=================== + mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1) + do l=p2,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p2,l) = mat(k,p2,l) + tmp_row(k,l) + enddo + enddo + mat(:,:p1-1,p1) = mat(:,:p1-1,p1) + tmp_row2(:,:p1-1) + do l=p1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row2(k,l) + enddo + enddo + end if + end if + deallocate(lbanned,hij_cache) + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + ! gen is a selector; mask is ionized generator; det is alpha + ! hij is contribution to + call i_h_j_complex(gen, det, N_int, hij) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + ! take conjugate to get contribution to instead of + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * dconjg(hij) + enddo + end do + end do +end + + diff --git a/src/cipsi/d1_old.irp.f b/src/cipsi/d1_old.irp.f new file mode 100644 index 00000000..0c93b157 --- /dev/null +++ b/src/cipsi/d1_old.irp.f @@ -0,0 +1,263 @@ + +subroutine get_d1_complex_old(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: indices should be okay for complex? + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + complex*16, allocatable :: hij_cache(:,:) + complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) + PROVIDE mo_integrals_map N_int + + allocate (lbanned(mo_num, 2)) + allocate (hij_cache(mo_num,2)) + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) + if(.not. bannedOrb(puti, mi)) then + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) + do putj=1, hfix-1 + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + do putj=hfix+1, mo_num + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + + if(ma == 1) then + mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + enddo + enddo + end if + end if + + !MOVE MI + pfix = p(1,mi) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + putj = p1 + do puti=1,mo_num !HOT + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + + if(mi == 1) then + mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) + mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) + mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + enddo + enddo + end if + + else ! sp /= 3 + + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) + do putj=1,hfix-1 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + do putj=hfix+1,mo_num + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + + mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1) + do l=puti,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l) + enddo + enddo + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + putj = p2 + do puti=1,mo_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1) + do l=p2,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p2,l) = mat(k,p2,l) + tmp_row(k,l) + enddo + enddo + mat(:,:p1-1,p1) = mat(:,:p1-1,p1) + tmp_row2(:,:p1-1) + do l=p1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row2(k,l) + enddo + enddo + end if + end if + deallocate(lbanned,hij_cache) + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + ! gen is a selector; mask is ionized generator; det is alpha + ! hij is contribution to + call i_h_j_complex(gen, det, N_int, hij) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + ! take conjugate to get contribution to instead of + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * dconjg(hij) + enddo + end do + end do +end + diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 96fd0249..90f12f8c 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2296,7 +2296,9 @@ subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat if(nt == 4) then ! differ by 6 (2,4) call get_d2_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) else if(nt == 3) then ! differ by 4 (1,3) - call get_d1_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) + !call get_d1_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) + !call get_d1_kpts(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) + call get_d1_kpts_new(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) else ! differ by 2 (0,2) call get_d0_complex(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp_complex(1, interesting(i))) end if @@ -2520,6 +2522,351 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + complex*16, allocatable :: hij_cache(:,:) + complex*16 :: hij, tmp_row(N_states, mo_num), tmp_row2(N_states, mo_num) + PROVIDE mo_integrals_map N_int + + allocate (lbanned(mo_num, 2)) + allocate (hij_cache(mo_num,2)) + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) + if(.not. bannedOrb(puti, mi)) then + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) + do putj=1, hfix-1 + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + do putj=hfix+1, mo_num + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + + if(ma == 1) then + mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + enddo + enddo + end if + end if + + !MOVE MI + pfix = p(1,mi) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + putj = p1 + do puti=1,mo_num !HOT + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + + if(mi == 1) then + mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) + mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) + else + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) + mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + enddo + enddo + end if + + else ! sp /= 3 + + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + tmp_row = (0.d0,0.d0) + do putj=1,hfix-1 + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + do putj=hfix+1,mo_num + if(banned(putj,puti,1)) cycle + if(lbanned(putj,ma)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + tmp_row(:,putj) = tmp_row(:,putj) + hij * coefs(:) + endif + end do + + mat(:, :puti-1, puti) = mat(:, :puti-1, puti) + tmp_row(:,:puti-1) + do l=puti,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, l) = mat(k, puti,l) + tmp_row(k,l) + enddo + enddo + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) + call get_mo_two_e_integrals_complex(hfix,p1,pfix,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + putj = p2 + do puti=1,mo_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do + mat(:,:p2-1,p2) = mat(:,:p2-1,p2) + tmp_row(:,:p2-1) + do l=p2,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p2,l) = mat(k,p2,l) + tmp_row(k,l) + enddo + enddo + mat(:,:p1-1,p1) = mat(:,:p1-1,p1) + tmp_row2(:,:p1-1) + do l=p1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k,p1,l) = mat(k,p1,l) + tmp_row2(k,l) + enddo + enddo + end if + end if + deallocate(lbanned,hij_cache) + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + ! gen is a selector; mask is ionized generator; det is alpha + ! hij is contribution to + call i_h_j_complex(gen, det, N_int, hij) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + ! take conjugate to get contribution to instead of + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * dconjg(hij) + enddo + end do + end do +end + + + +subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: indices/conjg should be okay for complex + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + integer :: i, j, k, s, h1, h2, p1, p2, puti, putj + double precision :: phase + complex*16 :: hij + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + logical :: ok + + integer, parameter :: bant=1 + complex*16, allocatable :: hij_cache1(:), hij_cache2(:) + allocate (hij_cache1(mo_num),hij_cache2(mo_num)) + + + if(sp == 3) then ! AB + h1 = p(1,1) + h2 = p(1,2) + do p1=1, mo_num + if(bannedOrb(p1, 1)) cycle + call get_mo_two_e_integrals_complex(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) + do p2=1, mo_num + if(bannedOrb(p2,2)) cycle + if(banned(p1, p2, bant)) cycle ! rentable? + if(p1 == h1 .or. p2 == h2) then + call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) + ! call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this + call i_h_j_complex(det, gen, N_int, hij) + else + phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) + hij = hij_cache1(p2) * phase + end if + if (hij == (0.d0,0.d0)) cycle + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT + enddo + end do + end do + + else ! AA BB + p1 = p(1,sp) + p2 = p(2,sp) + do puti=1, mo_num + if(bannedOrb(puti, sp)) cycle + call get_mo_two_e_integrals_complex(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map,mo_integrals_map_2) + do putj=puti+1, mo_num + if(bannedOrb(putj, sp)) cycle + if(banned(puti, putj, bant)) cycle ! rentable? + if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then + call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) + !call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this + call i_h_j_complex(det, gen, N_int, hij) + if (hij == (0.d0,0.d0)) cycle + else + hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj)) + if (hij == (0.d0,0.d0)) cycle + hij = dconjg(hij) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) + end if + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij + enddo + end do + end do + end if + + deallocate(hij_cache1,hij_cache2) +end + +subroutine get_d1_kpts(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + !todo: indices should be okay for complex? + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(bit_kind), intent(in) :: phasemask(N_int,2) + logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) + integer(bit_kind) :: det(N_int, 2) + complex*16, intent(in) :: coefs(N_states) + complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision, external :: get_phase_bi + complex*16, external :: mo_two_e_integral_complex + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib, k, l + integer :: kp1,ip1, kp2,ip2, khfix,ihfix, kputi,iputi, kputj,iputj, putj0 integer :: kpfix, ipfix, puti0 integer :: kputi1,kputi2,puti01,puti02 @@ -2570,38 +2917,41 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp ip2 = mod(p2-1, mo_num_per_kpt) + 1 if(.not. bannedOrb(puti, mi)) then - !call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) - !call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !================== + call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !================== call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p2,ip2,kp2,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) tmp_row = (0.d0,0.d0) tmp_row_kpts2 = (0.d0,0.d0) kputj = kconserv(kp1,kp2,khfix) putj0 = (kputj-1)*mo_num_per_kpt - !do putj=1, hfix-1 - ! if(lbanned(putj, ma)) cycle - ! if(banned(putj, puti,bant)) cycle - ! hij = hij_cache(putj,1) - hij_cache(putj,2) - ! if (hij /= (0.d0,0.d0)) then - ! hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) - ! !DIR$ LOOP COUNT AVG(4) - ! do k=1,N_states - ! tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) - ! enddo - ! endif - !end do - !do putj=hfix+1, mo_num - ! if(lbanned(putj, ma)) cycle - ! if(banned(putj, puti,bant)) cycle - ! hij = hij_cache(putj,2) - hij_cache(putj,1) - ! if (hij /= (0.d0,0.d0)) then - ! hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) - ! !DIR$ LOOP COUNT AVG(4) - ! do k=1,N_states - ! tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) - ! enddo - ! endif - !end do + !================== + do putj=1, hfix-1 + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,1) - hij_cache(putj,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do + do putj=hfix+1, mo_num + if(lbanned(putj, ma)) cycle + if(banned(putj, puti,bant)) cycle + hij = hij_cache(putj,2) - hij_cache(putj,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,putj) = tmp_row(k,putj) + hij * coefs(k) + enddo + endif + end do !=========================== ! begin kpts testing do putj = putj0+1, hfix-1 @@ -2641,11 +2991,39 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp ! endif !enddo !=========================================================== + tmp_mat1 = (0.d0,0.d0) + tmp_mat2 = (0.d0,0.d0) + !=========================================================== if(ma == 1) then + !=========================================================== + tmp_mat1(1:N_states,1:mo_num,puti) = tmp_mat1(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) + tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = tmp_mat2(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & + tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) + !=========================================================== !mat(1:N_states,1:mo_num,puti) = mat(1:N_states,1:mo_num,puti) + tmp_row(1:N_states,1:mo_num) mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) = mat(1:N_states,putj0+1:putj0+mo_num_per_kpt,puti) + & tmp_row_kpts2(1:N_states,1:mo_num_per_kpt) else + !=========================================================== + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat1(k,puti,l) = tmp_mat1(k,puti,l) + tmp_row(k,l) + enddo + enddo + do l=1,mo_num_per_kpt + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat2(k,puti,l+putj0) = tmp_mat2(k,puti,l+putj0) + tmp_row_kpts2(k,l) + enddo + enddo + !=========================================================== + !do l=1,mo_num + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k,puti,l) = mat(k,puti,l) + tmp_row(k,l) + ! enddo + !enddo do l=1,mo_num_per_kpt !DIR$ LOOP COUNT AVG(4) do k=1,N_states @@ -2653,53 +3031,68 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp enddo enddo end if + !=========================================================== + do k=1,N_states + do l=1,mo_num + do ii0=1,mo_num + if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then + print'((A),6(I5),2(2(E25.15),2X))','WarNInG 4a, ',k,l,ii0,hfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) + ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + endif + enddo + enddo + enddo + !=========================================================== end if !MOVE MI pfix = p(1,mi) kpfix = (pfix-1)/mo_num_per_kpt + 1 ipfix = mod(pfix-1,mo_num_per_kpt) + 1 - !tmp_row = (0.d0,0.d0) - !tmp_row2 = (0.d0,0.d0) + tmp_row = (0.d0,0.d0) + tmp_row2 = (0.d0,0.d0) !tmp_row_kpts = (0.d0,0.d0) !tmp_row2_kpts = (0.d0,0.d0) tmp_row_kpts2 = (0.d0,0.d0) tmp_row2_kpts2 = (0.d0,0.d0) - !call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) - !call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !=========================================================== + call get_mo_two_e_integrals_complex(hfix,pfix,p1,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) + call get_mo_two_e_integrals_complex(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) + !=========================================================== call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p1,ip1,kp1,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,pfix,ipfix,kpfix,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,2),mo_integrals_map,mo_integrals_map_2) putj = p1 !============ !begin ref - !do puti=1,mo_num !HOT - ! if(lbanned(puti,mi)) cycle - ! !p1 fixed - ! putj = p1 - ! if(.not. banned(putj,puti,bant)) then - ! hij = hij_cache(puti,2) - ! if (hij /= (0.d0,0.d0)) then - ! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) - ! !DIR$ LOOP COUNT AVG(4) - ! do k=1,N_states - ! tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) - ! enddo - ! endif - ! end if -! ! enddo -! ! - ! putj = p2 -! ! do puti=1,mo_num !HOT - ! if(.not. banned(putj,puti,bant)) then - ! hij = hij_cache(puti,1) - ! if (hij /= (0.d0,0.d0)) then - ! hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) - ! do k=1,N_states - ! tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) - ! enddo - ! endif - ! end if - !end do + do puti=1,mo_num !HOT + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,2) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_row(k,puti) = tmp_row(k,puti) + hij * coefs(k) + enddo + endif + end if +! enddo +! + putj = p2 +! do puti=1,mo_num !HOT + if(.not. banned(putj,puti,bant)) then + hij = hij_cache(puti,1) + if (hij /= (0.d0,0.d0)) then + hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) + do k=1,N_states + tmp_row2(k,puti) = tmp_row2(k,puti) + hij * coefs(k) + enddo + endif + end if + end do !end ref !=================== !begin kpts @@ -2798,12 +3191,43 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp !enddo !=================== + tmp_mat1 = (0.d0,0.d0) + tmp_mat2 = (0.d0,0.d0) if(mi == 1) then + !=================== + tmp_mat1(:,:,p1) = tmp_mat1(:,:,p1) + tmp_row(:,:) + tmp_mat1(:,:,p2) = tmp_mat1(:,:,p2) + tmp_row2(:,:) + tmp_mat2(:,puti02+1:puti02+mo_num_per_kpt,p1) = tmp_mat2(:,puti02+1:puti02+mo_num_per_kpt,p1) + tmp_row_kpts2(:,:) + tmp_mat2(:,puti01+1:puti01+mo_num_per_kpt,p2) = tmp_mat2(:,puti01+1:puti01+mo_num_per_kpt,p2) + tmp_row2_kpts2(:,:) + !=================== !mat(:,:,p1) = mat(:,:,p1) + tmp_row(:,:) !mat(:,:,p2) = mat(:,:,p2) + tmp_row2(:,:) mat(:,puti02+1:puti02+mo_num_per_kpt,p1) = mat(:,puti02+1:puti02+mo_num_per_kpt,p1) + tmp_row_kpts2(:,:) mat(:,puti01+1:puti01+mo_num_per_kpt,p2) = mat(:,puti01+1:puti01+mo_num_per_kpt,p2) + tmp_row2_kpts2(:,:) else + !=================== + do l=1,mo_num + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat1(k,p1,l) = tmp_mat1(k,p1,l) + tmp_row(k,l) + tmp_mat1(k,p2,l) = tmp_mat1(k,p2,l) + tmp_row2(k,l) + enddo + enddo + do l=1,mo_num_per_kpt + !DIR$ LOOP COUNT AVG(4) + do k=1,N_states + tmp_mat2(k,p1,l+puti02) = tmp_mat2(k,p1,l+puti02) + tmp_row_kpts2(k,l) + tmp_mat2(k,p2,l+puti01) = tmp_mat2(k,p2,l+puti01) + tmp_row2_kpts2(k,l) + enddo + enddo + !=================== + !do l=1,mo_num + ! !DIR$ LOOP COUNT AVG(4) + ! do k=1,N_states + ! mat(k,p1,l) = mat(k,p1,l) + tmp_row(k,l) + ! mat(k,p2,l) = mat(k,p2,l) + tmp_row2(k,l) + ! enddo + !enddo do l=1,mo_num_per_kpt !DIR$ LOOP COUNT AVG(4) do k=1,N_states @@ -2812,6 +3236,19 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp enddo enddo end if + !=========================================================== + do k=1,N_states + do l=1,mo_num + do ii0=1,mo_num + if (cdabs(tmp_mat2(k,l,ii0)-tmp_mat1(k,l,ii0)).gt.1.d-12) then + print'((A),7(I5),2(2(E25.15),2X))','WarNInG 5a, ',k,l,ii0,hfix,pfix,p1,p2,tmp_mat2(k,l,ii0),tmp_mat1(k,l,ii0) + ! else if ((cdabs(tmp_row_kpts(1,ii0))+cdabs(tmp_row(1,ii0))).gt.1.d-12) then + ! print'((A),4(I5),2(2(E25.15),2X))','WarNInG 1b, ',ii0,hfix,pfix,p2,tmp_row_kpts(1,ii0),tmp_row(1,ii0) + endif + enddo + enddo + enddo + !=========================================================== !todo: kpts okay up to this point in get_d1_complex else ! sp /= 3 @@ -3124,86 +3561,3 @@ subroutine get_d1_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp end - - -subroutine get_d0_complex(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) - !todo: indices/conjg should be okay for complex - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) - integer(bit_kind), intent(in) :: phasemask(N_int,2) - logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num,2) - integer(bit_kind) :: det(N_int, 2) - complex*16, intent(in) :: coefs(N_states) - complex*16, intent(inout) :: mat(N_states, mo_num, mo_num) - integer, intent(in) :: h(0:2,2), p(0:4,2), sp - - integer :: i, j, k, s, h1, h2, p1, p2, puti, putj - double precision :: phase - complex*16 :: hij - double precision, external :: get_phase_bi - complex*16, external :: mo_two_e_integral_complex - logical :: ok - - integer, parameter :: bant=1 - complex*16, allocatable :: hij_cache1(:), hij_cache2(:) - allocate (hij_cache1(mo_num),hij_cache2(mo_num)) - - - if(sp == 3) then ! AB - h1 = p(1,1) - h2 = p(1,2) - do p1=1, mo_num - if(bannedOrb(p1, 1)) cycle - call get_mo_two_e_integrals_complex(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) - do p2=1, mo_num - if(bannedOrb(p2,2)) cycle - if(banned(p1, p2, bant)) cycle ! rentable? - if(p1 == h1 .or. p2 == h2) then - call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) - ! call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this - call i_h_j_complex(det, gen, N_int, hij) - else - phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) - hij = hij_cache1(p2) * phase - end if - if (hij == (0.d0,0.d0)) cycle - !DIR$ LOOP COUNT AVG(4) - do k=1,N_states - mat(k, p1, p2) = mat(k, p1, p2) + coefs(k) * hij ! HOTSPOT - enddo - end do - end do - - else ! AA BB - p1 = p(1,sp) - p2 = p(2,sp) - do puti=1, mo_num - if(bannedOrb(puti, sp)) cycle - call get_mo_two_e_integrals_complex(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map,mo_integrals_map_2) - call get_mo_two_e_integrals_complex(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map,mo_integrals_map_2) - do putj=puti+1, mo_num - if(bannedOrb(putj, sp)) cycle - if(banned(puti, putj, bant)) cycle ! rentable? - if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then - call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) - !call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this - call i_h_j_complex(det, gen, N_int, hij) - if (hij == (0.d0,0.d0)) cycle - else - hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj)) - if (hij == (0.d0,0.d0)) cycle - hij = dconjg(hij) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) - end if - !DIR$ LOOP COUNT AVG(4) - do k=1,N_states - mat(k, puti, putj) = mat(k, puti, putj) + coefs(k) * hij - enddo - end do - end do - end if - - deallocate(hij_cache1,hij_cache2) -end - From 4e199be01a701ce4bd31cf01e20aa8e63851b2be Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Apr 2020 14:44:38 -0500 Subject: [PATCH 192/256] minor converter cleanup --- src/utils_complex/MolPyscfToQPkpts.py | 62 +++------------------------ 1 file changed, 7 insertions(+), 55 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 75bcd7fc..68c67200 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -695,15 +695,9 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, with h5py.File(qph5path,'a') as qph5: # k,mo,ao(,2) mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c',dtype=np.complex128) - mo_coef_blocked=block_diag(*mo_k) - mo_coef_blocked_f = block_diag(*mo_coef_f) - #qph5.create_dataset('mo_basis/mo_coef_real',data=mo_coef_blocked.real) - #qph5.create_dataset('mo_basis/mo_coef_imag',data=mo_coef_blocked.imag) - #qph5.create_dataset('mo_basis/mo_coef_kpts_real',data=mo_k.real) - #qph5.create_dataset('mo_basis/mo_coef_kpts_imag',data=mo_k.imag) - print(mo_coef_f.dtype) - print(mo_coef_blocked_f.dtype) - qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) + #mo_coef_blocked=block_diag(*mo_k) + #mo_coef_blocked_f = block_diag(*mo_coef_f) + #qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) if print_debug: @@ -722,28 +716,10 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, if print_ao_ints_mono: with h5py.File(qph5path,'a') as qph5: - kin_ao_blocked=block_diag(*kin_ao) - ovlp_ao_blocked=block_diag(*ovlp_ao) - ne_ao_blocked=block_diag(*ne_ao) - kin_ao_f = np.array(kin_ao.transpose((0,2,1)),order='c',dtype=np.complex128) ovlp_ao_f = np.array(ovlp_ao.transpose((0,2,1)),order='c',dtype=np.complex128) ne_ao_f = np.array(ne_ao.transpose((0,2,1)),order='c',dtype=np.complex128) - kin_ao_blocked_f = block_diag(*kin_ao_f) - ovlp_ao_blocked_f = block_diag(*ovlp_ao_f) - ne_ao_blocked_f = block_diag(*ne_ao_f) - - #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_real',data=kin_ao_blocked.real) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_imag',data=kin_ao_blocked.imag) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_real',data=ovlp_ao_blocked.real) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_imag',data=ovlp_ao_blocked.imag) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_real', data=ne_ao_blocked.real) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_imag', data=ne_ao_blocked.imag) - - #qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic',data=kin_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap',data=ovlp_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) - #qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e', data=ne_ao_blocked_f.view(dtype=np.float64).reshape((Nk*nao,Nk*nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_kinetic_kpts',data=kin_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_overlap_kpts',data=ovlp_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) qph5.create_dataset('ao_one_e_ints/ao_integrals_n_e_kpts', data=ne_ao_f.view(dtype=np.float64).reshape((Nk,nao,nao,2))) @@ -758,29 +734,11 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, ovlp_mo = ao_to_mo_1e(ovlp_ao,mo_k) ne_mo = ao_to_mo_1e(ne_ao,mo_k) - kin_mo_blocked=block_diag(*kin_mo) - ovlp_mo_blocked=block_diag(*ovlp_mo) - ne_mo_blocked=block_diag(*ne_mo) - with h5py.File(qph5path,'a') as qph5: kin_mo_f = np.array(kin_mo.transpose((0,2,1)),order='c',dtype=np.complex128) ovlp_mo_f = np.array(ovlp_mo.transpose((0,2,1)),order='c',dtype=np.complex128) ne_mo_f = np.array(ne_mo.transpose((0,2,1)),order='c',dtype=np.complex128) - kin_mo_blocked_f = block_diag(*kin_mo_f) - ovlp_mo_blocked_f = block_diag(*ovlp_mo_f) - ne_mo_blocked_f = block_diag(*ne_mo_f) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_real',data=kin_mo_blocked.real) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_imag',data=kin_mo_blocked.imag) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_real',data=ovlp_mo_blocked.real) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_imag',data=ovlp_mo_blocked.imag) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_real', data=ne_mo_blocked.real) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_imag', data=ne_mo_blocked.imag) - - #qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic',data=kin_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap',data=ovlp_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) - #qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e', data=ne_mo_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nmo,2))) - qph5.create_dataset('mo_one_e_ints/mo_integrals_kinetic_kpts',data=kin_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_overlap_kpts',data=ovlp_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) qph5.create_dataset('mo_one_e_ints/mo_integrals_n_e_kpts', data=ne_mo_f.view(dtype=np.float64).reshape((Nk,nmo,nmo,2))) @@ -811,37 +769,31 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # # ########################################## - j3arr = get_j3ao(mf.with_df._cderi,nao,Nk) + j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) # test? nkpt_pairs should be (Nk*(Nk+1))//2 - nkpt_pairs, naux, _, _ = j3arr.shape + nkpt_pairs, naux, _, _ = j3ao_new.shape print("n df fitting functions", naux) with h5py.File(qph5path,'a') as qph5: qph5.create_group('ao_two_e_ints') qph5['ao_two_e_ints'].attrs['df_num']=naux - j3ao_new = get_j3ao_new(mf.with_df._cderi,nao,Nk) if print_ao_ints_df: if print_debug: - print_df(j3arr,'D.qp',bielec_int_threshold) + print_df(j3ao_new,'D.qp',bielec_int_threshold) with h5py.File(qph5path,'a') as qph5: - #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_real',data=j3arr.transpose((2,3,1,0)).real) - #qph5.create_dataset('ao_two_e_ints/df_ao_integrals_imag',data=j3arr.transpose((2,3,1,0)).imag) qph5.create_dataset('ao_two_e_ints/df_ao_integrals',data=j3ao_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nao,nao,2))) if print_mo_ints_df: - j3mo = df_ao_to_mo(j3arr,mo_k) j3mo_new = df_ao_to_mo_new(j3ao_new,mo_k) if print_debug: - print_df(j3mo,'D.mo.qp',bielec_int_threshold) + print_df(j3mo_new,'D.mo.qp',bielec_int_threshold) with h5py.File(qph5path,'a') as qph5: - #qph5.create_dataset('mo_two_e_ints/df_mo_integrals_real',data=j3mo.transpose((2,3,1,0)).real) - #qph5.create_dataset('mo_two_e_ints/df_mo_integrals_imag',data=j3mo.transpose((2,3,1,0)).imag) qph5.create_dataset('mo_two_e_ints/df_mo_integrals',data=j3mo_new.view(dtype=np.float64).reshape((nkpt_pairs,naux,nmo,nmo,2))) if (print_ao_ints_bi): From e2802ea5b9004a91c26ba9f16ebb510a3b61b3aa Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:25:08 -0500 Subject: [PATCH 193/256] separate allocation calls for debugging --- .../diagonalization_hs2_dressed.irp.f | 50 ++++++++++++------- 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index d16445cc..9615f72c 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -879,10 +879,11 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i itertot = 0 if (state_following) then - allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), & - y_tmp(N_st_diag*itermax, N_st_diag*itermax)) + allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) + allocate(y_tmp(N_st_diag*itermax, N_st_diag*itermax)) else - allocate(overlap(1,1),y_tmp(1,1)) ! avoid 'if' for deallocate + allocate(overlap(1,1)) + allocate(y_tmp(1,1)) ! avoid 'if' for deallocate endif overlap = 0.d0 y_tmp = (0.d0,0.d0) @@ -1002,24 +1003,37 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) else - allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) + !allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) + allocate(W(sze,N_st_diag*itermax)) + allocate(S(sze,N_st_diag*itermax)) endif - allocate( & - ! Large - U(sze,N_st_diag*itermax), & - S_d(sze,N_st_diag), & + !allocate( & + ! ! Large + ! U(sze,N_st_diag*itermax), & + ! S_d(sze,N_st_diag), & - ! Small - h(N_st_diag*itermax,N_st_diag*itermax), & - h_p(N_st_diag*itermax,N_st_diag*itermax), & - y(N_st_diag*itermax,N_st_diag*itermax), & - s_(N_st_diag*itermax,N_st_diag*itermax), & - s_tmp(N_st_diag*itermax,N_st_diag*itermax), & - residual_norm(N_st_diag), & - s2(N_st_diag*itermax), & - y_s(N_st_diag*itermax,N_st_diag*itermax), & - lambda(N_st_diag*itermax)) + ! ! Small + ! h(N_st_diag*itermax,N_st_diag*itermax), & + ! h_p(N_st_diag*itermax,N_st_diag*itermax), & + ! y(N_st_diag*itermax,N_st_diag*itermax), & + ! s_(N_st_diag*itermax,N_st_diag*itermax), & + ! s_tmp(N_st_diag*itermax,N_st_diag*itermax), & + ! residual_norm(N_st_diag), & + ! s2(N_st_diag*itermax), & + ! y_s(N_st_diag*itermax,N_st_diag*itermax), & + ! lambda(N_st_diag*itermax)) + allocate(U(sze,N_st_diag*itermax)) + allocate(S_d(sze,N_st_diag)) + allocate(h(N_st_diag*itermax,N_st_diag*itermax)) + allocate(h_p(N_st_diag*itermax,N_st_diag*itermax)) + allocate(y(N_st_diag*itermax,N_st_diag*itermax)) + allocate(s_(N_st_diag*itermax,N_st_diag*itermax)) + allocate(s_tmp(N_st_diag*itermax,N_st_diag*itermax)) + allocate(residual_norm(N_st_diag)) + allocate(s2(N_st_diag*itermax)) + allocate(y_s(N_st_diag*itermax,N_st_diag*itermax)) + allocate(lambda(N_st_diag*itermax)) h = (0.d0,0.d0) U = (0.d0,0.d0) From c120ccf523d9ff74b5580658c0c7837a66ea1f21 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:27:32 -0500 Subject: [PATCH 194/256] more error checking --- src/utils/linear_algebra.irp.f | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index 84985a53..778e59c7 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -224,18 +224,34 @@ subroutine ortho_qr_complex(A,LDA,m,n) call zgeqrf( m, n, A, LDA, tau, work, lwork, info ) lwork=int(work(1)) deallocate(work) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 1 + endif allocate(work(lwork)) call zgeqrf(m, n, A, LDA, tau, work, lwork, info ) deallocate(work) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 2 + endif lwork=-1 allocate(work(1)) call zungqr(m, n, n, A, LDA, tau, work, lwork, info) lwork=int(work(1)) deallocate(work) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 3 + endif allocate(work(lwork)) call zungqr(m, n, n, A, LDA, tau, work, lwork, info) deallocate(work,tau) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 4 + endif end subroutine ortho_qr_unblocked_complex(A,LDA,m,n) @@ -260,7 +276,15 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n) allocate(tau(n),work(n)) call zgeqr2(m,n,A,LDA,tau,work,info) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqr2 had an illegal value' + stop 1 + endif call zung2r(m,n,n,A,LDA,tau,work,info) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zung2r had an illegal value' + stop 2 + endif deallocate(work,tau) end From 95294eaf14b3d203485afed95e9ba1e28f8f517e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:29:16 -0500 Subject: [PATCH 195/256] minor fixes in davidson --- src/davidson/diagonalization_hs2_dressed.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 9615f72c..2a7c93d6 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1176,7 +1176,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i do i=1,shift2 s_(i,j) = (0.d0,0.d0) do k=1,sze - s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j)) + s_(i,j) = s_(i,j) + dconjg(U(k,i)) * dcmplx(S(k,j)) enddo enddo enddo @@ -1188,7 +1188,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i !todo: why not size(h,1)? call zgemm('C','N', shift2, shift2, sze, & (1.d0,0.d0), U, size(U,1), W, size(W,1), & - (0.d0,0.d0), h, size(h_p,1)) + (0.d0,0.d0), h, size(h,1)) ! Penalty method ! -------------- From 6c64747bcb115d0b091a137e2901bc8b1c59dd1e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:30:53 -0500 Subject: [PATCH 196/256] fixed attributes --- src/davidson/u0_h_u0.irp.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 6142e828..0f12a8df 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -797,7 +797,9 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) ! istart, iend, ishift, istep are used in ZMQ parallelization. END_DOC integer, intent(in) :: N_st,sze - complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) + complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st) + complex*16, intent(inout) :: u_0(sze,N_st) + !complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) integer :: k complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t From d58bf16961c3d42312e26e4c7c1ba984fa0a6347 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 8 May 2020 16:49:04 -0500 Subject: [PATCH 197/256] twist units in nexus script --- src/utils_complex/generate_pyscf_twists.py | 1 + 1 file changed, 1 insertion(+) diff --git a/src/utils_complex/generate_pyscf_twists.py b/src/utils_complex/generate_pyscf_twists.py index f6f9be95..9b659398 100644 --- a/src/utils_complex/generate_pyscf_twists.py +++ b/src/utils_complex/generate_pyscf_twists.py @@ -174,6 +174,7 @@ for cell_type in cell_types: print (cell_type) print ('===============================') s = diamond.structure.copy() + s.change_units('B') #required for supertwists to be in 1/au instead of 1/Ã… kmap = s.kmap() print ('supercell kpoints/twists') From 11ad53d1b045ed1705e5b17c345960f639c81c9b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 11 May 2020 15:59:27 -0500 Subject: [PATCH 198/256] put complex mo coef back into converter --- src/utils_complex/MolPyscfToQPkpts.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 68c67200..81464d2b 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -696,8 +696,8 @@ def pyscf2QP2(cell,mf, kpts, kmesh=None, cas_idx=None, int_threshold = 1E-8, # k,mo,ao(,2) mo_coef_f = np.array(mo_k.transpose((0,2,1)),order='c',dtype=np.complex128) #mo_coef_blocked=block_diag(*mo_k) - #mo_coef_blocked_f = block_diag(*mo_coef_f) - #qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) + mo_coef_blocked_f = block_diag(*mo_coef_f) + qph5.create_dataset('mo_basis/mo_coef_complex',data=mo_coef_blocked_f.view(dtype=np.float64).reshape((Nk*nmo,Nk*nao,2))) qph5.create_dataset('mo_basis/mo_coef_kpts',data=mo_coef_f.view(dtype=np.float64).reshape((Nk,nmo,nao,2))) if print_debug: From 655af00b9cd5066fd0c0cc5b903e35e065f62453 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 13 May 2020 10:52:57 -0500 Subject: [PATCH 199/256] fixed problem in davidson previously got errors when compiling with -O2 and avx seems to be fixed after removing check for dressing state --- .../diagonalization_hs2_dressed.irp.f | 110 +++++++++--------- 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 2a7c93d6..19ca9c38 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1112,61 +1112,61 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i continue endif - if (dressing_state > 0) then - !todo: implement for complex - print*,irp_here,' not implemented for complex (dressed)' - stop -1 -! -! if (N_st == 1) then -! -! l = dressed_column_idx(1) -! complex*16 :: f -! !todo: check for complex -! f = (1.0d0,0.d0)/psi_coef(l,1) -! do istate=1,N_st_diag -! do i=1,sze -! !todo: conjugate? -! W(i,shift+istate) += dressing_column_h_complex(i,1) *f * U(l,shift+istate) -! W(l,shift+istate) += dressing_column_h_complex(i,1) *f * U(i,shift+istate) -! S(i,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(l,shift+istate)) -! S(l,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(i,shift+istate)) -! enddo -! -! enddo -! -! else -! -! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & -! psi_coef, size(psi_coef,1), & -! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & -! dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), & -! 1.d0, W(1,shift+1), size(W,1)) -! -! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & -! dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), & -! 1.d0, S_d, size(S_d,1)) -! -! -! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & -! dressing_column_h, size(dressing_column_h,1), & -! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & -! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & -! 1.d0, W(1,shift+1), size(W,1)) -! -! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & -! dressing_column_s, size(dressing_column_s,1), & -! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & -! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & -! 1.d0, S_d, size(S_d,1)) -! -! endif - endif +! if (dressing_state > 0) then +! !todo: implement for complex +! print*,irp_here,' not implemented for complex (dressed)' +! stop -1 +!! +!! if (N_st == 1) then +!! +!! l = dressed_column_idx(1) +!! complex*16 :: f +!! !todo: check for complex +!! f = (1.0d0,0.d0)/psi_coef(l,1) +!! do istate=1,N_st_diag +!! do i=1,sze +!! !todo: conjugate? +!! W(i,shift+istate) += dressing_column_h_complex(i,1) *f * U(l,shift+istate) +!! W(l,shift+istate) += dressing_column_h_complex(i,1) *f * U(i,shift+istate) +!! S(i,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(l,shift+istate)) +!! S(l,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(i,shift+istate)) +!! enddo +!! +!! enddo +!! +!! else +!! +!! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +!! psi_coef, size(psi_coef,1), & +!! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +!! +!! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +!! dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), & +!! 1.d0, W(1,shift+1), size(W,1)) +!! +!! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +!! dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), & +!! 1.d0, S_d, size(S_d,1)) +!! +!! +!! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +!! dressing_column_h, size(dressing_column_h,1), & +!! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +!! +!! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +!! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +!! 1.d0, W(1,shift+1), size(W,1)) +!! +!! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +!! dressing_column_s, size(dressing_column_s,1), & +!! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +!! +!! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +!! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +!! 1.d0, S_d, size(S_d,1)) +!! +!! endif +! endif ! Compute s_kl = = ! ------------------------------------------- From 4618e48d3ab3aa7c30db609751a7200e58241b4d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 13 May 2020 10:57:09 -0500 Subject: [PATCH 200/256] add random imaginary part for complex davidson guess --- src/davidson/diagonalization_hs2_dressed.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 19ca9c38..f710be14 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1061,8 +1061,8 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i r1 = dsqrt(-2.d0*dlog(r1)) r2 = dtwo_pi*r2 !todo: real or complex? rescale for complex? sqrt(2)? - u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) - !u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) + !u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) + u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) enddo enddo do k=1,N_st_diag From eb5cb4a32215a130fe39270c1996d3a07bb544ad Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 14 May 2020 13:15:33 -0500 Subject: [PATCH 201/256] Update EZFIO.cfg --- src/nuclei/EZFIO.cfg | 1 + 1 file changed, 1 insertion(+) diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index a700d9b2..8d386c5f 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -48,6 +48,7 @@ default: None doc: Number of k-points type: integer interface: ezfio, provider +default: 1 [kpt_pair_num] doc: Number of k-point pairs From 5f8ed5cadb98028642291e1e6084ddfedb7ceaf1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 14 May 2020 14:22:34 -0500 Subject: [PATCH 202/256] fixed incorrect index --- src/ao_one_e_ints/ao_overlap.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index 9877f882..d972b869 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -481,7 +481,7 @@ BEGIN_PROVIDER [ complex*16, S_half_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num allocate(U(ao_num_per_kpt,ao_num_per_kpt),Vt(ao_num_per_kpt,ao_num_per_kpt),D(ao_num_per_kpt)) do kk=1,kpt_num - call svd_complex(ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1),U,size(U,1),D,Vt,size(Vt,1),ao_num_per_kpt,ao_num_per_kpt) + call svd_complex(ao_overlap_kpts(1,1,kk),size(ao_overlap_kpts,1),U,size(U,1),D,Vt,size(Vt,1),ao_num_per_kpt,ao_num_per_kpt) do i=1,ao_num_per_kpt D(i) = dsqrt(D(i)) From 134de074f365bac7c814c0a659498289e3f63135 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 26 May 2020 15:33:42 -0500 Subject: [PATCH 203/256] fixed types --- src/davidson/diagonalization_hs2_dressed.irp.f | 9 +++++++++ src/davidson/u0_h_u0.irp.f | 11 ++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index f710be14..a94bec2e 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1040,6 +1040,15 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i y = (0.d0,0.d0) s_ = (0.d0,0.d0) s_tmp = (0.d0,0.d0) + W = (0.d0,0.d0) + S = (0.e0,0.e0) + S_d = (0.d0,0.d0) + h_p = (0.d0,0.d0) + residual_norm = 0.d0 + s2 = 0.d0 + y_s = (0.e0,0.e0) + lambda = 0.d0 + ASSERT (N_st > 0) diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 0f12a8df..27d16a1e 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -797,9 +797,9 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze) ! istart, iend, ishift, istep are used in ZMQ parallelization. END_DOC integer, intent(in) :: N_st,sze - complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st) - complex*16, intent(inout) :: u_0(sze,N_st) - !complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) + !complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st) + !complex*16, intent(inout) :: u_0(sze,N_st) + complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) integer :: k complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t @@ -884,7 +884,8 @@ subroutine H_S2_u_0_nstates_openmp_work_complex_$N_int(v_t,s_t,u_t,N_st,sze,ista complex*16, intent(in) :: u_t(N_st,N_det) complex*16, intent(out) :: v_t(N_st,sze), s_t(N_st,sze) - complex*16 :: hij, sij + complex*16 :: hij + double precision :: sij integer :: i,j,k,l,kk integer :: k_a, k_b, l_a, l_b, m_a, m_b integer :: istate @@ -1389,7 +1390,7 @@ compute_singles=.True. double precision, external :: diag_H_mat_elem, diag_S_mat_elem hij = dcmplx(diag_H_mat_elem(tmp_det,$N_int),0.d0) - sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0) + sij = diag_s_mat_elem(tmp_det,$N_int) !DIR$ LOOP COUNT AVG(4) do l=1,N_st v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a) From 9043ec7eaefe9d9143d278e75d9144166c560808 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 28 May 2020 11:37:13 -0500 Subject: [PATCH 204/256] add ocaml interface to nuclei/kpt_num --- src/nuclei/EZFIO.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index 8d386c5f..b4599b72 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -47,7 +47,7 @@ default: None [kpt_num] doc: Number of k-points type: integer -interface: ezfio, provider +interface: ezfio, provider, ocaml default: 1 [kpt_pair_num] From 1ecf741b17d380cf23fd42efc64f6d85e00b26fe Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 28 May 2020 14:44:27 -0500 Subject: [PATCH 205/256] always deinit mo map 2 --- src/mo_two_e_ints/mo_bi_integrals.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index aeef6ff6..0aa5a121 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -1462,9 +1462,9 @@ subroutine clear_mo_map ! Frees the memory of the MO map END_DOC call map_deinit(mo_integrals_map) - if (is_complex) then + !if (is_complex) then call map_deinit(mo_integrals_map_2) - endif + !endif FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map end From ca7321fdc7be1aff98e6ce52ebe9635bbfe29a89 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 28 May 2020 14:55:36 -0500 Subject: [PATCH 206/256] kpt_num interface and deinit map 2 --- src/mo_two_e_ints/mo_bi_integrals.irp.f | 4 ++-- src/nuclei/EZFIO.cfg | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index aeef6ff6..0aa5a121 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -1462,9 +1462,9 @@ subroutine clear_mo_map ! Frees the memory of the MO map END_DOC call map_deinit(mo_integrals_map) - if (is_complex) then + !if (is_complex) then call map_deinit(mo_integrals_map_2) - endif + !endif FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map end diff --git a/src/nuclei/EZFIO.cfg b/src/nuclei/EZFIO.cfg index a700d9b2..b4599b72 100644 --- a/src/nuclei/EZFIO.cfg +++ b/src/nuclei/EZFIO.cfg @@ -47,7 +47,8 @@ default: None [kpt_num] doc: Number of k-points type: integer -interface: ezfio, provider +interface: ezfio, provider, ocaml +default: 1 [kpt_pair_num] doc: Number of k-point pairs From 20eb52b2b0cd2645b17ca63637a435bfe13e9a48 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 28 May 2020 17:57:34 -0500 Subject: [PATCH 207/256] cleanup and add FREE mo_integrals_map_2 --- src/mo_two_e_ints/mo_bi_integrals.irp.f | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index 0aa5a121..21422ba3 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -1462,10 +1462,8 @@ subroutine clear_mo_map ! Frees the memory of the MO map END_DOC call map_deinit(mo_integrals_map) - !if (is_complex) then - call map_deinit(mo_integrals_map_2) - !endif - FREE mo_integrals_map mo_two_e_integrals_jj mo_two_e_integrals_jj_anti + call map_deinit(mo_integrals_map_2) + FREE mo_integrals_map mo_integrals_map_2 mo_two_e_integrals_jj mo_two_e_integrals_jj_anti FREE mo_two_e_integrals_jj_exchange mo_two_e_integrals_in_map end From 1daadf2dcfbd24d6ff7c0e9688aac1741acbb196 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 11:55:33 -0500 Subject: [PATCH 208/256] added gf module; initial commit --- src/green/EZFIO.cfg | 101 ++++ src/green/NEED | 1 + src/green/README.rst | 6 + src/green/green.main.irp.f | 51 ++ src/green/hu0_hp.irp.f | 847 ++++++++++++++++++++++++++ src/green/hu0_lanczos.irp.f | 405 +++++++++++++ src/green/lanczos.irp.f | 882 ++++++++++++++++++++++++++++ src/green/plot-spec-dens.py | 90 +++ src/green/print_dets_test.irp.f | 15 + src/green/print_e_mo_debug.irp.f | 15 + src/green/print_h_debug.irp.f | 178 ++++++ src/green/print_h_omp_debug.irp.f | 41 ++ src/green/print_spectral_dens.irp.f | 43 ++ src/green/utils_hp.irp.f | 614 +++++++++++++++++++ 14 files changed, 3289 insertions(+) create mode 100644 src/green/EZFIO.cfg create mode 100644 src/green/NEED create mode 100644 src/green/README.rst create mode 100644 src/green/green.main.irp.f create mode 100644 src/green/hu0_hp.irp.f create mode 100644 src/green/hu0_lanczos.irp.f create mode 100644 src/green/lanczos.irp.f create mode 100755 src/green/plot-spec-dens.py create mode 100644 src/green/print_dets_test.irp.f create mode 100644 src/green/print_e_mo_debug.irp.f create mode 100644 src/green/print_h_debug.irp.f create mode 100644 src/green/print_h_omp_debug.irp.f create mode 100644 src/green/print_spectral_dens.irp.f create mode 100644 src/green/utils_hp.irp.f diff --git a/src/green/EZFIO.cfg b/src/green/EZFIO.cfg new file mode 100644 index 00000000..859a3eb9 --- /dev/null +++ b/src/green/EZFIO.cfg @@ -0,0 +1,101 @@ +[n_lanczos_complete] +type: integer +doc: number of lanczos iterations completed +interface: ezfio,provider,ocaml +default: 0 + +[n_lanczos_iter] +type: integer +doc: number of lanczos iterations +interface: ezfio,provider,ocaml +default: 10 + +[omega_min] +type: double precision +doc: lower limit of frequency for spectral density calculation +interface: ezfio,provider,ocaml +default: -2.e-1 + +[omega_max] +type: double precision +doc: upper limit of frequency for spectral density calculation +interface: ezfio,provider,ocaml +default: 1.2e1 + +[n_omega] +type: integer +doc: number of points for spectral density calculation +interface: ezfio,provider,ocaml +default: 1000 + +[gf_epsilon] +type: double precision +doc: infinitesimal imaginary frequency term in Green's function +interface: ezfio,provider,ocaml +default: 1.e-2 + +[n_green_vec] +type: integer +doc: number of holes/particles +interface: ezfio +default: 2 + +[green_idx] +interface: ezfio +doc: homo/lumo indices +type: integer +size: (green.n_green_vec) + +[green_spin] +interface: ezfio +doc: homo/lumo spin +type: integer +size: (green.n_green_vec) + +[green_sign] +interface: ezfio +doc: homo/lumo sign +type: double precision +size: (green.n_green_vec) + +[alpha_lanczos] +interface: ezfio +doc: lanczos alpha values +type: double precision +size: (green.n_lanczos_iter,green.n_green_vec) + +[beta_lanczos] +interface: ezfio +doc: lanczos beta values +type: double precision +size: (green.n_lanczos_iter,green.n_green_vec) + +[un_lanczos] +interface: ezfio +doc: saved lanczos u vector +type: complex*16 +size: (determinants.n_det,green.n_green_vec) + +[vn_lanczos] +interface: ezfio +doc: saved lanczos v vector +type: complex*16 +size: (determinants.n_det,green.n_green_vec) + +[lanczos_eigvals] +interface: ezfio +doc: eigvals of tridiagonal form of H +type: double precision +size: (green.n_lanczos_iter,green.n_green_vec) + +[lanczos_debug_print] +interface: ezfio,provider,ocaml +type: logical +doc: printing of lanczos vectors at every step +default: False + +[n_lanczos_debug] +interface: ezfio,provider,ocaml +type: integer +doc: number of elements to print +default: 10 diff --git a/src/green/NEED b/src/green/NEED new file mode 100644 index 00000000..4315d882 --- /dev/null +++ b/src/green/NEED @@ -0,0 +1 @@ +davidson fci diff --git a/src/green/README.rst b/src/green/README.rst new file mode 100644 index 00000000..6bdb2ca7 --- /dev/null +++ b/src/green/README.rst @@ -0,0 +1,6 @@ +===== +dummy +===== + +Module necessary to avoid the ``xxx is a root module but does not contain a main file`` message. + diff --git a/src/green/green.main.irp.f b/src/green/green.main.irp.f new file mode 100644 index 00000000..c9b3ef66 --- /dev/null +++ b/src/green/green.main.irp.f @@ -0,0 +1,51 @@ +program green + implicit none + BEGIN_DOC +! TODO + END_DOC + read_wf = .True. + touch read_wf + provide n_green_vec + print*,'ref_bitmask_energy = ',ref_bitmask_energy +! call psicoefprinttest + call print_lanczos_eigvals + call print_spec +end + +subroutine psicoefprinttest + implicit none + integer :: i + TOUCH psi_coef + print *, 'printing ndet', N_det +end +subroutine print_lanczos_eigvals + implicit none + integer :: i, iunit, j + integer :: getunitandopen + character(5) :: jstr + + do j=1,n_green_vec + write(jstr,'(I0.3)') j + iunit = getunitandopen('lanczos_eigval_alpha_beta.out.'//trim(jstr),'w') + print *, 'printing lanczos eigenvalues, alpha, beta to "lanczos_eigval_alpha_beta.out.'//trim(jstr)//'"' + do i=1,n_lanczos_iter + write(iunit,'(I6,3(E25.15))') i, lanczos_eigvals(i,j), alpha_lanczos(i,j), beta_lanczos(i,j) + enddo + close(iunit) + enddo +end +subroutine print_spec + implicit none + integer :: i, iunit, j + integer :: getunitandopen + character(5) :: jstr + do j=1,n_green_vec + write(jstr,'(I0.3)') j + iunit = getunitandopen('omega_A.out.'//trim(jstr),'w') + print *, 'printing frequency, spectral density to "omega_A.out.'//trim(jstr)//'"' + do i=1,n_omega + write(iunit,'(2(E25.15))') omega_list(i), spectral_lanczos(i,j) + enddo + close(iunit) + enddo +end diff --git a/src/green/hu0_hp.irp.f b/src/green/hu0_hp.irp.f new file mode 100644 index 00000000..c3d8be40 --- /dev/null +++ b/src/green/hu0_hp.irp.f @@ -0,0 +1,847 @@ +! modified from H_S2_u_0_nstates_openmp in Davidson/u0Hu0.irp.f + +subroutine h_u_0_hp_openmp(v_0,u_0,N_hp,sze,spin_hp,sign_hp,idx_hp) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_0 = H|u_0> + ! + ! Assumes that the determinants are in psi_det + ! + ! istart, iend, ishift, istep are used in ZMQ parallelization. + ! + ! N_hp is number of holes and particles to be applied + ! each element of spin_hp is either 1(alpha) or 2(beta) + ! each element of sign_hp is either 1(particle) or -1(hole) + ! idx_hp contains orbital indices for holes and particles + END_DOC + integer, intent(in) :: N_hp,sze + complex*16, intent(inout) :: v_0(sze,N_hp), u_0(sze,N_hp) + integer :: k + complex*16, allocatable :: u_t(:,:), v_t(:,:) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t + allocate(u_t(N_hp,N_det),v_t(N_hp,N_det)) + do k=1,N_hp + call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) + enddo + v_t = (0.d0,0.d0) + call cdtranspose( & + u_0, & + size(u_0, 1), & + u_t, & + size(u_t, 1), & + N_det, N_hp) + + call h_u_0_hp_openmp_work(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,1,N_det,0,1) + deallocate(u_t) + + call cdtranspose( & + v_t, & + size(v_t, 1), & + v_0, & + size(v_0, 1), & + N_hp, N_det) + deallocate(v_t) + + do k=1,N_hp + call cdset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + call cdset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det) + enddo + +end + + +subroutine h_u_0_hp_openmp_work(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_t = H|u_t> + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer, intent(in) :: N_hp,sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_hp,N_det) + complex*16, intent(out) :: v_t(N_hp,sze) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + + + PROVIDE ref_bitmask_energy N_int + + select case (N_int) + case (1) + call H_u_0_hp_openmp_work_1(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + case (2) + call H_u_0_hp_openmp_work_2(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + case (3) + call H_u_0_hp_openmp_work_3(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + case (4) + call H_u_0_hp_openmp_work_4(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + case default + call H_u_0_hp_openmp_work_N_int(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + end select +end +BEGIN_TEMPLATE + +subroutine h_u_0_hp_openmp_work_$N_int(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_t = H|u_t> and s_t = S^2 |u_t> + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer, intent(in) :: N_hp,sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_hp,N_det) + complex*16, intent(out) :: v_t(N_hp,sze) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + + complex*16 :: hij + double precision :: hii + integer :: i,j,k,l + integer :: k_a, k_b, l_a, l_b, m_a, m_b + integer :: istate + integer :: krow, kcol, krow_b, kcol_b + integer :: lrow, lcol + integer :: mrow, mcol + integer(bit_kind) :: spindet($N_int) + integer(bit_kind) :: tmp_det($N_int,2) + integer(bit_kind) :: tmp_det2($N_int,2) + integer(bit_kind) :: tmp_det3($N_int,2) + integer(bit_kind), allocatable :: buffer(:,:) + integer :: n_doubles + integer, allocatable :: doubles(:) + integer, allocatable :: singles_a(:) + integer, allocatable :: singles_b(:) + integer, allocatable :: idx(:), idx0(:) + integer :: maxab, n_singles_a, n_singles_b, kcol_prev + integer*8 :: k8 + + logical, allocatable :: exc_is_banned_a1(:),exc_is_banned_b1(:),exc_is_banned_a2(:),exc_is_banned_b2(:) + logical, allocatable :: exc_is_banned_ab1(:),exc_is_banned_ab12(:),allowed_hp(:) + logical :: all_banned_a1,all_banned_b1,all_banned_a2,all_banned_b2 + logical :: all_banned_ab12,all_banned_ab1 + integer :: ii,na,nb + double precision, allocatable :: hii_hp(:) + complex*16, allocatable :: hij_hp(:) + + maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + allocate(idx0(maxab)) + + do i=1,maxab + idx0(i) = i + enddo + + ! Prepare the array of all alpha single excitations + ! ------------------------------------------------- + + PROVIDE N_int nthreads_davidson elec_num + !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthreads_davidson) & + !$OMP SHARED(psi_bilinear_matrix_rows, N_det, & + !$OMP psi_bilinear_matrix_columns, & + !$OMP psi_det_alpha_unique, psi_det_beta_unique, & + !$OMP n_det_alpha_unique, n_det_beta_unique, N_int, & + !$OMP psi_bilinear_matrix_transp_rows, & + !$OMP psi_bilinear_matrix_transp_columns, & + !$OMP psi_bilinear_matrix_transp_order, N_hp, & + !$OMP psi_bilinear_matrix_order_transp_reverse, & + !$OMP psi_bilinear_matrix_columns_loc, & + !$OMP psi_bilinear_matrix_transp_rows_loc, & + !$OMP istart, iend, istep, irp_here, v_t, & + !$OMP spin_hp,sign_hp,idx_hp, & + !$OMP elec_num_tab,nuclear_repulsion, & + !$OMP ishift, idx0, u_t, maxab) & + !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & + !$OMP lcol, lrow, l_a, l_b, & + !$OMP buffer, doubles, n_doubles, & + !$OMP tmp_det2, hii, hij, idx, l, kcol_prev, & + !$OMP singles_a, n_singles_a, singles_b, & + !$OMP exc_is_banned_a1,exc_is_banned_b1,exc_is_banned_ab1, & + !$OMP exc_is_banned_a2,exc_is_banned_b2,exc_is_banned_ab12, & + !$OMP all_banned_a1,all_banned_b1,all_banned_ab1, & + !$OMP all_banned_a2,all_banned_b2,all_banned_ab12, & + !$OMP allowed_hp, & + !$OMP ii, hij_hp, j, hii_hp,na,nb, & + !$OMP n_singles_b, k8) + + ! Alpha/Beta double excitations + ! ============================= + + allocate( buffer($N_int,maxab), & + singles_a(maxab), & + singles_b(maxab), & + doubles(maxab), & + idx(maxab), & + exc_is_banned_a1(N_hp), & + exc_is_banned_b1(N_hp), & + exc_is_banned_a2(N_hp), & + exc_is_banned_b2(N_hp), & + exc_is_banned_ab1(N_hp), & + exc_is_banned_ab12(N_hp), & + allowed_hp(N_hp), & + hij_hp(N_hp), & + hii_hp(N_hp)) + + kcol_prev=-1 + all_banned_b1=.False. + ASSERT (iend <= N_det) + ASSERT (istart > 0) + ASSERT (istep > 0) + + !$OMP DO SCHEDULE(dynamic,64) + do k_a=istart+ishift,iend,istep + ! iterate over dets in psi + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + if (kcol /= kcol_prev) then !if we've moved to a new unique beta determinant + call get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned_b1,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b1) + if (all_banned_b1) then + kcol_prev = kcol + cycle + else ! get all unique beta dets connected to this one by a single excitation + call get_all_spin_singles_$N_int( & + psi_det_beta_unique, idx0, & + tmp_det(1,2), N_det_beta_unique, & + singles_b, n_singles_b) + kcol_prev = kcol + endif + else + if (all_banned_b1) cycle + endif + + ! at least some beta allowed + ! check alpha + call get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned_a1,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a1) + if (all_banned_a1) cycle + + all_banned_ab1=.True. + do ii=1,N_hp + exc_is_banned_ab1(ii)=(exc_is_banned_a1(ii).or.exc_is_banned_b1(ii)) + all_banned_ab1 = (all_banned_ab1.and.exc_is_banned_ab1(ii)) + enddo + if (all_banned_ab1) cycle +! kcol_prev = kcol ! keep track of old col to see when we've moved to a new one + + ! Loop over singly excited beta columns + ! ------------------------------------- + + do i=1,n_singles_b ! loop over other columns in this row + lcol = singles_b(i) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol) + + call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) + if (all_banned_b2) cycle + + l_a = psi_bilinear_matrix_columns_loc(lcol) ! location of start of this column within psi_bilinear_mat + ASSERT (l_a <= N_det) + + do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - l_a ! loop over rows in this column + lrow = psi_bilinear_matrix_rows(l_a) ! get row (index of unique alpha det) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! get alpha det + + ASSERT (l_a <= N_det) + idx(j) = l_a ! indices of dets within psi_bilinear_mat + l_a = l_a+1 + enddo + j = j-1 + ! get all alpha dets in this column that are connected to ref alpha by a single exc. + call get_all_spin_singles_$N_int( & + buffer, idx, tmp_det(1,1), j, & + singles_a, n_singles_a ) + + ! Loop over alpha singles + ! ----------------------- + + do k = 1,n_singles_a + l_a = singles_a(k) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) + if (all_banned_a2) cycle + all_banned_ab12 = .True. + do ii=1,N_hp + exc_is_banned_ab12(ii)=((exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)).or.exc_is_banned_a2(ii)) + allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) + all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) + enddo + if (all_banned_ab12) cycle + call i_h_j_double_alpha_beta_hp(tmp_det,tmp_det2,$N_int,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + do l=1,N_hp + v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) + enddo + enddo + enddo + enddo + !$OMP END DO + + !$OMP DO SCHEDULE(dynamic,64) + do k_a=istart+ishift,iend,istep + + + ! Single and double alpha excitations + ! =================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) + if (all_banned_ab1) cycle + + + ! Initial determinant is at k_b in beta-major representation + ! ---------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + spindet(1:$N_int) = tmp_det(1:$N_int,1) + + ! Loop inside the beta column to gather all the connected alphas + lcol = psi_bilinear_matrix_columns(k_a) + l_a = psi_bilinear_matrix_columns_loc(lcol) + do i=1,N_det_alpha_unique + if (l_a > N_det) exit + lcol = psi_bilinear_matrix_columns(l_a) + if (lcol /= kcol) exit + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) + idx(i) = l_a + l_a = l_a+1 + enddo + i = i-1 + + !call get_all_spin_singles_and_doubles_$N_int( & + ! buffer, idx, spindet, i, & + ! singles_a, doubles, n_singles_a, n_doubles ) + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, $N_int, i, & + singles_a, doubles, n_singles_a, n_doubles ) + + ! Compute Hij for all alpha singles + ! ---------------------------------- + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + do i=1,n_singles_a + l_a = singles_a(i) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) + if (all_banned_a2) cycle + all_banned_ab12 = .True. + do ii=1,N_hp + exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_a2(ii)) + allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) + all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) + enddo + if (all_banned_ab12) cycle + call i_h_j_mono_spin_hp(tmp_det,tmp_det2,$N_int,1, hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + + do l=1,N_hp + v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) + ! single => sij = 0 + enddo + enddo + + ! Compute Hij for all alpha doubles + ! ---------------------------------- + + do i=1,n_doubles + l_a = doubles(i) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + call get_list_hp_banned_single_spin(psi_det_alpha_unique(1,lrow),N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) + if (all_banned_a2) cycle + all_banned_ab12 = .True. + do ii=1,N_hp + exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_a2(ii)) + allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) + all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) + enddo + if (all_banned_ab12) cycle + call i_h_j_double_spin_hp( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int,1,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + do l=1,N_hp + v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) + ! same spin => sij = 0 + enddo + enddo + + + ! Single and double beta excitations + ! ================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + kcol = psi_bilinear_matrix_columns(k_a) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + !! should already be done from top of loop? + !call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) + !if (all_banned_ab1) cycle + + spindet(1:$N_int) = tmp_det(1:$N_int,2) + + ! Initial determinant is at k_b in beta-major representation + ! ----------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + ! Loop inside the alpha row to gather all the connected betas + lrow = psi_bilinear_matrix_transp_rows(k_b) + l_b = psi_bilinear_matrix_transp_rows_loc(lrow) + do i=1,N_det_beta_unique + if (l_b > N_det) exit + lrow = psi_bilinear_matrix_transp_rows(l_b) + if (lrow /= krow) exit + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol) + idx(i) = l_b + l_b = l_b+1 + enddo + i = i-1 + + !call get_all_spin_singles_and_doubles_$N_int( & + ! buffer, idx, spindet, i, & + ! singles_b, doubles, n_singles_b, n_doubles ) + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, $N_int, i, & + singles_b, doubles, n_singles_b, n_doubles ) + + ! Compute Hij for all beta singles + ! ---------------------------------- + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + do i=1,n_singles_b + l_b = singles_b(i) + ASSERT (l_b <= N_det) + + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) + call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) + if (all_banned_b2) cycle + all_banned_ab12 = .True. + do ii=1,N_hp + exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)) + allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) + all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) + enddo + if (all_banned_ab12) cycle + call i_h_j_mono_spin_hp(tmp_det,tmp_det2,$N_int,2, hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + do l=1,N_hp + v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) + ! single => sij = 0 + enddo + enddo + + ! Compute Hij for all beta doubles + ! ---------------------------------- + + do i=1,n_doubles + l_b = doubles(i) + ASSERT (l_b <= N_det) + + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + call get_list_hp_banned_single_spin(psi_det_beta_unique(1,lcol),N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) + if (all_banned_b2) cycle + all_banned_ab12 = .True. + do ii=1,N_hp + exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)) + allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) + all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) + enddo + if (all_banned_ab12) cycle + call i_h_j_double_spin_hp( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int,2,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + + do l=1,N_hp + v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) + ! same spin => sij = 0 + enddo + enddo + + + ! Diagonal contribution + ! ===================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) + if (all_banned_ab1) cycle + + double precision, external :: diag_H_mat_elem, diag_S_mat_elem + hii = diag_h_mat_elem(tmp_det,$N_int) + + do ii=1,N_hp + if(exc_is_banned_ab1(ii)) then + hii_hp(ii)=0.d0 + else + tmp_det2=tmp_det + na=elec_num_tab(spin_hp(ii)) + nb=elec_num_tab(iand(spin_hp(ii),1)+1) + hii_hp(ii)=hii + if (sign_hp(ii)>0) then + call ac_operator(idx_hp(ii),spin_hp(ii),tmp_det2,hii_hp(ii),$N_int,na,nb) + else + call a_operator(idx_hp(ii),spin_hp(ii),tmp_det2,hii_hp(ii),$N_int,na,nb) + endif + endif + v_t(ii,k_a) = v_t(ii,k_a) + (nuclear_repulsion + hii_hp(ii)) * u_t(ii,k_a) + enddo + + + end do + !$OMP END DO + deallocate(buffer, singles_a, singles_b, doubles, idx, & + exc_is_banned_a1, & + exc_is_banned_b1, & + exc_is_banned_a2, & + exc_is_banned_b2, & + exc_is_banned_ab1, & + exc_is_banned_ab12, & + allowed_hp, & + hij_hp, hii_hp ) + !$OMP END PARALLEL + deallocate(idx0) +end + +SUBST [ N_int ] + +1;; +2;; +3;; +4;; +N_int;; + +END_TEMPLATE + + + +subroutine i_h_j_double_spin_hp(key_i,key_j,Nint,ispin,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + use bitmasks + implicit none + BEGIN_DOC + ! todo: maybe make new get_double_excitation_spin? + ! the 4 index ordering is already done in there, so we could avoid duplicating that work + ! Returns where i and j are determinants differing by a same-spin double excitation + END_DOC + integer, intent(in) :: Nint,ispin,N_hp + integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint) + complex*16, intent(out) :: hij_hp(N_hp) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + logical, intent(in) :: allowed_hp(N_hp) + complex*16 :: hij0 + double precision :: phase_hp(N_hp) + integer :: exc(0:2,2) + double precision :: phase + complex*16, external :: get_mo_bielec_integral + integer :: i1,i2,i3,i4,j2,j3,ii + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) + hij0 = phase*(get_mo_bielec_integral( & + exc(1,1), & + exc(2,1), & + exc(1,2), & + exc(2,2), mo_integrals_map) - & + get_mo_bielec_integral( & + exc(1,1), & + exc(2,1), & + exc(2,2), & + exc(1,2), mo_integrals_map) ) + + ASSERT (exc(1,1) < exc(2,1)) + ASSERT (exc(1,2) < exc(2,2)) + i1=min(exc(1,1),exc(1,2)) + j2=max(exc(1,1),exc(1,2)) + j3=min(exc(2,1),exc(2,2)) + i4=max(exc(2,1),exc(2,2)) + i2=min(j2,j3) + i3=max(j2,j3) + + do ii=1,N_hp + if (allowed_hp(ii)) then + if (ispin.eq.spin_hp(ii)) then + if ((idx_hp(ii).lt.i1).or.(idx_hp(ii).gt.i4)) then + phase_hp(ii)=1.d0 + else if ((idx_hp(ii).lt.i2).or.(idx_hp(ii).gt.i3)) then + phase_hp(ii)=-1.d0 + else + phase_hp(ii)=1.d0 + endif + else + phase_hp(ii)=1.d0 + endif + else + phase_hp(ii)=0.d0 + endif + hij_hp(ii) = hij0 * phase_hp(ii) + enddo +end + +subroutine i_h_j_mono_spin_hp(key_i,key_j,Nint,spin,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + use bitmasks + implicit none + BEGIN_DOC + ! todo: change this to use normal version of get_mono_excitation_from_fock + ! all info needed is in phase and hij, h/p part can happen after getting hij the normal way + ! Returns where i and j are determinants differing by a single excitation + END_DOC + integer, intent(in) :: Nint, spin, N_hp + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij_hp(N_hp) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + logical, intent(in) :: allowed_hp(N_hp) + !double precision :: phase_hp(N_hp) + complex*16 :: hij0 + + integer :: exc(0:2,2) + double precision :: phase + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + + call get_mono_excitation_from_fock_hp(key_i,key_j,exc(1,1),exc(1,2),spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) +end + +subroutine get_mono_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + use bitmasks + implicit none + integer,intent(in) :: h,p,spin,N_hp + double precision, intent(in) :: phase + integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) + complex*16, intent(out) :: hij_hp(N_hp) + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + logical, intent(in) :: allowed_hp(N_hp) + double precision :: phase_hp(N_hp) + complex*16 :: hij0 + integer :: low,high + + integer(bit_kind) :: differences(N_int,2) + integer(bit_kind) :: hole(N_int,2) + integer(bit_kind) :: partcl(N_int,2) + integer :: occ_hole(N_int*bit_kind_size,2) + integer :: occ_partcl(N_int*bit_kind_size,2) + integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) + integer :: i0,i,ii + do i = 1, N_int + differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) + differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) + hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) + hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) + partcl(i,1) = iand(differences(i,1),det_1(i,1)) + partcl(i,2) = iand(differences(i,2),det_1(i,2)) + enddo + call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) + call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) + hij0 = fock_operator_closed_shell_ref_bitmask(h,p) + ! holes :: direct terms + do i0 = 1, n_occ_ab_hole(1) + i = occ_hole(i0,1) + hij0 -= big_array_coulomb_integrals(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + do i0 = 1, n_occ_ab_hole(2) + i = occ_hole(i0,2) + hij0 -= big_array_coulomb_integrals(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + + ! holes :: exchange terms + do i0 = 1, n_occ_ab_hole(spin) + i = occ_hole(i0,spin) + hij0 += big_array_exchange_integrals(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) + enddo + + ! particles :: direct terms + do i0 = 1, n_occ_ab_partcl(1) + i = occ_partcl(i0,1) + hij0 += big_array_coulomb_integrals(i,h,p)!get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + do i0 = 1, n_occ_ab_partcl(2) + i = occ_partcl(i0,2) + hij0 += big_array_coulomb_integrals(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + enddo + + ! particles :: exchange terms + do i0 = 1, n_occ_ab_partcl(spin) + i = occ_partcl(i0,spin) + hij0 -= big_array_exchange_integrals(i,h,p)!get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) + enddo + + low=min(h,p) + high=max(h,p) + +!! do ii=1,N_hp +!! if (.not.allowed_hp(ii)) then +!! phase_hp(ii) = 0.d0 +!! cycle +!! else if (spin_hp(ii).ne.spin) then +!! phase_hp(ii) = 1.d0 +!! else +!! if ((low.lt.idx_hp(ii)).and.(high.gt.idx_hp(ii))) then +!! phase_hp(ii) = -1.d0 +!! else +!! phase_hp(ii) = 1.d0 +!! endif +!! endif +!! enddo +!! +!! do ii=1,N_hp +!! if (allowed_hp(ii)) then +!! hij_hp(ii) = hij + sign_hp(ii) * big_array_coulomb_integrals(idx_hp(ii),h,p) +!! if (spin.eq.spin_hp(ii)) then +!! hij_hp(ii) = hij_hp(ii) - sign_hp(ii) * big_array_exchange_integrals(idx_hp(ii),h,p) +!! endif +!! else +!! hij_hp(ii) = 0.d0 +!! endif +!! enddo +!! +!! do ii=1,N_hp +!! hij_hp(ii) = hij_hp(ii) * phase_hp(ii) * phase +!! enddo + + do ii=1,N_hp + if (.not.allowed_hp(ii)) then + phase_hp(ii) = 0.d0 + hij_hp(ii) = 0.d0 + cycle + else if (spin.eq.spin_hp(ii)) then + hij_hp(ii) = hij0 + sign_hp(ii) *(big_array_coulomb_integrals(idx_hp(ii),h,p) - big_array_exchange_integrals(idx_hp(ii),h,p)) + if ((low.lt.idx_hp(ii)).and.(high.gt.idx_hp(ii))) then + phase_hp(ii) = -1.d0 + else + phase_hp(ii) = 1.d0 + endif + else + phase_hp(ii) = 1.d0 + hij_hp(ii) = hij0 + sign_hp(ii) * big_array_coulomb_integrals(idx_hp(ii),h,p) + endif + hij_hp(ii) = hij_hp(ii) * phase * phase_hp(ii) + enddo + +end + + +subroutine i_H_j_double_alpha_beta_hp(key_i,key_j,Nint,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + use bitmasks + implicit none + BEGIN_DOC + ! Returns where i and j are determinants differing by an opposite-spin double excitation + END_DOC + integer, intent(in) :: Nint,N_hp + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + complex*16, intent(out) :: hij_hp(N_hp) + complex*16 :: hij0 + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + logical, intent(in) :: allowed_hp(N_hp) + double precision :: phase_hp(N_hp) + integer :: i + + integer :: lowhigh(2,2) + integer :: exc(0:2,2,2) + double precision :: phase, phase2 + complex*16, external :: get_mo_bielec_integral + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_mono_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) + call get_mono_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) + phase = phase*phase2 + + if (exc(1,1,1) == exc(1,2,2)) then + hij0 = big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) == exc(1,1,2)) then + hij0 = big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij0 = get_mo_bielec_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif + + !todo: clean this up + ! if new particle/hole is between p/h of single exc of same spin, then parity changes, otherwise stays the same + ! value of Hij for double excitation is unchanged (new p/h is not one of the indices involved in the excitation) + + lowhigh(1,1)=min(exc(1,1,1),exc(1,2,1)) + lowhigh(2,1)=max(exc(1,1,1),exc(1,2,1)) + lowhigh(1,2)=min(exc(1,1,2),exc(1,2,2)) + lowhigh(2,2)=max(exc(1,1,2),exc(1,2,2)) + do i=1,N_hp + if (.not.allowed_hp(i)) then + phase_hp(i)=0.d0 + else if ((idx_hp(i).gt.lowhigh(1,spin_hp(i))).and.(idx_hp(i).lt.lowhigh(2,spin_hp(i)))) then + phase_hp(i)=-1.d0 + else + phase_hp(i)=1.d0 + endif + hij_hp(i)=hij0*phase*phase_hp(i) + enddo +end diff --git a/src/green/hu0_lanczos.irp.f b/src/green/hu0_lanczos.irp.f new file mode 100644 index 00000000..e4da5c78 --- /dev/null +++ b/src/green/hu0_lanczos.irp.f @@ -0,0 +1,405 @@ +! modified from H_S2_u_0_nstates_openmp in Davidson/u0Hu0.irp.f + +subroutine H_u_0_openmp(v_0,u_0,sze) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_0 = H|u_0> + ! + ! Assumes that the determinants are in psi_det + ! + ! istart, iend, ishift, istep are used in ZMQ parallelization. + END_DOC + integer :: N_st=1 + integer, intent(in) :: sze + complex*16, intent(inout) :: v_0(sze), u_0(sze) + integer :: k + call cdset_order(u_0(1),psi_bilinear_matrix_order,N_det) + v_0 = (0.d0,0.d0) + + call h_u_0_openmp_work(v_0,u_0,sze,1,N_det,0,1) + + call cdset_order(v_0(1),psi_bilinear_matrix_order_reverse,N_det) + call cdset_order(u_0(1),psi_bilinear_matrix_order_reverse,N_det) + +end + + +subroutine H_u_0_openmp_work(v_t,u_t,sze,istart,iend,ishift,istep) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_t = H|u_t> + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer :: N_st=1 + integer, intent(in) :: sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_det) + complex*16, intent(out) :: v_t(sze) + + + PROVIDE ref_bitmask_energy N_int + + select case (N_int) + case (1) + call H_u_0_openmp_work_1(v_t,u_t,sze,istart,iend,ishift,istep) + case (2) + call H_u_0_openmp_work_2(v_t,u_t,sze,istart,iend,ishift,istep) + case (3) + call H_u_0_openmp_work_3(v_t,u_t,sze,istart,iend,ishift,istep) + case (4) + call H_u_0_openmp_work_4(v_t,u_t,sze,istart,iend,ishift,istep) + case default + call H_u_0_openmp_work_N_int(v_t,u_t,sze,istart,iend,ishift,istep) + end select +end +BEGIN_TEMPLATE + +subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_t = H|u_t> + ! + ! Default should be 1,N_det,0,1 + END_DOC + integer :: N_st=1 + integer, intent(in) :: sze,istart,iend,ishift,istep + complex*16, intent(in) :: u_t(N_det) + complex*16, intent(out) :: v_t(sze) + + complex*16 :: hij + double precision :: hii + integer :: i,j,k,l + integer :: k_a, k_b, l_a, l_b, m_a, m_b + integer :: istate + integer :: krow, kcol, krow_b, kcol_b + integer :: lrow, lcol + integer :: mrow, mcol + integer(bit_kind) :: spindet($N_int) + integer(bit_kind) :: tmp_det($N_int,2) + integer(bit_kind) :: tmp_det2($N_int,2) + integer(bit_kind) :: tmp_det3($N_int,2) + integer(bit_kind), allocatable :: buffer(:,:) + integer :: n_doubles + integer, allocatable :: doubles(:) + integer, allocatable :: singles_a(:) + integer, allocatable :: singles_b(:) + integer, allocatable :: idx(:), idx0(:) + integer :: maxab, n_singles_a, n_singles_b, kcol_prev + integer*8 :: k8 + + maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + allocate(idx0(maxab)) + + do i=1,maxab + idx0(i) = i + enddo + + ! Prepare the array of all alpha single excitations + ! ------------------------------------------------- + + PROVIDE N_int nthreads_davidson + !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthreads_davidson) & + !$OMP SHARED(psi_bilinear_matrix_rows, N_det, & + !$OMP psi_bilinear_matrix_columns, & + !$OMP psi_det_alpha_unique, psi_det_beta_unique, & + !$OMP n_det_alpha_unique, n_det_beta_unique, N_int, & + !$OMP psi_bilinear_matrix_transp_rows, & + !$OMP psi_bilinear_matrix_transp_columns, & + !$OMP psi_bilinear_matrix_transp_order, N_st, & + !$OMP psi_bilinear_matrix_order_transp_reverse, & + !$OMP psi_bilinear_matrix_columns_loc, & + !$OMP psi_bilinear_matrix_transp_rows_loc, & + !$OMP istart, iend, istep, irp_here, v_t, & + !$OMP ishift, idx0, u_t, maxab) & + !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & + !$OMP lcol, lrow, l_a, l_b, & + !$OMP buffer, doubles, n_doubles, & + !$OMP tmp_det2, hii, hij, idx, l, kcol_prev, & + !$OMP singles_a, n_singles_a, singles_b, & + !$OMP n_singles_b, k8) + + ! Alpha/Beta double excitations + ! ============================= + + allocate( buffer($N_int,maxab), & + singles_a(maxab), & + singles_b(maxab), & + doubles(maxab), & + idx(maxab)) + + kcol_prev=-1 + + ASSERT (iend <= N_det) + ASSERT (istart > 0) + ASSERT (istep > 0) + + !$OMP DO SCHEDULE(dynamic,64) + do k_a=istart+ishift,iend,istep + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + if (kcol /= kcol_prev) then + call get_all_spin_singles_$N_int( & + psi_det_beta_unique, idx0, & + tmp_det(1,2), N_det_beta_unique, & + singles_b, n_singles_b) + endif + kcol_prev = kcol + + ! Loop over singly excited beta columns + ! ------------------------------------- + + do i=1,n_singles_b + lcol = singles_b(i) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol) + + l_a = psi_bilinear_matrix_columns_loc(lcol) + ASSERT (l_a <= N_det) + + do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - l_a + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) + + ASSERT (l_a <= N_det) + idx(j) = l_a + l_a = l_a+1 + enddo + j = j-1 + + call get_all_spin_singles_$N_int( & + buffer, idx, tmp_det(1,1), j, & + singles_a, n_singles_a ) + + ! Loop over alpha singles + ! ----------------------- + + do k = 1,n_singles_a + l_a = singles_a(k) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call i_h_j_double_alpha_beta(tmp_det,tmp_det2,$N_int,hij) + v_t(k_a) = v_t(k_a) + hij * u_t(l_a) + enddo + enddo + enddo + !$OMP END DO + + !$OMP DO SCHEDULE(dynamic,64) + do k_a=istart+ishift,iend,istep + + + ! Single and double alpha excitations + ! =================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + ! Initial determinant is at k_b in beta-major representation + ! ---------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + spindet(1:$N_int) = tmp_det(1:$N_int,1) + + ! Loop inside the beta column to gather all the connected alphas + lcol = psi_bilinear_matrix_columns(k_a) + l_a = psi_bilinear_matrix_columns_loc(lcol) + do i=1,N_det_alpha_unique + if (l_a > N_det) exit + lcol = psi_bilinear_matrix_columns(l_a) + if (lcol /= kcol) exit + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) + idx(i) = l_a + l_a = l_a+1 + enddo + i = i-1 + + !call get_all_spin_singles_and_doubles_$N_int( & + ! buffer, idx, spindet, i, & + ! singles_a, doubles, n_singles_a, n_doubles ) + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, $N_int, i, & + singles_a, doubles, n_singles_a, n_doubles ) + + ! Compute Hij for all alpha singles + ! ---------------------------------- + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + do i=1,n_singles_a + l_a = singles_a(i) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 1, hij) + + v_t(k_a) = v_t(k_a) + hij * u_t(l_a) + enddo + + + ! Compute Hij for all alpha doubles + ! ---------------------------------- + + do i=1,n_doubles + l_a = doubles(i) + ASSERT (l_a <= N_det) + + lrow = psi_bilinear_matrix_rows(l_a) + ASSERT (lrow <= N_det_alpha_unique) + + call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) + v_t(k_a) = v_t(k_a) + hij * u_t(l_a) + enddo + + + ! Single and double beta excitations + ! ================================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + kcol = psi_bilinear_matrix_columns(k_a) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + spindet(1:$N_int) = tmp_det(1:$N_int,2) + + ! Initial determinant is at k_b in beta-major representation + ! ----------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_transp_reverse(k_a) + ASSERT (k_b <= N_det) + + ! Loop inside the alpha row to gather all the connected betas + lrow = psi_bilinear_matrix_transp_rows(k_b) + l_b = psi_bilinear_matrix_transp_rows_loc(lrow) + do i=1,N_det_beta_unique + if (l_b > N_det) exit + lrow = psi_bilinear_matrix_transp_rows(l_b) + if (lrow /= krow) exit + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol) + idx(i) = l_b + l_b = l_b+1 + enddo + i = i-1 + + !call get_all_spin_singles_and_doubles_$N_int( & + ! buffer, idx, spindet, i, & + ! singles_b, doubles, n_singles_b, n_doubles ) + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, $N_int, i, & + singles_b, doubles, n_singles_b, n_doubles ) + + ! Compute Hij for all beta singles + ! ---------------------------------- + + tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + do i=1,n_singles_b + l_b = singles_b(i) + ASSERT (l_b <= N_det) + + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) + call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 2, hij) + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + v_t(k_a) = v_t(k_a) + hij * u_t(l_a) + enddo + + ! Compute Hij for all beta doubles + ! ---------------------------------- + + do i=1,n_doubles + l_b = doubles(i) + ASSERT (l_b <= N_det) + + lcol = psi_bilinear_matrix_transp_columns(l_b) + ASSERT (lcol <= N_det_beta_unique) + + call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) + l_a = psi_bilinear_matrix_transp_order(l_b) + ASSERT (l_a <= N_det) + + v_t(k_a) = v_t(k_a) + hij * u_t(l_a) + enddo + + + ! Diagonal contribution + ! ===================== + + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + ASSERT (krow <= N_det_alpha_unique) + + kcol = psi_bilinear_matrix_columns(k_a) + ASSERT (kcol <= N_det_beta_unique) + + tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) + tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) + + !double precision, external :: diag_H_mat_elem, diag_S_mat_elem + double precision, external :: diag_H_mat_elem + hii = diag_H_mat_elem(tmp_det,$N_int) + v_t(k_a) = v_t(k_a) + hii * u_t(k_a) + + end do + !$OMP END DO + deallocate(buffer, singles_a, singles_b, doubles, idx) + !$OMP END PARALLEL + +end + +SUBST [ N_int ] + +1;; +2;; +3;; +4;; +N_int;; + +END_TEMPLATE + diff --git a/src/green/lanczos.irp.f b/src/green/lanczos.irp.f new file mode 100644 index 00000000..a2557abb --- /dev/null +++ b/src/green/lanczos.irp.f @@ -0,0 +1,882 @@ + + +BEGIN_PROVIDER [ integer, n_green_vec ] + implicit none + BEGIN_DOC + ! number of particles/holes to use for spectral density calc. + ! just set to 2 for now (homo and lumo) + END_DOC + n_green_vec = 2 +END_PROVIDER + + BEGIN_PROVIDER [ integer, green_idx, (n_green_vec) ] +&BEGIN_PROVIDER [ integer, green_idx_int, (n_green_vec) ] +&BEGIN_PROVIDER [ integer, green_idx_bit, (n_green_vec) ] +&BEGIN_PROVIDER [ integer, green_spin, (n_green_vec) ] +&BEGIN_PROVIDER [ double precision, green_sign, (n_green_vec) ] + implicit none + BEGIN_DOC + ! description of particles/holes to be used in spectral density calculation + ! green_idx: orbital index of particle/hole + ! green_idx_{int,bit}: location of idx within determinant bitstring + ! green_spin: 1(alpha) or 2(beta) + ! green_sign: 1(particle) or -1(hole) + END_DOC + integer :: s1,s2,i1,i2 + integer :: i + + integer :: idx_homo_lumo(2), spin_homo_lumo(2) + logical :: has_idx,has_spin,has_sign,has_lanc + integer :: nlanc + ! needs psi_det, mo_tot_num, N_int, mo_bielec_integral_jj, mo_mono_elec_integral_diag + call ezfio_has_green_green_idx(has_idx) + call ezfio_has_green_green_spin(has_spin) + call ezfio_has_green_green_sign(has_sign) +! call ezfio_has_green_n_lanczos_complete(has_lanc) + call ezfio_get_green_n_lanczos_complete(nlanc) + if (has_idx.and.has_spin.and.has_sign) then + print*,'reading idx,spin,sign' + call ezfio_get_green_green_idx(green_idx) + call ezfio_get_green_green_spin(green_spin) + call ezfio_get_green_green_sign(green_sign) + else if (nlanc.gt.0) then + stop 'problem with lanczos restart; need idx, spin, sign' + else + print*,'new lanczos calculation, finding homo/lumo' + call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_tot_num,idx_homo_lumo,spin_homo_lumo) + + ! homo + green_idx(1)=idx_homo_lumo(1) + green_spin(1)=spin_homo_lumo(1) + green_sign(1)=-1.d0 + + ! lumo + green_idx(2)=idx_homo_lumo(2) + green_spin(2)=spin_homo_lumo(2) + green_sign(2)=1.d0 + + call ezfio_set_green_green_idx(green_idx) + call ezfio_set_green_green_spin(green_spin) + call ezfio_set_green_green_sign(green_sign) + endif + + + +! if (nlanc.gt.0) then +! ! call ezfio_get_green_n_lanczos_complete(nlanc) +! print*,'restarting from previous lanczos',nlanc +! if (has_idx.and.has_spin.and.has_sign) then +! print*,'reading idx,spin,sign' +! call ezfio_get_green_green_idx(green_idx) +! call ezfio_get_green_green_spin(green_spin) +! call ezfio_get_green_green_sign(green_sign) +! else +! stop 'problem with lanczos restart; need idx, spin, sign' +! endif +! else +! print*,'new lanczos calculation, finding homo/lumo' +! call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_tot_num,idx_homo_lumo,spin_homo_lumo) +! +! ! homo +! green_idx(1)=idx_homo_lumo(1) +! green_spin(1)=spin_homo_lumo(1) +! green_sign(1)=-1.d0 +! +! ! lumo +! green_idx(2)=idx_homo_lumo(2) +! green_spin(2)=spin_homo_lumo(2) +! green_sign(2)=1.d0 +! +! call ezfio_set_green_green_idx(green_idx) +! call ezfio_set_green_green_spin(green_spin) +! call ezfio_set_green_green_sign(green_sign) +! endif + + do i=1,n_green_vec + call get_orb_int_bit(green_idx(i),green_idx_int(i),green_idx_bit(i)) + print*,i,green_idx(i),green_idx_int(i),green_idx_bit(i),green_spin(i),green_sign(i) + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ double precision, green_det_phase, (N_det,n_green_vec) ] + implicit none + BEGIN_DOC + ! for each det in psi, compute phase for each particle/hole excitation + ! each element should be +/-1 or 0 + END_DOC + integer :: i + double precision :: phase_tmp(n_green_vec) + PROVIDE psi_det green_idx + + do i=1,N_det + call get_phase_hp(green_idx_int,green_idx_bit,green_spin,green_sign,psi_det(1,1,i),phase_tmp,N_int,n_green_vec) + green_det_phase(i,1:n_green_vec) = phase_tmp(1:n_green_vec) + enddo + +END_PROVIDER + +BEGIN_PROVIDER [ complex*16, u1_lanczos, (N_det,n_green_vec) ] + implicit none + BEGIN_DOC + ! initial lanczos vectors + ! must be normalized + END_DOC + + integer :: i,j + + do j=1,n_green_vec + do i=1,N_det + u1_lanczos(i,j)=green_det_phase(i,j)*psi_coef(i,1) + enddo + call normalize_complex(u1_lanczos(:,j),N_det) + enddo + +END_PROVIDER + +! BEGIN_PROVIDER [ double precision, alpha_lanczos, (n_green_vec,n_lanczos_iter) ] +!&BEGIN_PROVIDER [ double precision, beta_lanczos, (n_green_vec,n_lanczos_iter) ] + BEGIN_PROVIDER [ double precision, alpha_lanczos, (n_lanczos_iter,n_green_vec) ] +&BEGIN_PROVIDER [ double precision, beta_lanczos, (n_lanczos_iter,n_green_vec) ] +&BEGIN_PROVIDER [ complex*16, un_lanczos, (N_det,n_green_vec) ] +&BEGIN_PROVIDER [ complex*16, vn_lanczos, (N_det,n_green_vec) ] +&BEGIN_PROVIDER [ double precision, lanczos_eigvals, (n_lanczos_iter,n_green_vec) ] + implicit none + BEGIN_DOC + ! for each particle/hole: + ! provide alpha and beta for tridiagonal form of H + ! un, vn lanczos vectors from latest iteration + ! lanczos_eigvals: eigenvalues of tridiagonal form of H + END_DOC + PROVIDE lanczos_debug_print n_lanczos_debug + complex*16, allocatable :: work(:,:) +! double precision :: alpha_tmp,beta_tmp + double precision, allocatable :: alpha_tmp(:),beta_tmp(:) + double precision, allocatable :: alpha_tmp_vec(:,:), beta_tmp_vec(:,:) + integer :: i,j + integer :: n_lanc_new_tmp, n_lanc_old_tmp + call ezfio_get_green_n_lanczos_iter(n_lanc_new_tmp) + call ezfio_get_green_n_lanczos_complete(n_lanc_old_tmp) + + if ((n_lanczos_complete).gt.0) then +! allocate(alpha_tmp_vec(n_green_vec,n_lanczos_complete),beta_tmp_vec(n_green_vec,n_lanczos_complete)) + allocate(alpha_tmp_vec(n_lanczos_complete,n_green_vec),beta_tmp_vec(n_lanczos_complete,n_green_vec)) + logical :: has_un_lanczos, has_vn_lanczos + call ezfio_has_green_un_lanczos(has_un_lanczos) + call ezfio_has_green_vn_lanczos(has_vn_lanczos) + if (has_un_lanczos.and.has_vn_lanczos) then + call ezfio_get_green_un_lanczos(un_lanczos) + call ezfio_get_green_vn_lanczos(vn_lanczos) +! if (lanczos_debug_print) then +! print*,'uu,vv read from disk' +! do i=1,n_lanczos_debug +! write(6,'(4(E25.15))')un_lanczos(i),vn_lanczos(i) +! enddo +! endif + else + print*,'problem reading lanczos vectors for restart' + stop + endif + logical :: has_alpha_lanczos, has_beta_lanczos + call ezfio_has_green_alpha_lanczos(has_alpha_lanczos) + call ezfio_has_green_beta_lanczos(has_beta_lanczos) + if (has_alpha_lanczos.and.has_beta_lanczos) then + call ezfio_set_green_n_lanczos_iter(n_lanc_old_tmp) + call ezfio_get_green_alpha_lanczos(alpha_tmp_vec) + call ezfio_get_green_beta_lanczos(beta_tmp_vec) + call ezfio_set_green_n_lanczos_iter(n_lanc_new_tmp) + do j=1,n_green_vec + do i=1,n_lanczos_complete + alpha_lanczos(i,j)=alpha_tmp_vec(i,j) + beta_lanczos(i,j)=beta_tmp_vec(i,j) + enddo + enddo + else + print*,'problem reading lanczos alpha, beta for restart' + stop + endif + deallocate(alpha_tmp_vec,beta_tmp_vec) + else + call write_time(6) + print*,'no saved lanczos vectors. starting lanczos' + PROVIDE u1_lanczos + un_lanczos=u1_lanczos + allocate(work(N_det,n_green_vec),alpha_tmp(n_green_vec),beta_tmp(n_green_vec)) + call lanczos_h_init_hp(un_lanczos,vn_lanczos,work,N_det,alpha_tmp,beta_tmp,& + n_green_vec,green_spin,green_sign,green_idx) + do i=1,n_green_vec + alpha_lanczos(1,i)=alpha_tmp(i) + beta_lanczos(1,i)=beta_tmp(i) + enddo + n_lanczos_complete=1 + deallocate(work,alpha_tmp,beta_tmp) + endif + + allocate(work(N_det,n_green_vec),alpha_tmp(n_green_vec),beta_tmp(n_green_vec)) + do i=n_lanczos_complete+1,n_lanczos_iter + call write_time(6) + print*,'starting lanczos iteration',i + call lanczos_h_step_hp(un_lanczos,vn_lanczos,work,N_det,alpha_tmp,beta_tmp,& + n_green_vec,green_spin,green_sign,green_idx) + do j=1,n_green_vec + alpha_lanczos(i,j)=alpha_tmp(j) + beta_lanczos(i,j)=beta_tmp(j) + enddo + n_lanczos_complete=n_lanczos_complete+1 + enddo + deallocate(work,alpha_tmp,beta_tmp) + + call ezfio_set_green_alpha_lanczos(alpha_lanczos) + call ezfio_set_green_beta_lanczos(beta_lanczos) + call ezfio_set_green_un_lanczos(un_lanczos) + call ezfio_set_green_vn_lanczos(vn_lanczos) + call ezfio_set_green_n_lanczos_complete(n_lanczos_complete) + + call diag_lanczos_vals_hp(alpha_lanczos, beta_lanczos, n_lanczos_complete, lanczos_eigvals,& + n_lanczos_iter,n_green_vec) + call ezfio_set_green_lanczos_eigvals(lanczos_eigvals) + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, delta_omega ] + implicit none + BEGIN_DOC + ! step size between frequency points for spectral density calculation + ! calculated from min, max, and number of steps + END_DOC + delta_omega=(omega_max-omega_min)/n_omega +END_PROVIDER + +BEGIN_PROVIDER [ double precision, omega_list, (n_omega) ] + implicit none + BEGIN_DOC + ! list of frequencies at which to compute spectral density + END_DOC + + integer :: i + double precision :: omega_i + PROVIDE delta_omega + do i=1,n_omega + omega_list(i) = omega_min + (i-1)*delta_omega + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [ double precision, spectral_lanczos, (n_omega,n_green_vec) ] + implicit none + BEGIN_DOC + ! spectral density A(omega) calculated from lanczos alpha/beta + ! calculated for n_omega points between omega_min and omega_max + END_DOC + + integer :: i,j + double precision :: omega_i + complex*16 :: z_i + !double precision :: spec_lanc_rev + double precision :: spec_lanc_rev_sign + logical :: has_ci_energy + double precision :: ref_energy_0 + PROVIDE delta_omega alpha_lanczos beta_lanczos omega_list + call ezfio_has_full_ci_zmq_energy(has_ci_energy) + if (has_ci_energy) then + call ezfio_get_full_ci_zmq_energy(ref_energy_0) + else + print*,'no reference energy from full_ci_zmq, exiting' + stop + endif + + + do i=1,n_omega + omega_i = omega_list(i) + z_i = dcmplx(omega_i,gf_epsilon) + do j=1,n_green_vec +! spectral_lanczos(i,j) = spec_lanc_rev(n_lanczos_iter,alpha_lanczos(:,j),beta_lanczos(:,j),z_i) + spectral_lanczos(i,j) = spec_lanc_rev_sign(n_lanczos_iter, & + alpha_lanczos(:,j), & + beta_lanczos(:,j), & + z_i - green_sign(j)*ref_energy_0, & + green_sign(j)) + enddo + enddo + +END_PROVIDER + +double precision function spec_lanc(n_lanc_iter,alpha,beta,z) + include 'constants.include.F' + implicit none + BEGIN_DOC + ! input: + ! alpha, beta: from tridiagonal form of H (obtain via lanczos) + ! beta and alpha same size (beta(1) is not used) + ! n_lanc_iter: size of alpha, beta + ! z: omega + i*epsilon + ! omega is frequency for which spectral density is to be computed + ! epsilon is magnitude of infinitesimal imaginary term + ! output: + ! spec_lanc: spectral density A(omega) + ! + ! uses inv_pi=(1.d0/pi) from constants + END_DOC + integer, intent(in) :: n_lanc_iter + double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) + complex*16, intent(in) :: z + + complex*16 bigAj2,bigAj1,bigAj0 + complex*16 bigBj2,bigBj1,bigBj0 + integer :: j + ! init for j=1 + ! bigAj2 is A(j-2) + ! bigAj1 is A(j-1) + ! etc. + + bigAj2=1.d0 ! A(-1) + bigAj1=0.d0 ! A(0) + bigAj0=1.d0 ! A(1) + + bigBj2=0.d0 ! B(-1) + bigBj1=1.d0 ! B(0) + bigBj0=z-alpha(1) ! B(1) + + do j=2,n_lanc_iter + bigAj2=bigAj1 + bigAj1=bigAj0 + bigAj0=(z-alpha(j))*bigAj1 - beta(j)**2*bigAj2 + + bigBj2=bigBj1 + bigBj1=bigBj0 + bigBj0=(z-alpha(j))*bigBj1 - beta(j)**2*bigBj2 + enddo + spec_lanc=-imag(bigAj0/bigBj0)*inv_pi +end + +double precision function spec_lanc_rev(n_lanc_iter,alpha,beta,z) + include 'constants.include.F' + implicit none + BEGIN_DOC + ! reverse iteration is more numerically stable + ! input: + ! alpha, beta: from tridiagonal form of H (obtain via lanczos) + ! beta and alpha same size (beta(1) is not used) + ! n_lanc_iter: size of alpha, beta + ! z: omega + i*epsilon + ! omega is frequency for which spectral density is to be computed + ! epsilon is magnitude of infinitesimal imaginary term + ! output: + ! spec_lanc: spectral density A(omega) + ! + ! uses inv_pi=(1.d0/pi) from constants + END_DOC + integer, intent(in) :: n_lanc_iter + double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) + complex*16, intent(in) :: z + + complex*16 :: tmp + integer :: j + + tmp=(0.d0,0.d0) + do j=n_lanc_iter,2,-1 + tmp=-beta(j)**2/(z-alpha(j)+tmp) + enddo + tmp=1.d0/(z-alpha(1)+tmp) + spec_lanc_rev=-imag(tmp)*inv_pi +end + +double precision function spec_lanc_rev_sign(n_lanc_iter,alpha,beta,z,g_sign) + include 'constants.include.F' + implicit none + BEGIN_DOC + ! reverse iteration is more numerically stable + ! input: + ! alpha, beta: from tridiagonal form of H (obtain via lanczos) + ! beta and alpha same size (beta(1) is not used) + ! n_lanc_iter: size of alpha, beta + ! z: omega + i*epsilon + ! omega is frequency for which spectral density is to be computed + ! epsilon is magnitude of infinitesimal imaginary term + ! output: + ! spec_lanc: spectral density A(omega) + ! + ! uses inv_pi=(1.d0/pi) from constants + END_DOC + integer, intent(in) :: n_lanc_iter + double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) + complex*16, intent(in) :: z + double precision, intent(in) :: g_sign + + complex*16 :: tmp + integer :: j + + tmp=(0.d0,0.d0) + do j=n_lanc_iter,2,-1 + tmp=-beta(j)**2/(z+g_sign*alpha(j)+tmp) + enddo + tmp=1.d0/(z+g_sign*alpha(1)+tmp) + spec_lanc_rev_sign=-imag(tmp)*inv_pi +end + + +subroutine lanczos_h_init_hp(uu,vv,work,sze,alpha_i,beta_i,ng,spin_hp,sign_hp,idx_hp) + implicit none + integer, intent(in) :: sze,ng + complex*16, intent(in) :: uu(sze,ng) + complex*16, intent(out) :: vv(sze,ng) + complex*16 :: work(sze,ng) + double precision, intent(out) :: alpha_i(ng), beta_i(ng) + integer, intent(in) :: spin_hp(ng), idx_hp(ng) + double precision, intent(in) :: sign_hp(ng) + + double precision, external :: dznrm2 + complex*16, external :: u_dot_v_complex + integer :: i,j + + BEGIN_DOC + ! initial step for lanczos tridiagonalization of H for multiple holes/particles + ! uu is array of initial vectors u1 (creation/annihilation operator applied to psi) + ! output vv is array of lanczos v1 (one for each hole/particle) + END_DOC + + print *,'starting lanczos' + print *,'sze = ',sze + + ! |uu> is |u(1)> + + ! |w(1)> = H|u(1)> + ! |work> is now |w(1)> + call compute_hu_hp(uu,work,ng,sze,spin_hp,sign_hp,idx_hp) + + ! alpha(n+1) = + do i=1,ng + alpha_i(i)=real(u_dot_v_complex(uu(1:sze,i),work(1:sze,i),sze)) + enddo + + do j=1,ng + do i=1,sze + vv(i,j)=work(i,j)-alpha_i(j)*uu(i,j) +! write(6,'(7(E25.15))')uu(i,j),vv(i,j),work(i,j),alpha_i(j) + enddo + enddo + + beta_i=0.d0 + ! |vv> is |v(1)> + ! |uu> is |u(1)> +end + +subroutine lanczos_h_step_hp(uu,vv,work,sze,alpha_i,beta_i,ng,spin_hp,sign_hp,idx_hp) + implicit none + integer, intent(in) :: sze,ng + complex*16, intent(inout) :: uu(sze,ng),vv(sze,ng) + complex*16, intent(out) :: work(sze,ng) + double precision, intent(out) :: alpha_i(ng), beta_i(ng) + integer, intent(in) :: spin_hp(ng), sign_hp(ng), idx_hp(ng) + + double precision, external :: dznrm2 + complex*16, external :: u_dot_v_complex + integer :: i,j + complex*16 :: tmp_c16 + BEGIN_DOC + ! lanczos tridiagonalization of H + ! n_lanc_iter is number of lanczos iterations + ! u1 is initial lanczos vector + ! u1 should be normalized + END_DOC + + ! |vv> is |v(n)> + ! |uu> is |u(n)> + + ! compute beta(n+1) + do j=1,ng + beta_i(j)=dznrm2(sze,vv(:,j),1) + ! |vv> is now |u(n+1)> + call zdscal(sze,(1.d0/beta_i(j)),vv(:,j),1) + enddo + + ! |w(n+1)> = H|u(n+1)> + ! |work> is now |w(n+1)> + call compute_hu_hp(vv,work,ng,sze,spin_hp,sign_hp,idx_hp) + + ! alpha(n+1) = + do i=1,ng + alpha_i(i)=real(u_dot_v_complex(vv(1:sze,i),work(1:sze,i),sze)) + enddo + + do j=1,ng + do i=1,sze + tmp_c16=work(i,j)-alpha_i(j)*vv(i,j)-beta_i(j)*uu(i,j) + uu(i,j)=vv(i,j) + vv(i,j)=tmp_c16 + enddo + enddo + ! |vv> is |v(n+1)> + ! |uu> is |u(n+1)> +end + + +subroutine lanczos_h_init(uu,vv,work,sze,alpha_i,beta_i) + implicit none + integer, intent(in) :: sze + complex*16, intent(inout) :: uu(sze) + complex*16, intent(out) :: vv(sze) + complex*16 :: work(sze) + double precision, intent(out) :: alpha_i, beta_i + + double precision, external :: dznrm2 + complex*16, external :: u_dot_v_complex + integer :: i + + BEGIN_DOC + ! lanczos tridiagonalization of H + ! n_lanc_iter is number of lanczos iterations + ! u1 is initial lanczos vector + ! u1 should be normalized + END_DOC + + print *,'starting lanczos' + print *,'sze = ',sze + ! exit if u1 is not normalized +! beta_norm = dznrm2(h_size,u1,1) +! if (dabs(beta_norm-1.d0) .gt. 1.d-6) then +! print *, 'Error: initial Lanczos vector is not normalized' +! stop -1 +! endif + + ! |uu> is |u(1)> + + ! |w(1)> = H|u(1)> + ! |work> is now |w(1)> + call compute_hu(uu,work,sze) + + ! alpha(n+1) = + alpha_i=real(u_dot_v_complex(uu,work,sze)) + + do i=1,sze + vv(i)=work(i)-alpha_i*uu(i) + enddo + beta_i=0.d0 + if (lanczos_debug_print) then + print*,'init uu,vv,work' + do i=1,n_lanczos_debug + write(6,'(6(E25.15))')uu(i),vv(i),work(i) + enddo + endif + ! |vv> is |v(1)> + ! |uu> is |u(1)> +end + +subroutine lanczos_h_step(uu,vv,work,sze,alpha_i,beta_i) + implicit none + integer, intent(in) :: sze + complex*16, intent(inout) :: uu(sze),vv(sze) + complex*16, intent(out) :: work(sze) + double precision, intent(out) :: alpha_i, beta_i + + double precision, external :: dznrm2 + complex*16, external :: u_dot_v_complex + integer :: i + complex*16 :: tmp_c16 + BEGIN_DOC + ! lanczos tridiagonalization of H + ! n_lanc_iter is number of lanczos iterations + ! u1 is initial lanczos vector + ! u1 should be normalized + END_DOC + + ! exit if u1 is not normalized +! beta_norm = dznrm2(h_size,u1,1) +! if (dabs(beta_norm-1.d0) .gt. 1.d-6) then +! print *, 'Error: initial Lanczos vector is not normalized' +! stop -1 +! endif + + ! |vv> is |v(n)> + ! |uu> is |u(n)> + + ! compute beta(n+1) + beta_i=dznrm2(sze,vv,1) + if (lanczos_debug_print) then + print*,'uu,vv in' + do i=1,n_lanczos_debug + write(6,'(4(E25.15))')uu(i),vv(i) + enddo + endif + ! |vv> is now |u(n+1)> + call zdscal(sze,(1.d0/beta_i),vv,1) + + ! |w(n+1)> = H|u(n+1)> + ! |work> is now |w(n+1)> + call compute_hu(vv,work,sze) + + if (lanczos_debug_print) then + print*,'vv,work' + do i=1,n_lanczos_debug + write(6,'(4(E25.15))')vv(i),work(i) + enddo + endif + + ! alpha(n+1) = + alpha_i=real(u_dot_v_complex(vv,work,sze)) + + do i=1,sze + tmp_c16=work(i)-alpha_i*vv(i)-beta_i*uu(i) + uu(i)=vv(i) + vv(i)=tmp_c16 + enddo + ! |vv> is |v(n+1)> + ! |uu> is |u(n+1)> +end + + + +subroutine lanczos_h(n_lanc_iter,alpha,beta,u1) + implicit none + integer, intent(in) :: n_lanc_iter + double precision, intent(out) :: alpha(n_lanc_iter), beta(n_lanc_iter) + complex*16, intent(in) :: u1(N_det) + integer :: h_size + double precision :: beta_norm, beta_norm_inv + complex*16, allocatable :: vec1(:), vec2(:), vec3(:) + complex*16 :: vec_tmp + double precision, external :: dznrm2 + complex*16, external :: u_dot_v_complex + + integer :: i,j,l + h_size=N_det + BEGIN_DOC + ! lanczos tridiagonalization of H + ! n_lanc_iter is number of lanczos iterations + ! u1 is initial lanczos vector + ! u1 should be normalized + END_DOC + + print *,'starting lanczos' + print *,'h_size = ',h_size +! print *,'initial vector:' +! do i=1,h_size +! print *,u1(i) +! enddo + ! exit if u1 is not normalized + beta_norm = dznrm2(h_size,u1,1) + if (dabs(beta_norm-1.d0) .gt. 1.d-6) then + print *, 'Error: initial Lanczos vector is not normalized' + stop -1 + endif + + allocate(vec1(h_size), & + vec2(h_size), & + vec3(h_size)) + + do i=1,h_size + vec1(i)=u1(i) + enddo + + ! |w1> = H|u1> + ! |vec2> = H|vec1> + call compute_hu(vec1,vec2,h_size)!! TODO: not implemented + + ! alpha(1) = = + ! = + alpha(1)=real(u_dot_v_complex(vec1,vec2,h_size)) + + ! |v1> = |w1> - alpha(1)*|u1> + ! |vec3> = |vec2> - alpha(1)*|vec1> + do i=1,h_size + vec3(i)=vec2(i)-alpha(1)*vec1(i) + enddo + do j=2,n_lanc_iter + call write_time(6) + print *,'starting lanczos iteration:',j + !! vec1 is |u(j-1)> + !! vec3 is |v(j-1)> + + ! beta(j) = sqrt() + beta_norm=dznrm2(h_size,vec3,1) + + ! TODO: check for beta=0? + beta_norm_inv=1.d0/beta_norm + + ! normalize |v(j-1)> to form |u(j)> + call zdscal(h_size,beta_norm_inv,vec3,1) + !! vec3 is |u(j)> + + ! |w(j)> = H|u(j)> + call compute_hu(vec3,vec2,h_size)!! TODO: not implemented + !! vec2 is |w(j)> + + alpha(j)=real(u_dot_v_complex(vec2,vec3,h_size)) + beta(j)=beta_norm + + ! |v(j)> = |w(j)> - alpha(j)*|u(j)> - beta(j)*|u(j-1)> + do l=1,h_size + vec_tmp=vec2(l)-alpha(j)*vec3(l)-beta(j)*vec1(l) + vec1(l)=vec3(l) + vec3(l)=vec_tmp + enddo + !! vec1 is |u(j)> + !! vec3 is |v(j)> + enddo + +end + + +subroutine compute_hu_hp(vec1,vec2,n_hp,h_size,spin_hp,sign_hp,idx_hp) + implicit none + integer, intent(in) :: h_size,n_hp + complex*16, intent(in) :: vec1(h_size,n_hp) + complex*16, intent(out) :: vec2(h_size,n_hp) + integer, intent(in) :: spin_hp(n_hp), idx_hp(n_hp) + double precision, intent (in) :: sign_hp(n_hp) + complex*16 :: vec1_tmp(h_size,n_hp) + integer :: i,j + BEGIN_DOC + ! |vec2> = H|vec1> + ! + ! TODO: implement + ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? + END_DOC + + vec1_tmp(1:h_size,1:n_hp) = vec1(1:h_size,1:n_hp) + call h_u_0_hp_openmp(vec2,vec1_tmp,n_hp,h_size,spin_hp,sign_hp,idx_hp) + + do j=1,n_hp + do i=1,h_size + if (cdabs(vec1_tmp(i,j) - vec1(i,j)).gt.1.d-6) then + print*,'ERROR: vec1 was changed by h_u_0_openmp' + endif + enddo + enddo +end + +subroutine compute_hu(vec1,vec2,h_size) + implicit none + integer, intent(in) :: h_size + complex*16, intent(in) :: vec1(h_size) + complex*16, intent(out) :: vec2(h_size) + complex*16 :: vec1_tmp(h_size) + integer :: i + BEGIN_DOC + ! |vec2> = H|vec1> + ! + ! TODO: implement + ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? + END_DOC + + vec1_tmp(1:h_size) = vec1(1:h_size) + call h_u_0_openmp(vec2,vec1_tmp,h_size) + + do i=1,h_size + if (cdabs(vec1_tmp(i) - vec1(i)).gt.1.d-6) then + print*,'ERROR: vec1 was changed by h_u_0_openmp' + endif + enddo +end + +subroutine compute_hu2(vec1,vec2,h_size) + implicit none + integer, intent(in) :: h_size + complex*16, intent(in) :: vec1(h_size) + complex*16, intent(out) :: vec2(h_size) + complex*16, allocatable :: u_tmp(:,:), s_tmp(:,:),v_tmp(:,:) + integer :: i + BEGIN_DOC + ! |vec2> = H|vec1> + ! + ! TODO: implement + ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? + END_DOC + + allocate(u_tmp(1,h_size),s_tmp(1,h_size),v_tmp(1,h_size)) + + u_tmp(1,1:h_size) = vec1(1:h_size) + call h_s2_u_0_nstates_openmp(v_tmp,s_tmp,u_tmp,1,h_size) + + do i=1,h_size + if (cdabs(u_tmp(1,i) - vec1(i)).gt.1.d-6) then + print*,'ERROR: vec1 was changed by h_u_0_openmp' + endif + enddo + vec2(1:h_size)=v_tmp(1,1:h_size) + deallocate(u_tmp,v_tmp,s_tmp) +end + + + +subroutine diag_lanczos_vals_vecs(alpha, beta, nlanc, vals, vecs, sze) + implicit none + BEGIN_DOC + ! diagonalization of tridiagonal form of H + ! this returns eigenvalues and eigenvectors in vals,vecs + END_DOC + integer, intent(in) :: nlanc,sze + double precision, intent(in) :: alpha(sze), beta(sze) + double precision, intent(out) :: vals(sze), vecs(sze,sze) + double precision :: work(2*nlanc-2), beta_tmp(nlanc-1) + integer :: i,info + + vals(1)=alpha(1) + do i=2,nlanc + vals(i)=alpha(i) + beta_tmp(i-1)=beta(i) + enddo + + call dstev('V', nlanc, vals, beta_tmp, vecs, sze, work, info) + if (info.gt.0) then + print *,'WARNING: diagonalization of tridiagonal form of H did not converge' + else if (info.lt.0) then + print *,'WARNING: argument to dstev had illegal value' + endif +end + +subroutine diag_lanczos_vals_hp(alpha, beta, nlanc, vals, sze,ng) + implicit none + BEGIN_DOC + ! diagonalization of tridiagonal form of H + ! this returns eigenvalues in vals + END_DOC + integer, intent(in) :: nlanc,sze,ng + !double precision, intent(in) :: alpha(ng,sze), beta(sze) + double precision, intent(in) :: alpha(sze,ng), beta(sze,ng) + double precision, intent(out) :: vals(sze,ng) + double precision :: work(1), beta_tmp(nlanc-1), vecs(1) + integer :: i,info,ig + + do ig=1,ng + vals(1,ig)=alpha(1,ig) + do i=2,nlanc + vals(i,ig)=alpha(i,ig) + beta_tmp(i-1)=beta(i,ig) + enddo + + call dstev('N', nlanc, vals(:,ig), beta_tmp, vecs, 1, work, info) + if (info.gt.0) then + print *,'WARNING: diagonalization of tridiagonal form of H did not converge' + else if (info.lt.0) then + print *,'WARNING: argument to dstev had illegal value' + endif + enddo +end +subroutine diag_lanczos_vals(alpha, beta, nlanc, vals, sze) + implicit none + BEGIN_DOC + ! diagonalization of tridiagonal form of H + ! this returns eigenvalues in vals + END_DOC + integer, intent(in) :: nlanc,sze + double precision, intent(in) :: alpha(sze), beta(sze) + double precision, intent(out) :: vals(sze) + double precision :: work(1), beta_tmp(nlanc-1), vecs(1) + integer :: i,info + + vals(1)=alpha(1) + do i=2,nlanc + vals(i)=alpha(i) + beta_tmp(i-1)=beta(i) + enddo + + call dstev('N', nlanc, vals, beta_tmp, vecs, 1, work, info) + if (info.gt.0) then + print *,'WARNING: diagonalization of tridiagonal form of H did not converge' + else if (info.lt.0) then + print *,'WARNING: argument to dstev had illegal value' + endif +end diff --git a/src/green/plot-spec-dens.py b/src/green/plot-spec-dens.py new file mode 100755 index 00000000..88e2dfec --- /dev/null +++ b/src/green/plot-spec-dens.py @@ -0,0 +1,90 @@ +#!/bin/env python + +import gzip +import sys +from math import pi +inv_pi = 1.0/pi + +def spec_dens(alpha,beta,z0,g_sign,e_shift): + sze=len(alpha) + sze_b=len(beta) + if (sze != sze_b): + print('Error: size mismatch',sze,sze_b) + sys.exit(1) + z=z0-g_sign*e_shift + tmp=0.0+0.0j + #for ai,bi in zip(reversed(a),reversed(b)) + for i in range(sze-1,0,-1): + tmp=-(beta[i]**2)/(z+g_sign*alpha[i]+tmp) + tmp=1.0/(z+g_sign*alpha[0]+tmp) + return -1.0 * tmp.imag * inv_pi + +def printspec(ezdir,wmin,wmax,nw,eps): + gdir=ezdir+'/green/' + with open(gdir+'n_green_vec') as infile: + ngvec=int(infile.readline().strip()) + with open(ezdir+'/full_ci_zmq/energy') as infile: + e0=float(infile.readline().strip()) + with open(gdir+'n_lanczos_complete') as infile: + nlanc=int(infile.readline().strip()) + + with gzip.open(gdir+'green_sign.gz') as infile: + gsign0=infile.read().split() + + with gzip.open(gdir+'alpha_lanczos.gz') as infile: + adata0=infile.read().split() + with gzip.open(gdir+'beta_lanczos.gz') as infile: + bdata0=infile.read().split() + + adim=int(adata0.pop(0)) + bdim=int(bdata0.pop(0)) + gsigndim=int(gsign0.pop(0)) + assert adim==2, 'dimension of alpha_lanczos should be 2' + assert bdim==2, 'dimension of beta_lanczos should be 2' + assert gsigndim==1, 'dimension of green_sign should be 1' + + ngvec_2=int(gsign0.pop(0)) + assert ngvec_2==ngvec, 'problem with size of green_sign.gz' + + ashape=tuple(map(int,adata0[:adim])) + bshape=tuple(map(int,bdata0[:bdim])) + assert ashape==(nlanc,ngvec), 'shape of alpha_lanczos should be (nlanc, ngvec)' + assert bshape==(nlanc,ngvec), 'shape of beta_lanczos should be (nlanc, ngvec)' + + amat=[] + for xi in range(ngvec): + amat.append(list(map(float,adata0[adim+xi*nlanc:adim+(xi+1)*nlanc]))) + + bmat=[] + b2mat=[] + for xi in range(ngvec): + #bmat.append(list(map(float,bdata0[bdim+xi*nlanc:bdim+(xi+1)*nlanc]))) + b_tmp=list(map(float,bdata0[bdim+xi*nlanc:bdim+(xi+1)*nlanc])) + b2_tmp=[i*i for i in b_tmp] + bmat.append(b_tmp) + b2mat.append(b2_tmp) + + gsign=list(map(float,gsign0)) + dw=(wmax-wmin)/(nw-1) + wlist = [wmin+iw*dw for iw in range(nw)] + densmat=[] + for ivec in range(ngvec): + densmat.append([spec_dens(amat[ivec],bmat[ivec],iw+1.j*eps,gsign[ivec],e0) for iw in wlist]) + + for i,dd in enumerate(zip(*densmat)): + print(('{:15.6E}'+ngvec*'{:25.15E}').format(wlist[i],*dd)) + +if __name__ == '__main__': + + if len(sys.argv) != 6: + print('bad args') + print('USAGE: plot-spec-dens.py ezfio omega_min omega_max n_omega epsilon') + sys.exit(1) + ezfio=sys.argv[1] + wmin=float(sys.argv[2]) + wmax=float(sys.argv[3]) + nw=int(sys.argv[4]) + eps=float(sys.argv[5]) + printspec(ezfio,wmin,wmax,nw,eps) + + diff --git a/src/green/print_dets_test.irp.f b/src/green/print_dets_test.irp.f new file mode 100644 index 00000000..6466141e --- /dev/null +++ b/src/green/print_dets_test.irp.f @@ -0,0 +1,15 @@ +program print_dets_test + implicit none + read_wf = .True. + touch read_wf + call routine + +end + +subroutine routine + use bitmasks + implicit none + integer :: i + read*,i + print*,psi_det(:,:,i) +end diff --git a/src/green/print_e_mo_debug.irp.f b/src/green/print_e_mo_debug.irp.f new file mode 100644 index 00000000..7bd738bc --- /dev/null +++ b/src/green/print_e_mo_debug.irp.f @@ -0,0 +1,15 @@ +program print_e_mo_debug + implicit none + read_wf = .True. + touch read_wf + call routine + +end + +subroutine routine + use bitmasks + implicit none + integer :: i + read*,i + call print_mo_energies(psi_det(:,:,i),N_int,mo_tot_num) +end diff --git a/src/green/print_h_debug.irp.f b/src/green/print_h_debug.irp.f new file mode 100644 index 00000000..10cc31d3 --- /dev/null +++ b/src/green/print_h_debug.irp.f @@ -0,0 +1,178 @@ +program print_h_debug + implicit none + read_wf = .True. + touch read_wf + call routine + +end + +subroutine routine + use bitmasks + implicit none + integer :: i,j + integer, allocatable :: H_matrix_degree(:,:) + double precision, allocatable :: H_matrix_phase(:,:) + integer :: degree + integer(bit_kind), allocatable :: keys_tmp(:,:,:) + allocate(keys_tmp(N_int,2,N_det)) + do i = 1, N_det + print*,'' + call debug_det(psi_det(1,1,i),N_int) + do j = 1, N_int + keys_tmp(j,1,i) = psi_det(j,1,i) + keys_tmp(j,2,i) = psi_det(j,2,i) + enddo + enddo + if(N_det.gt.10000)then + print*,'Warning !!!' + print*,'Number of determinants is ',N_det + print*,'It means that the H matrix will be enormous !' + print*,'stoppping ..' + stop + endif + print*,'' + print*,'Determinants ' + do i = 1, N_det + enddo + allocate(H_matrix_degree(N_det,N_det),H_matrix_phase(N_det,N_det)) + integer :: exc(0:2,2,2) + double precision :: phase + do i = 1, N_det + do j = i, N_det + call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int) + H_matrix_degree(i,j) = degree + H_matrix_degree(j,i) = degree + phase = 0.d0 + if(degree==1.or.degree==2)then + call get_excitation(psi_det(1,1,i),psi_det(1,1,j),exc,degree,phase,N_int) + endif + H_matrix_phase(i,j) = phase + H_matrix_phase(j,i) = phase + enddo + enddo + print*,'H matrix ' + double precision :: s2 + complex*16 :: ref_h_matrix + ref_h_matrix = h_matrix_all_dets(1,1) + print*,'HF like determinant energy = ',ref_bitmask_energy+nuclear_repulsion + print*,'Ref element of H_matrix = ',ref_h_matrix+nuclear_repulsion + print*,'Printing the H matrix ...' + print*,'' + print*,'' +!do i = 1, N_det +! H_matrix_all_dets(i,i) -= ref_h_matrix +!enddo + + do i = 1, N_det + H_matrix_all_dets(i,i) += nuclear_repulsion + enddo + +!do i = 5,N_det +! H_matrix_all_dets(i,3) = 0.d0 +! H_matrix_all_dets(3,i) = 0.d0 +! H_matrix_all_dets(i,4) = 0.d0 +! H_matrix_all_dets(4,i) = 0.d0 +!enddo + + + + +! TODO: change for complex + do i = 1, N_det + write(*,'(I3,X,A3,2000(E24.15))')i,' | ',H_matrix_all_dets(i,:) + enddo + +! print*,'' +! print*,'' +! print*,'' +! print*,'Printing the degree of excitations within the H matrix' +! print*,'' +! print*,'' +! do i = 1, N_det +! write(*,'(I3,X,A3,X,1000(I1,X))')i,' | ',H_matrix_degree(i,:) +! enddo +! +! +! print*,'' +! print*,'' +! print*,'Printing the phase of the Hamiltonian matrix elements ' +! print*,'' +! print*,'' +! do i = 1, N_det +! write(*,'(I3,X,A3,X,1000(F3.0,X))')i,' | ',H_matrix_phase(i,:) +! enddo +! print*,'' + + +! double precision, allocatable :: eigenvalues(:) +! complex*16, allocatable :: eigenvectors(:,:) +! double precision, allocatable :: s2_eigvalues(:) +! allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) +! allocate (eigenvalues(N_det),s2_eigvalues(N_det)) +! call lapack_diag_complex(eigenvalues,eigenvectors, & +! H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) +! print*,'Two first eigenvectors ' +! call u_0_S2_u_0(s2_eigvalues,eigenvectors,n_det,keys_tmp,N_int,N_det,size(eigenvectors,1)) +! do j =1, N_states +! print*,'s2 = ',s2_eigvalues(j) +! print*,'e = ',eigenvalues(j) +! print*,'coefs : ' +! do i = 1, N_det +! print*,'i = ',i,eigenvectors(i,j) +! enddo +! if(j>1)then +! print*,'Delta E(H) = ',eigenvalues(1) - eigenvalues(j) +! print*,'Delta E(eV) = ',(eigenvalues(1) - eigenvalues(j))*27.2114d0 +! endif +! enddo +! complex*16 :: get_mo_bielec_integral,k_a_iv,k_b_iv +! integer :: h1,p1,h2,p2 +! h1 = 10 +! p1 = 16 +! h2 = 14 +! p2 = 14 +!!h1 = 1 +!!p1 = 4 +!!h2 = 2 +!!p2 = 2 +! k_a_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) +! h2 = 15 +! p2 = 15 +! k_b_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) +! print*,'k_a_iv = ',k_a_iv +! print*,'k_b_iv = ',k_b_iv +! complex*16 :: k_av,k_bv,k_ai,k_bi +! h1 = 16 +! p1 = 14 +! h2 = 14 +! p2 = 16 +! k_av = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! h1 = 16 +! p1 = 15 +! h2 = 15 +! p2 = 16 +! k_bv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! +! h1 = 10 +! p1 = 14 +! h2 = 14 +! p2 = 10 +! k_ai = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! +! h1 = 10 +! p1 = 15 +! h2 = 15 +! p2 = 10 +! k_bi = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! +! print*,'k_av, k_bv = ',k_av,k_bv +! print*,'k_ai, k_bi = ',k_ai,k_bi +! complex*16 :: k_iv +! +! h1 = 10 +! p1 = 16 +! h2 = 16 +! p2 = 10 +! k_iv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) +! print*,'k_iv = ',k_iv +end diff --git a/src/green/print_h_omp_debug.irp.f b/src/green/print_h_omp_debug.irp.f new file mode 100644 index 00000000..abb8b127 --- /dev/null +++ b/src/green/print_h_omp_debug.irp.f @@ -0,0 +1,41 @@ +program print_h_omp_debug + implicit none + read_wf = .True. + touch read_wf + call routine_omp + +end + +subroutine routine_omp + use bitmasks + implicit none + integer :: h_size + complex*16, allocatable :: u_tmp(:,:), s_tmp(:,:),v_tmp(:,:) + integer :: i,n_st + h_size=N_det + BEGIN_DOC + ! |vec2> = H|vec1> + ! + ! TODO: implement + ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? + END_DOC + n_st=min(1000,h_size) + allocate(u_tmp(n_st,h_size),s_tmp(n_st,h_size),v_tmp(n_st,h_size)) + + u_tmp=(0.d0,0.d0) + v_tmp=(0.d0,0.d0) + s_tmp=(0.d0,0.d0) + + do i=1,n_st + u_tmp(i,i)=(1.d0,0.d0) + enddo + + call h_s2_u_0_nstates_openmp(v_tmp,s_tmp,u_tmp,n_st,h_size) + do i = 1, n_st + v_tmp(i,i) += nuclear_repulsion + enddo + do i = 1, n_st + write(*,'(I3,X,A3,2000(E24.15))')i,' | ',v_tmp(i,:) + enddo + deallocate(u_tmp,v_tmp,s_tmp) +end diff --git a/src/green/print_spectral_dens.irp.f b/src/green/print_spectral_dens.irp.f new file mode 100644 index 00000000..ca6826ce --- /dev/null +++ b/src/green/print_spectral_dens.irp.f @@ -0,0 +1,43 @@ +program print_spectral_dens + implicit none + BEGIN_DOC +! TODO + END_DOC + read_wf = .True. + touch read_wf + provide n_green_vec + call print_lanczos_eigvals + call print_spec +end + +subroutine print_lanczos_eigvals + implicit none + integer :: i, iunit, j + integer :: getunitandopen + character(5) :: jstr + + do j=1,n_green_vec + write(jstr,'(I0.3)') j + iunit = getunitandopen('lanczos_eigval_alpha_beta.out.'//trim(jstr),'w') + print *, 'printing lanczos eigenvalues, alpha, beta to "lanczos_eigval_alpha_beta.out.'//trim(jstr)//'"' + do i=1,n_lanczos_iter + write(iunit,'(I6,3(E25.15))') i, lanczos_eigvals(i,j), alpha_lanczos(i,j), beta_lanczos(i,j) + enddo + close(iunit) + enddo +end +subroutine print_spec + implicit none + integer :: i, iunit, j + integer :: getunitandopen + character(5) :: jstr + do j=1,n_green_vec + write(jstr,'(I0.3)') j + iunit = getunitandopen('omega_A.out.'//trim(jstr),'w') + print *, 'printing frequency, spectral density to "omega_A.out.'//trim(jstr)//'"' + do i=1,n_omega + write(iunit,'(2(E25.15))') omega_list(i), spectral_lanczos(i,j) + enddo + close(iunit) + enddo +end diff --git a/src/green/utils_hp.irp.f b/src/green/utils_hp.irp.f new file mode 100644 index 00000000..0978f9ee --- /dev/null +++ b/src/green/utils_hp.irp.f @@ -0,0 +1,614 @@ +subroutine print_mo_energies(key_ref,nint,nmo) + use bitmasks + BEGIN_DOC + ! get mo energies for one det + END_DOC + implicit none + integer, intent(in) :: nint, nmo + integer(bit_kind), intent(in) :: key_ref(nint,2) + double precision, allocatable :: e_mo(:,:) + integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) + integer :: n_occ(2), n_virt(2) + integer, parameter :: int_spin2(1:2) = (/2,1/) + integer :: i,j,ispin,jspin,i0,j0,k + integer(bit_kind), allocatable :: key_virt(:,:) + integer, allocatable :: is_occ(:,:) + + + allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2),key_virt(nint,2),e_mo(nmo,2),is_occ(nmo,2)) + is_occ=0 + + call bitstring_to_list_ab(key_ref,occ,n_occ,nint) + do i=1,nint + do ispin=1,2 + key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) + enddo + enddo + call bitstring_to_list_ab(key_virt,virt,n_virt,nint) + + e_mo(1:nmo,1)=mo_mono_elec_integral_diag(1:nmo) + e_mo(1:nmo,2)=mo_mono_elec_integral_diag(1:nmo) + + do ispin=1,2 + jspin=int_spin2(ispin) + do i0=1,n_occ(ispin) + i=occ(i0,ispin) + is_occ(i,ispin)=1 + do j0=i0+1,n_occ(ispin) + j=occ(j0,ispin) + e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + enddo + do k=2,ispin + do j0=1,n_occ(jspin) + j=occ(j0,jspin) + e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) !can delete this and remove k level of loop + enddo + enddo + do j0=1,n_virt(ispin) + j=virt(j0,ispin) + e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + enddo + do j0=1,n_virt(jspin) + j=virt(j0,jspin) + e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) + enddo + enddo + enddo + + do i=1,nmo + write(6,'(2(I5),2(E25.15))')is_occ(i,1),is_occ(i,2),e_mo(i,1),e_mo(i,2) + enddo + deallocate(occ,virt,key_virt,e_mo,is_occ) +end + +subroutine get_mo_energies(key_ref,nint,nmo,e_mo) + use bitmasks + BEGIN_DOC + ! get mo energies for one det + END_DOC + implicit none + integer, intent(in) :: nint, nmo + integer(bit_kind), intent(in) :: key_ref(nint,2) + double precision, intent(out) :: e_mo(nmo,2) + integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) + integer :: n_occ(2), n_virt(2) + integer, parameter :: int_spin2(1:2) = (/2,1/) + integer :: i,j,ispin,jspin,i0,j0,k + integer(bit_kind), allocatable :: key_virt(:,:) + + + allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2),key_virt(nint,2)) + + call bitstring_to_list_ab(key_ref,occ,n_occ,nint) + do i=1,nint + do ispin=1,2 + key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) + enddo + enddo + call bitstring_to_list_ab(key_virt,virt,n_virt,nint) + + e_mo(1:nmo,1)=mo_mono_elec_integral_diag(1:nmo) + e_mo(1:nmo,2)=mo_mono_elec_integral_diag(1:nmo) + + do ispin=1,2 + jspin=int_spin2(ispin) + do i0=1,n_occ(ispin) + i=occ(i0,ispin) + do j0=i0+1,n_occ(ispin) + j=occ(j0,ispin) + e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + enddo + do k=2,ispin + do j0=1,n_occ(jspin) + j=occ(j0,jspin) + e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) !can delete this and remove k level of loop + enddo + enddo + do j0=1,n_virt(ispin) + j=virt(j0,ispin) + e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + enddo + do j0=1,n_virt(jspin) + j=virt(j0,jspin) + e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) + enddo + enddo + enddo + + deallocate(occ,virt,key_virt) +end + +subroutine get_mask_phase_new(det1, pm, Nint) + use bitmasks + BEGIN_DOC + ! phasemask copied from qp2 + ! return phasemask of det1 in pm + END_DOC + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det1(Nint,2) + integer(bit_kind), intent(out) :: pm(Nint,2) + integer(bit_kind) :: tmp1, tmp2 + integer :: i + pm(1:Nint,1:2) = det1(1:Nint,1:2) + tmp1 = 0_8 + tmp2 = 0_8 + do i=1,Nint + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1)) + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2)) + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4)) + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8)) + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16)) + pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32)) + pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32)) + pm(i,1) = ieor(pm(i,1), tmp1) + pm(i,2) = ieor(pm(i,2), tmp2) + if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1) + if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2) + end do +end subroutine + +subroutine get_phase_hp(g_idx_int,g_idx_bit,g_spin,g_sign,det_in,g_det_phase,nint,n_g) + use bitmasks + implicit none + integer, intent(in) :: nint,n_g + integer, intent(in) :: g_idx_int(n_g), g_idx_bit(n_g),g_spin(n_g) + double precision, intent(in) :: g_sign(n_g) + integer(bit_kind), intent(in) :: det_in(nint,2) + double precision, intent(out) :: g_det_phase(n_g) + + integer(bit_kind) :: tmp_spindet(nint), pm(nint,2) + double precision, parameter :: phase_dble(0:1) = (/1.d0,-1.d0/) + + integer :: i + logical :: is_allowed(n_g), all_banned, is_filled + + all_banned=.True. + do i=1,n_g + tmp_spindet(1:nint) = det_in(1:nint,g_spin(i)) + call spinorb_is_filled_int_bit(tmp_spindet,g_idx_int(i),g_idx_bit(i),nint,is_filled) + is_allowed(i) = (.not.(((g_sign(i)<0).and.(.not.is_filled)).or.((g_sign(i)>0).and.(is_filled)))) + all_banned=(all_banned.and.(.not.is_allowed(i))) + enddo + + if (all_banned) then + g_det_phase(:)=0.d0 + else + call get_mask_phase_new(det_in,pm,nint) + do i=1,n_g + if (is_allowed(i)) then + g_det_phase(i) = phase_dble(popcnt(iand(ibset(0_bit_kind,g_idx_bit(i)),pm(g_idx_int(i),g_spin(i))))) + else + g_det_phase(i)=0.d0 + endif + enddo + endif +end + +subroutine get_homo_lumo(key_ref,nint,nmo,idx_homo_lumo,spin_homo_lumo) + use bitmasks + implicit none + integer, intent(in) :: nint,nmo + integer(bit_kind), intent(in) :: key_ref(nint,2) + integer, intent(out) :: idx_homo_lumo(2), spin_homo_lumo(2) + + double precision, allocatable :: e_mo(:,:) + integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) + integer :: n_occ(2), n_virt(2) + integer :: i,i0,ispin + integer(bit_kind), allocatable :: key_virt(:,:) + double precision :: maxocc(2), minvirt(2) + integer :: imaxocc(2), iminvirt(2) + + allocate(e_mo(nmo,2),key_virt(nint,2),occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2)) + + call get_mo_energies(key_ref,nint,nmo,e_mo) + + !allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2)) + + call bitstring_to_list_ab(key_ref,occ,n_occ,nint) + do i=1,nint + do ispin=1,2 + key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) + enddo + enddo + call bitstring_to_list_ab(key_virt,virt,n_virt,nint) + + maxocc=-1.d20 !maybe use -1.d0*huge(0.d0)? + minvirt=1.d20 + imaxocc=-1 + iminvirt=-1 + + do ispin=1,2 + do i0=1,n_occ(ispin) + i=occ(i0,ispin) + if (e_mo(i,ispin).gt.maxocc(ispin)) then + maxocc(ispin)=e_mo(i,ispin) + imaxocc(ispin)=i + endif + enddo + do i0=1,n_virt(ispin) + i=virt(i0,ispin) + if (e_mo(i,ispin).lt.minvirt(ispin)) then + minvirt(ispin)=e_mo(i,ispin) + iminvirt(ispin)=i + endif + enddo + enddo + double precision :: e_mo_thresh + e_mo_thresh = 1.d-8 + !these should both just be 2x2 arrays, but performance here doesn't really matter and this is more readable + !if (maxocc(1).ge.maxocc(2)) then + if ((maxocc(2)-maxocc(1)).le.e_mo_thresh) then + spin_homo_lumo(1)=1 + else + spin_homo_lumo(1)=2 + endif + if ((minvirt(1)-minvirt(2)).le.e_mo_thresh) then + spin_homo_lumo(2)=1 + else + spin_homo_lumo(2)=2 + endif + + idx_homo_lumo(1)=imaxocc(spin_homo_lumo(1)) + idx_homo_lumo(2)=iminvirt(spin_homo_lumo(2)) + + deallocate(e_mo,occ,virt,key_virt) + +end + +subroutine get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,nint,all_banned) + use bitmasks + implicit none + BEGIN_DOC + ! input determinant tmp_det and list of single holes/particles + ! for each hole/particle, determine whether it is filled/empty in tmp_det + ! return which are disallowed in exc_is_banned + ! if all are banned, set all_banned to true + END_DOC + integer, intent(in) :: N_hp,nint + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + integer(bit_kind), intent(in) :: tmp_det(nint,2) + logical, intent(out) :: exc_is_banned(N_hp) + logical, intent(out) :: all_banned + + integer :: i + logical :: is_filled + + all_banned = .True. + do i=1,N_hp + call orb_is_filled(tmp_det,idx_hp(i),spin_hp(i),nint,is_filled) + if (sign_hp(i).gt.0) then ! particle creation, banned if already filled + exc_is_banned(i) = is_filled + else ! hole creation, banned if already empty + exc_is_banned(i) = (.not.is_filled) + endif + all_banned = (all_banned.and.exc_is_banned(i)) + enddo +end + +subroutine get_list_hp_banned_single_spin(tmp_spindet,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,ispin,nint,all_banned) + use bitmasks + implicit none + BEGIN_DOC + ! input spindeterminant tmp_spindet and list of single holes/particles + ! tmp_spindet is only one spin part of a full det, with spin==ispin + ! for each hole/particle, determine whether it is filled/empty in tmp_det + ! return which are disallowed in exc_is_banned + ! if all are banned, set all_banned to true + END_DOC + integer, intent(in) :: N_hp, ispin, nint + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + integer(bit_kind), intent(in) :: tmp_spindet(nint) + logical, intent(out) :: exc_is_banned(N_hp) + logical, intent(out) :: all_banned + + integer :: i + logical :: is_filled + + all_banned = .True. + do i=1,N_hp + if (spin_hp(i).eq.ispin) then + call orb_is_filled_single_spin(tmp_spindet,idx_hp(i),nint,is_filled) + if (sign_hp(i).gt.0) then ! particle creation, banned if already filled + exc_is_banned(i) = is_filled + else ! hole creation, banned if already empty + exc_is_banned(i) = (.not.is_filled) + endif + else + exc_is_banned(i) = .False. + endif + all_banned = (all_banned.and.exc_is_banned(i)) + enddo +end + +subroutine get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,ispin,nint,all_banned) + use bitmasks + implicit none + BEGIN_DOC + ! input determinant tmp_det and list of single holes/particles + ! for each hole/particle, determine whether it is filled/empty in tmp_det + ! return which are disallowed in exc_is_banned + ! if all are banned, set all_banned to true + ! only consider tmp_det(1:N_int, ispin) + END_DOC + integer, intent(in) :: N_hp, ispin, nint + integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) + double precision, intent(in) :: sign_hp(N_hp) + integer(bit_kind), intent(in) :: tmp_det(nint,2) + logical, intent(out) :: exc_is_banned(N_hp) + logical, intent(out) :: all_banned + + integer(bit_kind) :: spindet(nint) + + integer :: i + logical :: is_filled + spindet(1:nint) = tmp_det(1:nint,ispin) + + all_banned = .True. + do i=1,N_hp + if (spin_hp(i).eq.ispin) then + call orb_is_filled(tmp_det,idx_hp(i),ispin,nint,is_filled) + if (sign_hp(i).gt.0) then ! particle creation, banned if already filled + exc_is_banned(i) = is_filled + else ! hole creation, banned if already empty + exc_is_banned(i) = (.not.is_filled) + endif + else + exc_is_banned(i) = .False. + endif + all_banned = (all_banned.and.exc_is_banned(i)) + enddo +end + + +subroutine spinorb_is_filled_int_bit(key_ref,iorb_int,iorb_bit,Nint,is_filled) + use bitmasks + implicit none + BEGIN_DOC + ! determine whether iorb is filled in key_ref + ! iorb is specified by int and bit locations within the determinant + END_DOC + integer, intent(in) :: iorb_int, iorb_bit, Nint + integer(bit_kind), intent(in) :: key_ref(Nint) + logical, intent(out) :: is_filled + + ASSERT (iorb_int > 0) + ASSERT (iorb_bit >= 0) + ASSERT (Nint > 0) + is_filled = btest(key_ref(iorb_int),iorb_bit) +end + +subroutine orb_is_filled_int_bit(key_ref,iorb_int,iorb_bit,ispin,Nint,is_filled) + use bitmasks + implicit none + BEGIN_DOC + ! todo: not finished + ! determine whether iorb is filled in key_ref + ! iorb is specified by int and bit locations within the determinant + END_DOC + integer, intent(in) :: iorb_int, iorb_bit, ispin, Nint + integer(bit_kind), intent(in) :: key_ref(Nint,2) + logical, intent(out) :: is_filled + + ASSERT (iorb_int > 0) + ASSERT (iorb_bit >= 0) + ASSERT (ispin > 0) + ASSERT (ispin < 3) + ASSERT (Nint > 0) + is_filled = btest(key_ref(iorb_int,ispin),iorb_bit) +! call spinorb_is_filled_int_bit(key_ref(1,ispin),iorb_int,iorb_bit,Nint,is_filled) +end + +subroutine get_orb_int_bit(iorb,iorb_int,iorb_bit) + BEGIN_DOC + ! get int and bit corresponding to orbital index iorb + END_DOC + use bitmasks + implicit none + integer, intent(in) :: iorb + integer, intent(out) :: iorb_int, iorb_bit + ASSERT (iorb > 0) + iorb_int = ishft(iorb-1,-bit_kind_shift)+1 + ASSERT (iorb_int > 0) + iorb_bit = iorb - ishft(iorb_int-1,bit_kind_shift)-1 + ASSERT (iorb_bit >= 0) +end + +subroutine orb_is_filled_single_spin(key_ref,iorb,Nint,is_filled) + use bitmasks + implicit none + BEGIN_DOC + ! determine whether iorb is filled in key_ref + ! key_ref is single alpha or beta determinant + END_DOC + integer, intent(in) :: iorb, Nint + integer(bit_kind), intent(in) :: key_ref(Nint) + logical, intent(out) :: is_filled + + integer :: k,l + + ASSERT (iorb > 0) + ASSERT (Nint > 0) + + ! k is index of the int where iorb is found + ! l is index of the bit where iorb is found + k = ishft(iorb-1,-bit_kind_shift)+1 + ASSERT (k >0) + l = iorb - ishft(k-1,bit_kind_shift)-1 + ASSERT (l >= 0) + is_filled = btest(key_ref(k),l) +end + +subroutine orb_is_filled(key_ref,iorb,ispin,Nint,is_filled) + use bitmasks + implicit none + BEGIN_DOC + ! determine whether iorb, ispin is filled in key_ref + ! key_ref has alpha and beta parts + END_DOC + integer, intent(in) :: iorb, ispin, Nint + integer(bit_kind), intent(in) :: key_ref(Nint,2) + logical, intent(out) :: is_filled + + integer :: k,l + + ASSERT (iorb > 0) + ASSERT (ispin > 0) + ASSERT (ispin < 3) + ASSERT (Nint > 0) + + ! k is index of the int where iorb is found + ! l is index of the bit where iorb is found + k = ishft(iorb-1,-bit_kind_shift)+1 + ASSERT (k >0) + l = iorb - ishft(k-1,bit_kind_shift)-1 + ASSERT (l >= 0) + is_filled = btest(key_ref(k,ispin),l) +end + +subroutine ac_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) + use bitmasks + implicit none + BEGIN_DOC + ! apply creation operator to key_ref + ! add electron with spin ispin to orbital with index iorb + ! output resulting det and phase in key_new and phase + END_DOC + integer, intent(in) :: iorb, ispin, Nint + integer(bit_kind), intent(in) :: key_ref(Nint,2) + integer(bit_kind), intent(out) :: key_new(Nint,2) + double precision, intent(out) :: phase + + integer :: k,l,i + + double precision, parameter :: p(0:1) = (/ 1.d0, -1.d0 /) + + ASSERT (iorb > 0) + ASSERT (ispin > 0) + ASSERT (ispin < 3) + ASSERT (Nint > 0) + + key_new=key_ref + + ! alpha det is list of Nint 64-bit ints + ! k is index of the int where iorb is found + ! l is index of the bit where iorb is found + k = ishft(iorb-1,-bit_kind_shift)+1 + ASSERT (k >0) + l = iorb - ishft(k-1,bit_kind_shift)-1 + ASSERT (l >= 0) + key_new(k,ispin) = ibset(key_new(k,ispin),l) + + integer(bit_kind) :: parity_filled + + ! I assume here that the ordering is all alpha spinorbs and then all beta spinorbs + ! If we add an alpha electron, parity is not affected by beta part of determinant + ! (only need number of alpha occupied orbs below iorb) + + ! If we add a beta electron, the parity is affected by alpha part + ! (need total number of occupied alpha orbs (all of which come before beta) + ! and total number of beta occupied orbs below iorb) + + if (ispin==1) then + parity_filled=0_bit_kind + else + parity_filled=iand(elec_alpha_num,1_bit_kind) + endif + + ! get parity due to orbs in other ints (with lower indices) + do i=1,k-1 + parity_filled = iand(popcnt(key_ref(i,ispin)),parity_filled) + enddo + + ! get parity due to orbs in same int as iorb + ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 + parity_filled = iand(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),parity_filled) + phase = p(iand(1_bit_kind,parity_filled)) + +end + +subroutine a_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) + use bitmasks + implicit none + BEGIN_DOC + ! apply annihilation operator to key_ref + ! remove electron with spin ispin to orbital with index iorb + ! output resulting det and phase in key_new and phase + END_DOC + integer, intent(in) :: iorb, ispin, Nint + integer(bit_kind), intent(in) :: key_ref(Nint,2) + integer(bit_kind), intent(out) :: key_new(Nint,2) + double precision, intent(out) :: phase + + integer :: k,l,i + + double precision, parameter :: p(0:1) = (/ 1.d0, -1.d0 /) + + ASSERT (iorb > 0) + ASSERT (ispin > 0) + ASSERT (ispin < 3) + ASSERT (Nint > 0) + + key_new=key_ref + + ! alpha det is list of Nint 64-bit ints + ! k is index of the int where iorb is found + ! l is index of the bit where iorb is found + k = ishft(iorb-1,-bit_kind_shift)+1 + ASSERT (k >0) + l = iorb - ishft(k-1,bit_kind_shift)-1 + ASSERT (l >= 0) + key_new(k,ispin) = ibclr(key_new(k,ispin),l) + + integer(bit_kind) :: parity_filled + + ! I assume here that the ordering is all alpha spinorbs and then all beta spinorbs + ! If we add an alpha electron, parity is not affected by beta part of determinant + ! (only need number of alpha occupied orbs below iorb) + + ! If we add a beta electron, the parity is affected by alpha part + ! (need total number of occupied alpha orbs (all of which come before beta) + ! and total number of beta occupied orbs below iorb) + + if (ispin==1) then + parity_filled=0_bit_kind + else + parity_filled=iand(elec_alpha_num,1_bit_kind) + endif + + ! get parity due to orbs in other ints (with lower indices) + do i=1,k-1 + parity_filled = iand(popcnt(key_ref(i,ispin)),parity_filled) + enddo + + ! get parity due to orbs in same int as iorb + ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 + parity_filled = iand(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),parity_filled) + phase = p(iand(1_bit_kind,parity_filled)) + +end +BEGIN_PROVIDER [ double precision, mo_mono_elec_integral_diag,(mo_tot_num)] + implicit none + integer :: i + BEGIN_DOC + ! diagonal elements of mo_mono_elec_integral array + END_DOC + print*,'Providing the mono electronic integrals (diagonal)' + + do i = 1, mo_tot_num + mo_mono_elec_integral_diag(i) = real(mo_mono_elec_integral(i,i)) + enddo + +END_PROVIDER From 25d0cbaa7537647c08a02fd51a61ec6c37116dca Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 11:59:14 -0500 Subject: [PATCH 209/256] complex to double in ezfio --- src/green/EZFIO.cfg | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/green/EZFIO.cfg b/src/green/EZFIO.cfg index 859a3eb9..0ad57888 100644 --- a/src/green/EZFIO.cfg +++ b/src/green/EZFIO.cfg @@ -73,14 +73,14 @@ size: (green.n_lanczos_iter,green.n_green_vec) [un_lanczos] interface: ezfio doc: saved lanczos u vector -type: complex*16 -size: (determinants.n_det,green.n_green_vec) +type: double precision +size: (2,determinants.n_det,green.n_green_vec) [vn_lanczos] interface: ezfio doc: saved lanczos v vector -type: complex*16 -size: (determinants.n_det,green.n_green_vec) +type: double precision +size: (2,determinants.n_det,green.n_green_vec) [lanczos_eigvals] interface: ezfio From 611f7d602d895862d26e4ab0ce953e29281d4ed2 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 13:36:00 -0500 Subject: [PATCH 210/256] smaller three to four index transformation --- src/mo_two_e_ints/df_mo_ints.irp.f | 212 ++++++++++++++++++++++++ src/mo_two_e_ints/mo_bi_integrals.irp.f | 3 +- 2 files changed, 214 insertions(+), 1 deletion(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index dbb10782..c9d03e0c 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -19,6 +19,218 @@ BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_ END_PROVIDER +subroutine mo_map_fill_from_df_single + use map_module + implicit none + BEGIN_DOC + ! fill mo bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_mo,j_mo,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) + + complex*16 :: integral + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: mo_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + + mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt + + size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000) + print*, 'Providing the mo_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(mo_num_per_kpt,mo_num_per_kpt,df_num)) + allocate( ints_ik(mo_num_per_kpt,mo_num_per_kpt,df_num)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_mo_integrals_complex(:,:,:,kjkl2) + endif + + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + call idx2_tri_int(ki,kk,kikk2) + if (ki < kk) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_mo_integrals_complex(:,:,:,kikk2) + endif + + !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP ki,kk,kikk2,ints_ik, & + !$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, & + !$OMP mo_integrals_map, mo_integrals_map_2) + + allocate( & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + n_integrals_1=0 + n_integrals_2=0 + !$OMP DO SCHEDULE(guided) + do mu=1,df_num + do il=1,mo_num_per_kpt + l=il+(kl-1)*mo_num_per_kpt + do ij=1,mo_num_per_kpt + j=ij+(kj-1)*mo_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + mjl = ints_jl(ij,il,mu) + if (mjl.eq.(0.d0,0.d0)) cycle + do ik=1,mo_num_per_kpt + k=ik+(kk-1)*mo_num_per_kpt + if (k>l) exit + do ii=1,mo_num_per_kpt + i=ii+(ki-1)*mo_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + mik = ints_ik(ii,ik,mu) + integral = mik * dconjg(mjl) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < mo_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + enddo !mu + !$OMP END DO NOWAIT + + if (n_integrals_1 > 0) then + !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + deallocate( & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kk + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl,ints_ik ) + + !call map_sort(mo_integrals_map) + !call map_unique(mo_integrals_map) + !call map_sort(mo_integrals_map_2) + !call map_unique(mo_integrals_map_2) + call map_merge(mo_integrals_map) + call map_merge(mo_integrals_map_2) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) + !!call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_map_size, mo_map_size + mo_map_size = get_mo_map_size() + + print*,'MO integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine mo_map_fill_from_df_single + subroutine mo_map_fill_from_df use map_module implicit none diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index 21422ba3..a4b3530e 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -43,7 +43,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] return else if (read_df_mo_integrals.or.read_df_ao_integrals) then PROVIDE df_mo_integrals_complex - call mo_map_fill_from_df + !call mo_map_fill_from_df + call mo_map_fill_from_df_single return else PROVIDE ao_two_e_integrals_in_map From 9beef1669e5fd71336ffa9c9f123bbc212c2f211 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 16:10:16 -0500 Subject: [PATCH 211/256] minor fix --- src/mo_two_e_ints/df_mo_ints.irp.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index c9d03e0c..9bc1e3c0 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -26,7 +26,7 @@ subroutine mo_map_fill_from_df_single ! fill mo bielec integral map using 3-index df integrals END_DOC - integer :: i,k,j,l + integer :: i,k,j,l,mu integer :: ki,kk,kj,kl integer :: ii,ik,ij,il integer :: kikk2,kjkl2,jl2,ik2 @@ -34,7 +34,7 @@ subroutine mo_map_fill_from_df_single complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) - complex*16 :: integral + complex*16 :: integral,mjl,mik integer :: n_integrals_1, n_integrals_2 integer :: size_buffer integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) @@ -97,6 +97,7 @@ subroutine mo_map_fill_from_df_single endif !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP mu, mik, mjl, & !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & From 095d5cf2525e983c71392481bf9d8239803bd551 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 18:16:36 -0500 Subject: [PATCH 212/256] int type --- src/utils_complex/export_integrals_ao_cplx.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils_complex/export_integrals_ao_cplx.irp.f b/src/utils_complex/export_integrals_ao_cplx.irp.f index d24a51e2..7d40ba76 100644 --- a/src/utils_complex/export_integrals_ao_cplx.irp.f +++ b/src/utils_complex/export_integrals_ao_cplx.irp.f @@ -159,7 +159,7 @@ provide ao_two_e_integrals_in_map if (cdabs(tmp_cmplx-int2e_tmp1).gt.thr0) then print'(4(I4),4(E15.7))',i,j,k,l,tmp_cmplx,int2e_tmp1 endif - integer*8 :: ii + integer :: ii ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) From 0524741d098148b8ebe9fbd5ca941c13a5fc55a3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 18:17:15 -0500 Subject: [PATCH 213/256] better mo transformation --- src/mo_two_e_ints/df_mo_ints.irp.f | 230 +++++++++++++++++++++++- src/mo_two_e_ints/mo_bi_integrals.irp.f | 3 +- 2 files changed, 228 insertions(+), 5 deletions(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 9bc1e3c0..3a61911e 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -19,6 +19,228 @@ BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_ END_PROVIDER +subroutine mo_map_fill_from_df_dot + use map_module + implicit none + BEGIN_DOC + ! fill mo bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l,mu + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_mo,j_mo,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) + + complex*16 :: integral,mjl,mik + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: mo_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + complex*16, external :: zdotc + + mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt + + size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000) + print*, 'Providing the mo_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(df_num,mo_num_per_kpt,mo_num_per_kpt)) + allocate( ints_ik(df_num,mo_num_per_kpt,mo_num_per_kpt)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_df,i_mo,j_mo) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2)) + enddo + enddo + enddo + else + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_df,i_mo,j_mo) = df_mo_integrals_complex(i_mo,j_mo,i_df,kjkl2) + enddo + enddo + enddo + endif + + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + call idx2_tri_int(ki,kk,kikk2) + if (ki < kk) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_df,i_mo,j_mo) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_df,i_mo,j_mo) = df_mo_integrals_complex(i_mo,j_mo,i_df,kikk2) + enddo + enddo + enddo + endif + + !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP mu, mik, mjl, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP ki,kk,kikk2,ints_ik, & + !$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, & + !$OMP mo_integrals_map, mo_integrals_map_2) + + allocate( & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + n_integrals_1=0 + n_integrals_2=0 + !$OMP DO SCHEDULE(guided) + do il=1,mo_num_per_kpt + l=il+(kl-1)*mo_num_per_kpt + do ij=1,mo_num_per_kpt + j=ij+(kj-1)*mo_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,mo_num_per_kpt + k=ik+(kk-1)*mo_num_per_kpt + if (k>l) exit + do ii=1,mo_num_per_kpt + i=ii+(ki-1)*mo_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < mo_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + !$OMP END DO NOWAIT + + if (n_integrals_1 > 0) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) + endif + if (n_integrals_2 > 0) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) + endif + deallocate( & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kk + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl,ints_ik ) + + call map_sort(mo_integrals_map) + call map_unique(mo_integrals_map) + call map_sort(mo_integrals_map_2) + call map_unique(mo_integrals_map_2) + !call map_merge(mo_integrals_map) + !call map_merge(mo_integrals_map_2) + + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) + !!call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_map_size, mo_map_size + mo_map_size = get_mo_map_size() + + print*,'MO integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine mo_map_fill_from_df_dot + subroutine mo_map_fill_from_df_single use map_module implicit none @@ -155,7 +377,7 @@ subroutine mo_map_fill_from_df_single endif if (n_integrals_1 >= size(buffer_i_1)-1) then !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) - call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) n_integrals_1 = 0 endif else @@ -169,7 +391,7 @@ subroutine mo_map_fill_from_df_single endif if (n_integrals_2 >= size(buffer_i_2)-1) then !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) - call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) n_integrals_2 = 0 endif endif @@ -183,11 +405,11 @@ subroutine mo_map_fill_from_df_single if (n_integrals_1 > 0) then !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) - call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) endif if (n_integrals_2 > 0) then !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) - call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) endif deallocate( & buffer_i_1, & diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index a4b3530e..16322c19 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -44,7 +44,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] else if (read_df_mo_integrals.or.read_df_ao_integrals) then PROVIDE df_mo_integrals_complex !call mo_map_fill_from_df - call mo_map_fill_from_df_single + !call mo_map_fill_from_df_single + call mo_map_fill_from_df_dot return else PROVIDE ao_two_e_integrals_in_map From 0fd6eb3897a9abff08574b0f58eb3d4ca6d35784 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 3 Jun 2020 16:13:16 -0500 Subject: [PATCH 214/256] updated green for qp2 --- src/green/green.main.irp.f | 2 +- src/green/hu0_hp.irp.f | 54 ++++++++++++------------ src/green/hu0_lanczos.irp.f | 10 ++--- src/green/lanczos.irp.f | 13 +++--- src/green/plot-spec-dens.py | 2 +- src/green/print_e_mo_debug.irp.f | 2 +- src/green/print_h_debug.irp.f | 6 +-- src/green/print_h_omp_debug.irp.f | 2 +- src/green/utils_hp.irp.f | 70 +++++++++++++++---------------- src/utils/constants.include.F | 1 + 10 files changed, 82 insertions(+), 80 deletions(-) diff --git a/src/green/green.main.irp.f b/src/green/green.main.irp.f index c9b3ef66..3fe26424 100644 --- a/src/green/green.main.irp.f +++ b/src/green/green.main.irp.f @@ -15,7 +15,7 @@ end subroutine psicoefprinttest implicit none integer :: i - TOUCH psi_coef + TOUCH psi_coef_complex print *, 'printing ndet', N_det end subroutine print_lanczos_eigvals diff --git a/src/green/hu0_hp.irp.f b/src/green/hu0_hp.irp.f index c3d8be40..4fa7275f 100644 --- a/src/green/hu0_hp.irp.f +++ b/src/green/hu0_hp.irp.f @@ -595,22 +595,22 @@ subroutine i_h_j_double_spin_hp(key_i,key_j,Nint,ispin,hij_hp,N_hp,spin_hp,sign_ double precision :: phase_hp(N_hp) integer :: exc(0:2,2) double precision :: phase - complex*16, external :: get_mo_bielec_integral + complex*16, external :: mo_two_e_integral_complex integer :: i1,i2,i3,i4,j2,j3,ii - PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) - hij0 = phase*(get_mo_bielec_integral( & + hij0 = phase*(mo_two_e_integral_complex( & exc(1,1), & exc(2,1), & exc(1,2), & - exc(2,2), mo_integrals_map) - & - get_mo_bielec_integral( & + exc(2,2)) - & + mo_two_e_integral_complex( & exc(1,1), & exc(2,1), & exc(2,2), & - exc(1,2), mo_integrals_map) ) + exc(1,2)) ) ASSERT (exc(1,1) < exc(2,1)) ASSERT (exc(1,2) < exc(2,2)) @@ -661,14 +661,14 @@ subroutine i_h_j_mono_spin_hp(key_i,key_j,Nint,spin,hij_hp,N_hp,spin_hp,sign_hp, integer :: exc(0:2,2) double precision :: phase - PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map - call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) - call get_mono_excitation_from_fock_hp(key_i,key_j,exc(1,1),exc(1,2),spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) + call get_single_excitation_from_fock_hp(key_i,key_j,exc(1,1),exc(1,2),spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) end -subroutine get_mono_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) +subroutine get_single_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) use bitmasks implicit none integer,intent(in) :: h,p,spin,N_hp @@ -699,37 +699,37 @@ subroutine get_mono_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_ enddo call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij0 = fock_operator_closed_shell_ref_bitmask(h,p) + hij0 = fock_op_cshell_ref_bitmask_cplx(h,p) ! holes :: direct terms do i0 = 1, n_occ_ab_hole(1) i = occ_hole(i0,1) - hij0 -= big_array_coulomb_integrals(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + hij0 -= big_array_coulomb_integrals_complex(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) enddo do i0 = 1, n_occ_ab_hole(2) i = occ_hole(i0,2) - hij0 -= big_array_coulomb_integrals(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + hij0 -= big_array_coulomb_integrals_complex(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) enddo ! holes :: exchange terms do i0 = 1, n_occ_ab_hole(spin) i = occ_hole(i0,spin) - hij0 += big_array_exchange_integrals(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) + hij0 += big_array_exchange_integrals_complex(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) enddo ! particles :: direct terms do i0 = 1, n_occ_ab_partcl(1) i = occ_partcl(i0,1) - hij0 += big_array_coulomb_integrals(i,h,p)!get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + hij0 += big_array_coulomb_integrals_complex(i,h,p)!get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) enddo do i0 = 1, n_occ_ab_partcl(2) i = occ_partcl(i0,2) - hij0 += big_array_coulomb_integrals(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) + hij0 += big_array_coulomb_integrals_complex(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) enddo ! particles :: exchange terms do i0 = 1, n_occ_ab_partcl(spin) i = occ_partcl(i0,spin) - hij0 -= big_array_exchange_integrals(i,h,p)!get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) + hij0 -= big_array_exchange_integrals_complex(i,h,p)!get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) enddo low=min(h,p) @@ -771,7 +771,7 @@ subroutine get_mono_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_ hij_hp(ii) = 0.d0 cycle else if (spin.eq.spin_hp(ii)) then - hij_hp(ii) = hij0 + sign_hp(ii) *(big_array_coulomb_integrals(idx_hp(ii),h,p) - big_array_exchange_integrals(idx_hp(ii),h,p)) + hij_hp(ii) = hij0 + sign_hp(ii) *(big_array_coulomb_integrals_complex(idx_hp(ii),h,p) - big_array_exchange_integrals_complex(idx_hp(ii),h,p)) if ((low.lt.idx_hp(ii)).and.(high.gt.idx_hp(ii))) then phase_hp(ii) = -1.d0 else @@ -779,7 +779,7 @@ subroutine get_mono_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_ endif else phase_hp(ii) = 1.d0 - hij_hp(ii) = hij0 + sign_hp(ii) * big_array_coulomb_integrals(idx_hp(ii),h,p) + hij_hp(ii) = hij0 + sign_hp(ii) * big_array_coulomb_integrals_complex(idx_hp(ii),h,p) endif hij_hp(ii) = hij_hp(ii) * phase * phase_hp(ii) enddo @@ -806,24 +806,24 @@ subroutine i_H_j_double_alpha_beta_hp(key_i,key_j,Nint,hij_hp,N_hp,spin_hp,sign_ integer :: lowhigh(2,2) integer :: exc(0:2,2,2) double precision :: phase, phase2 - complex*16, external :: get_mo_bielec_integral + complex*16, external :: mo_two_e_integral_complex - PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map - call get_mono_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) - call get_mono_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) + call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) + call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) phase = phase*phase2 if (exc(1,1,1) == exc(1,2,2)) then - hij0 = big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + hij0 = big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) == exc(1,1,2)) then - hij0 = big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + hij0 = big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) else - hij0 = get_mo_bielec_integral( & + hij0 = mo_two_e_integral_complex( & exc(1,1,1), & exc(1,1,2), & exc(1,2,1), & - exc(1,2,2) ,mo_integrals_map) + exc(1,2,2)) endif !todo: clean this up diff --git a/src/green/hu0_lanczos.irp.f b/src/green/hu0_lanczos.irp.f index e4da5c78..6f7ebf1d 100644 --- a/src/green/hu0_lanczos.irp.f +++ b/src/green/hu0_lanczos.irp.f @@ -194,7 +194,7 @@ subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) ASSERT (lrow <= N_det_alpha_unique) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call i_h_j_double_alpha_beta(tmp_det,tmp_det2,$N_int,hij) + call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij) v_t(k_a) = v_t(k_a) + hij * u_t(l_a) enddo enddo @@ -264,7 +264,7 @@ subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) ASSERT (lrow <= N_det_alpha_unique) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 1, hij) + call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij) v_t(k_a) = v_t(k_a) + hij * u_t(l_a) enddo @@ -280,7 +280,7 @@ subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) lrow = psi_bilinear_matrix_rows(l_a) ASSERT (lrow <= N_det_alpha_unique) - call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) + call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) v_t(k_a) = v_t(k_a) + hij * u_t(l_a) enddo @@ -341,7 +341,7 @@ subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) ASSERT (lcol <= N_det_beta_unique) tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) - call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 2, hij) + call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij) l_a = psi_bilinear_matrix_transp_order(l_b) ASSERT (l_a <= N_det) v_t(k_a) = v_t(k_a) + hij * u_t(l_a) @@ -357,7 +357,7 @@ subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) lcol = psi_bilinear_matrix_transp_columns(l_b) ASSERT (lcol <= N_det_beta_unique) - call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) + call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) l_a = psi_bilinear_matrix_transp_order(l_b) ASSERT (l_a <= N_det) diff --git a/src/green/lanczos.irp.f b/src/green/lanczos.irp.f index a2557abb..baf66d80 100644 --- a/src/green/lanczos.irp.f +++ b/src/green/lanczos.irp.f @@ -28,7 +28,7 @@ END_PROVIDER integer :: idx_homo_lumo(2), spin_homo_lumo(2) logical :: has_idx,has_spin,has_sign,has_lanc integer :: nlanc - ! needs psi_det, mo_tot_num, N_int, mo_bielec_integral_jj, mo_mono_elec_integral_diag + ! needs psi_det, mo_num, N_int, mo_bielec_integral_jj, mo_mono_elec_integral_diag call ezfio_has_green_green_idx(has_idx) call ezfio_has_green_green_spin(has_spin) call ezfio_has_green_green_sign(has_sign) @@ -43,7 +43,7 @@ END_PROVIDER stop 'problem with lanczos restart; need idx, spin, sign' else print*,'new lanczos calculation, finding homo/lumo' - call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_tot_num,idx_homo_lumo,spin_homo_lumo) + call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_num,idx_homo_lumo,spin_homo_lumo) ! homo green_idx(1)=idx_homo_lumo(1) @@ -75,7 +75,7 @@ END_PROVIDER ! endif ! else ! print*,'new lanczos calculation, finding homo/lumo' -! call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_tot_num,idx_homo_lumo,spin_homo_lumo) +! call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_num,idx_homo_lumo,spin_homo_lumo) ! ! ! homo ! green_idx(1)=idx_homo_lumo(1) @@ -279,9 +279,9 @@ BEGIN_PROVIDER [ double precision, spectral_lanczos, (n_omega,n_green_vec) ] logical :: has_ci_energy double precision :: ref_energy_0 PROVIDE delta_omega alpha_lanczos beta_lanczos omega_list - call ezfio_has_full_ci_zmq_energy(has_ci_energy) + call ezfio_has_fci_energy(has_ci_energy) if (has_ci_energy) then - call ezfio_get_full_ci_zmq_energy(ref_energy_0) + call ezfio_get_fci_energy(ref_energy_0) else print*,'no reference energy from full_ci_zmq, exiting' stop @@ -469,7 +469,8 @@ subroutine lanczos_h_step_hp(uu,vv,work,sze,alpha_i,beta_i,ng,spin_hp,sign_hp,id complex*16, intent(inout) :: uu(sze,ng),vv(sze,ng) complex*16, intent(out) :: work(sze,ng) double precision, intent(out) :: alpha_i(ng), beta_i(ng) - integer, intent(in) :: spin_hp(ng), sign_hp(ng), idx_hp(ng) + integer, intent(in) :: spin_hp(ng), idx_hp(ng) + double precision, intent(in) :: sign_hp(ng) double precision, external :: dznrm2 complex*16, external :: u_dot_v_complex diff --git a/src/green/plot-spec-dens.py b/src/green/plot-spec-dens.py index 88e2dfec..bf4f2294 100755 --- a/src/green/plot-spec-dens.py +++ b/src/green/plot-spec-dens.py @@ -23,7 +23,7 @@ def printspec(ezdir,wmin,wmax,nw,eps): gdir=ezdir+'/green/' with open(gdir+'n_green_vec') as infile: ngvec=int(infile.readline().strip()) - with open(ezdir+'/full_ci_zmq/energy') as infile: + with open(ezdir+'/fci/energy') as infile: e0=float(infile.readline().strip()) with open(gdir+'n_lanczos_complete') as infile: nlanc=int(infile.readline().strip()) diff --git a/src/green/print_e_mo_debug.irp.f b/src/green/print_e_mo_debug.irp.f index 7bd738bc..1fe41e34 100644 --- a/src/green/print_e_mo_debug.irp.f +++ b/src/green/print_e_mo_debug.irp.f @@ -11,5 +11,5 @@ subroutine routine implicit none integer :: i read*,i - call print_mo_energies(psi_det(:,:,i),N_int,mo_tot_num) + call print_mo_energies(psi_det(:,:,i),N_int,mo_num) end diff --git a/src/green/print_h_debug.irp.f b/src/green/print_h_debug.irp.f index 10cc31d3..4dd394d7 100644 --- a/src/green/print_h_debug.irp.f +++ b/src/green/print_h_debug.irp.f @@ -53,7 +53,7 @@ subroutine routine print*,'H matrix ' double precision :: s2 complex*16 :: ref_h_matrix - ref_h_matrix = h_matrix_all_dets(1,1) + ref_h_matrix = h_matrix_all_dets_complex(1,1) print*,'HF like determinant energy = ',ref_bitmask_energy+nuclear_repulsion print*,'Ref element of H_matrix = ',ref_h_matrix+nuclear_repulsion print*,'Printing the H matrix ...' @@ -64,7 +64,7 @@ subroutine routine !enddo do i = 1, N_det - H_matrix_all_dets(i,i) += nuclear_repulsion + H_matrix_all_dets_complex(i,i) += nuclear_repulsion enddo !do i = 5,N_det @@ -79,7 +79,7 @@ subroutine routine ! TODO: change for complex do i = 1, N_det - write(*,'(I3,X,A3,2000(E24.15))')i,' | ',H_matrix_all_dets(i,:) + write(*,'(I3,X,A3,2000(E24.15))')i,' | ',H_matrix_all_dets_complex(i,:) enddo ! print*,'' diff --git a/src/green/print_h_omp_debug.irp.f b/src/green/print_h_omp_debug.irp.f index abb8b127..0a9cd930 100644 --- a/src/green/print_h_omp_debug.irp.f +++ b/src/green/print_h_omp_debug.irp.f @@ -30,7 +30,7 @@ subroutine routine_omp u_tmp(i,i)=(1.d0,0.d0) enddo - call h_s2_u_0_nstates_openmp(v_tmp,s_tmp,u_tmp,n_st,h_size) + call h_s2_u_0_nstates_openmp_complex(v_tmp,s_tmp,u_tmp,n_st,h_size) do i = 1, n_st v_tmp(i,i) += nuclear_repulsion enddo diff --git a/src/green/utils_hp.irp.f b/src/green/utils_hp.irp.f index 0978f9ee..264e3014 100644 --- a/src/green/utils_hp.irp.f +++ b/src/green/utils_hp.irp.f @@ -26,8 +26,8 @@ subroutine print_mo_energies(key_ref,nint,nmo) enddo call bitstring_to_list_ab(key_virt,virt,n_virt,nint) - e_mo(1:nmo,1)=mo_mono_elec_integral_diag(1:nmo) - e_mo(1:nmo,2)=mo_mono_elec_integral_diag(1:nmo) + e_mo(1:nmo,1)=mo_one_e_integrals_diag(1:nmo) + e_mo(1:nmo,2)=mo_one_e_integrals_diag(1:nmo) do ispin=1,2 jspin=int_spin2(ispin) @@ -36,23 +36,23 @@ subroutine print_mo_energies(key_ref,nint,nmo) is_occ(i,ispin)=1 do j0=i0+1,n_occ(ispin) j=occ(j0,ispin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj_anti(i,j) - e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) enddo do k=2,ispin do j0=1,n_occ(jspin) j=occ(j0,jspin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj(i,j) - e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) !can delete this and remove k level of loop + e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) !can delete this and remove k level of loop enddo enddo do j0=1,n_virt(ispin) j=virt(j0,ispin) - e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) enddo do j0=1,n_virt(jspin) j=virt(j0,jspin) - e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) enddo enddo enddo @@ -89,8 +89,8 @@ subroutine get_mo_energies(key_ref,nint,nmo,e_mo) enddo call bitstring_to_list_ab(key_virt,virt,n_virt,nint) - e_mo(1:nmo,1)=mo_mono_elec_integral_diag(1:nmo) - e_mo(1:nmo,2)=mo_mono_elec_integral_diag(1:nmo) + e_mo(1:nmo,1)=mo_one_e_integrals_diag(1:nmo) + e_mo(1:nmo,2)=mo_one_e_integrals_diag(1:nmo) do ispin=1,2 jspin=int_spin2(ispin) @@ -98,23 +98,23 @@ subroutine get_mo_energies(key_ref,nint,nmo,e_mo) i=occ(i0,ispin) do j0=i0+1,n_occ(ispin) j=occ(j0,ispin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj_anti(i,j) - e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) enddo do k=2,ispin do j0=1,n_occ(jspin) j=occ(j0,jspin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_bielec_integral_jj(i,j) - e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) !can delete this and remove k level of loop + e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) !can delete this and remove k level of loop enddo enddo do j0=1,n_virt(ispin) j=virt(j0,ispin) - e_mo(j,ispin) = e_mo(j,ispin) + mo_bielec_integral_jj_anti(i,j) + e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) enddo do j0=1,n_virt(jspin) j=virt(j0,jspin) - e_mo(j,jspin) = e_mo(j,jspin) + mo_bielec_integral_jj(i,j) + e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) enddo enddo enddo @@ -524,17 +524,17 @@ subroutine ac_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) if (ispin==1) then parity_filled=0_bit_kind else - parity_filled=iand(elec_alpha_num,1_bit_kind) + parity_filled=iand(int(elec_alpha_num,bit_kind),1_bit_kind) endif ! get parity due to orbs in other ints (with lower indices) do i=1,k-1 - parity_filled = iand(popcnt(key_ref(i,ispin)),parity_filled) + parity_filled = iand(int(popcnt(key_ref(i,ispin)),bit_kind),parity_filled) enddo ! get parity due to orbs in same int as iorb ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 - parity_filled = iand(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),parity_filled) + parity_filled = iand(int(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),bit_kind),parity_filled) phase = p(iand(1_bit_kind,parity_filled)) end @@ -585,30 +585,30 @@ subroutine a_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) if (ispin==1) then parity_filled=0_bit_kind else - parity_filled=iand(elec_alpha_num,1_bit_kind) + parity_filled=iand(int(elec_alpha_num,bit_kind),1_bit_kind) endif ! get parity due to orbs in other ints (with lower indices) do i=1,k-1 - parity_filled = iand(popcnt(key_ref(i,ispin)),parity_filled) + parity_filled = iand(int(popcnt(key_ref(i,ispin)),bit_kind),parity_filled) enddo ! get parity due to orbs in same int as iorb ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 - parity_filled = iand(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),parity_filled) + parity_filled = iand(int(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),bit_kind),parity_filled) phase = p(iand(1_bit_kind,parity_filled)) end -BEGIN_PROVIDER [ double precision, mo_mono_elec_integral_diag,(mo_tot_num)] - implicit none - integer :: i - BEGIN_DOC - ! diagonal elements of mo_mono_elec_integral array - END_DOC - print*,'Providing the mono electronic integrals (diagonal)' - - do i = 1, mo_tot_num - mo_mono_elec_integral_diag(i) = real(mo_mono_elec_integral(i,i)) - enddo - -END_PROVIDER +!BEGIN_PROVIDER [ double precision, mo_mono_elec_integral_diag,(mo_num)] +! implicit none +! integer :: i +! BEGIN_DOC +! ! diagonal elements of mo_mono_elec_integral array +! END_DOC +! print*,'Providing the mono electronic integrals (diagonal)' +! +! do i = 1, mo_num +! mo_mono_elec_integral_diag(i) = real(mo_mono_elec_integral(i,i)) +! enddo +! +!END_PROVIDER diff --git a/src/utils/constants.include.F b/src/utils/constants.include.F index 7399b4a6..bad68054 100644 --- a/src/utils/constants.include.F +++ b/src/utils/constants.include.F @@ -7,6 +7,7 @@ double precision, parameter :: sqpi = dsqrt(dacos(-1.d0)) double precision, parameter :: pi_5_2 = 34.9868366552d0 double precision, parameter :: dfour_pi = 4.d0*dacos(-1.d0) double precision, parameter :: dtwo_pi = 2.d0*dacos(-1.d0) +double precision, parameter :: inv_pi = 1.d0/dacos(-1.d0) double precision, parameter :: inv_sq_pi = 1.d0/dsqrt(dacos(-1.d0)) double precision, parameter :: inv_sq_pi_2 = 0.5d0/dsqrt(dacos(-1.d0)) double precision, parameter :: thresh = 1.d-15 From 227c139895efb89f12b0b84f2b93b71204babfae Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 13:36:00 -0500 Subject: [PATCH 215/256] smaller three to four index transformation --- src/mo_two_e_ints/df_mo_ints.irp.f | 212 ++++++++++++++++++++++++ src/mo_two_e_ints/mo_bi_integrals.irp.f | 3 +- 2 files changed, 214 insertions(+), 1 deletion(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index dbb10782..c9d03e0c 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -19,6 +19,218 @@ BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_ END_PROVIDER +subroutine mo_map_fill_from_df_single + use map_module + implicit none + BEGIN_DOC + ! fill mo bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_mo,j_mo,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) + + complex*16 :: integral + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: mo_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + + mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt + + size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000) + print*, 'Providing the mo_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(mo_num_per_kpt,mo_num_per_kpt,df_num)) + allocate( ints_ik(mo_num_per_kpt,mo_num_per_kpt,df_num)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2)) + enddo + enddo + enddo + else + ints_jl = df_mo_integrals_complex(:,:,:,kjkl2) + endif + + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + call idx2_tri_int(ki,kk,kikk2) + if (ki < kk) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + ints_ik = df_mo_integrals_complex(:,:,:,kikk2) + endif + + !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP ki,kk,kikk2,ints_ik, & + !$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, & + !$OMP mo_integrals_map, mo_integrals_map_2) + + allocate( & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + n_integrals_1=0 + n_integrals_2=0 + !$OMP DO SCHEDULE(guided) + do mu=1,df_num + do il=1,mo_num_per_kpt + l=il+(kl-1)*mo_num_per_kpt + do ij=1,mo_num_per_kpt + j=ij+(kj-1)*mo_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + mjl = ints_jl(ij,il,mu) + if (mjl.eq.(0.d0,0.d0)) cycle + do ik=1,mo_num_per_kpt + k=ik+(kk-1)*mo_num_per_kpt + if (k>l) exit + do ii=1,mo_num_per_kpt + i=ii+(ki-1)*mo_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + mik = ints_ik(ii,ik,mu) + integral = mik * dconjg(mjl) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < mo_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + enddo !mu + !$OMP END DO NOWAIT + + if (n_integrals_1 > 0) then + !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + endif + if (n_integrals_2 > 0) then + !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + endif + deallocate( & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kk + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl,ints_ik ) + + !call map_sort(mo_integrals_map) + !call map_unique(mo_integrals_map) + !call map_sort(mo_integrals_map_2) + !call map_unique(mo_integrals_map_2) + call map_merge(mo_integrals_map) + call map_merge(mo_integrals_map_2) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) + !!call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_map_size, mo_map_size + mo_map_size = get_mo_map_size() + + print*,'MO integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine mo_map_fill_from_df_single + subroutine mo_map_fill_from_df use map_module implicit none diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index 21422ba3..a4b3530e 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -43,7 +43,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] return else if (read_df_mo_integrals.or.read_df_ao_integrals) then PROVIDE df_mo_integrals_complex - call mo_map_fill_from_df + !call mo_map_fill_from_df + call mo_map_fill_from_df_single return else PROVIDE ao_two_e_integrals_in_map From fc8abcbf0a081a7393edc79b9bcdcde92d9447b3 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 16:10:16 -0500 Subject: [PATCH 216/256] minor fix --- src/mo_two_e_ints/df_mo_ints.irp.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index c9d03e0c..9bc1e3c0 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -26,7 +26,7 @@ subroutine mo_map_fill_from_df_single ! fill mo bielec integral map using 3-index df integrals END_DOC - integer :: i,k,j,l + integer :: i,k,j,l,mu integer :: ki,kk,kj,kl integer :: ii,ik,ij,il integer :: kikk2,kjkl2,jl2,ik2 @@ -34,7 +34,7 @@ subroutine mo_map_fill_from_df_single complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) - complex*16 :: integral + complex*16 :: integral,mjl,mik integer :: n_integrals_1, n_integrals_2 integer :: size_buffer integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) @@ -97,6 +97,7 @@ subroutine mo_map_fill_from_df_single endif !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP mu, mik, mjl, & !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & From 1c14b837c298f3122ac97214f45dea5b0a03a7e4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 18:16:36 -0500 Subject: [PATCH 217/256] int type --- src/utils_complex/export_integrals_ao_cplx.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils_complex/export_integrals_ao_cplx.irp.f b/src/utils_complex/export_integrals_ao_cplx.irp.f index d24a51e2..7d40ba76 100644 --- a/src/utils_complex/export_integrals_ao_cplx.irp.f +++ b/src/utils_complex/export_integrals_ao_cplx.irp.f @@ -159,7 +159,7 @@ provide ao_two_e_integrals_in_map if (cdabs(tmp_cmplx-int2e_tmp1).gt.thr0) then print'(4(I4),4(E15.7))',i,j,k,l,tmp_cmplx,int2e_tmp1 endif - integer*8 :: ii + integer :: ii ii = l-ao_integrals_cache_min ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) From fee0ae8680fa36d376a69048e910acb9ebdd4c6c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 2 Jun 2020 18:17:15 -0500 Subject: [PATCH 218/256] better mo transformation --- src/mo_two_e_ints/df_mo_ints.irp.f | 230 +++++++++++++++++++++++- src/mo_two_e_ints/mo_bi_integrals.irp.f | 3 +- 2 files changed, 228 insertions(+), 5 deletions(-) diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 9bc1e3c0..3a61911e 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -19,6 +19,228 @@ BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_ END_PROVIDER +subroutine mo_map_fill_from_df_dot + use map_module + implicit none + BEGIN_DOC + ! fill mo bielec integral map using 3-index df integrals + END_DOC + + integer :: i,k,j,l,mu + integer :: ki,kk,kj,kl + integer :: ii,ik,ij,il + integer :: kikk2,kjkl2,jl2,ik2 + integer :: i_mo,j_mo,i_df + + complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:) + + complex*16 :: integral,mjl,mik + integer :: n_integrals_1, n_integrals_2 + integer :: size_buffer + integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:) + real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:) + double precision :: tmp_re,tmp_im + integer :: mo_num_kpt_2 + + double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 + double precision :: map_mb + + logical :: use_map1 + integer(key_kind) :: idx_tmp + double precision :: sign + complex*16, external :: zdotc + + mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt + + size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000) + print*, 'Providing the mo_bielec integrals from 3-index df integrals' + call write_time(6) +! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write') +! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals + + call wall_time(wall_1) + call cpu_time(cpu_1) + + allocate( ints_jl(df_num,mo_num_per_kpt,mo_num_per_kpt)) + allocate( ints_ik(df_num,mo_num_per_kpt,mo_num_per_kpt)) + + wall_0 = wall_1 + do kl=1, kpt_num + do kj=1, kl + call idx2_tri_int(kj,kl,kjkl2) + if (kj < kl) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_df,i_mo,j_mo) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2)) + enddo + enddo + enddo + else + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_jl(i_df,i_mo,j_mo) = df_mo_integrals_complex(i_mo,j_mo,i_df,kjkl2) + enddo + enddo + enddo + endif + + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + call idx2_tri_int(ki,kk,kikk2) + if (ki < kk) then + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_df,i_mo,j_mo) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2)) + enddo + enddo + enddo +! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/))) + else + do i_mo=1,mo_num_per_kpt + do j_mo=1,mo_num_per_kpt + do i_df=1,df_num + ints_ik(i_df,i_mo,j_mo) = df_mo_integrals_complex(i_mo,j_mo,i_df,kikk2) + enddo + enddo + enddo + endif + + !$OMP PARALLEL PRIVATE(i,k,j,l,ii,ik,ij,il,jl2,ik2, & + !$OMP mu, mik, mjl, & + !$OMP n_integrals_1, buffer_i_1, buffer_values_1, & + !$OMP n_integrals_2, buffer_i_2, buffer_values_2, & + !$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) & + !$OMP DEFAULT(NONE) & + !$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, & + !$OMP kl,kj,kjkl2,ints_jl, & + !$OMP ki,kk,kikk2,ints_ik, & + !$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, & + !$OMP mo_integrals_map, mo_integrals_map_2) + + allocate( & + buffer_i_1(size_buffer), & + buffer_i_2(size_buffer), & + buffer_values_1(size_buffer), & + buffer_values_2(size_buffer) & + ) + + n_integrals_1=0 + n_integrals_2=0 + !$OMP DO SCHEDULE(guided) + do il=1,mo_num_per_kpt + l=il+(kl-1)*mo_num_per_kpt + do ij=1,mo_num_per_kpt + j=ij+(kj-1)*mo_num_per_kpt + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do ik=1,mo_num_per_kpt + k=ik+(kk-1)*mo_num_per_kpt + if (k>l) exit + do ii=1,mo_num_per_kpt + i=ii+(ki-1)*mo_num_per_kpt + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) +! print*,i,k,j,l,real(integral),imag(integral) + if (cdabs(integral) < mo_integrals_threshold) then + cycle + endif + call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign) + tmp_re = dble(integral) + tmp_im = dimag(integral) + if (use_map1) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp + buffer_values_1(n_integrals_1)=tmp_re + if (sign.ne.0.d0) then + n_integrals_1 += 1 + buffer_i_1(n_integrals_1)=idx_tmp+1 + buffer_values_1(n_integrals_1)=tmp_im*sign + endif + if (n_integrals_1 >= size(buffer_i_1)-1) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) + n_integrals_1 = 0 + endif + else + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp + buffer_values_2(n_integrals_2)=tmp_re + if (sign.ne.0.d0) then + n_integrals_2 += 1 + buffer_i_2(n_integrals_2)=idx_tmp+1 + buffer_values_2(n_integrals_2)=tmp_im*sign + endif + if (n_integrals_2 >= size(buffer_i_2)-1) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) + n_integrals_2 = 0 + endif + endif + + enddo !ii + enddo !ik + enddo !ij + enddo !il + !$OMP END DO NOWAIT + + if (n_integrals_1 > 0) then + call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) + !call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) + endif + if (n_integrals_2 > 0) then + call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) + !call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) + endif + deallocate( & + buffer_i_1, & + buffer_i_2, & + buffer_values_1, & + buffer_values_2 & + ) + !$OMP END PARALLEL + enddo !kk + enddo !kj + call wall_time(wall_2) + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + print*, 100.*float(kl)/float(kpt_num), '% in ', & + wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + endif + + enddo !kl + deallocate( ints_jl,ints_ik ) + + call map_sort(mo_integrals_map) + call map_unique(mo_integrals_map) + call map_sort(mo_integrals_map_2) + call map_unique(mo_integrals_map_2) + !call map_merge(mo_integrals_map) + !call map_merge(mo_integrals_map_2) + + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map) + !!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2) + !!call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_map_size, mo_map_size + mo_map_size = get_mo_map_size() + + print*,'MO integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB' + print*,' Number of MO integrals: ', mo_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + +end subroutine mo_map_fill_from_df_dot + subroutine mo_map_fill_from_df_single use map_module implicit none @@ -155,7 +377,7 @@ subroutine mo_map_fill_from_df_single endif if (n_integrals_1 >= size(buffer_i_1)-1) then !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) - call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) n_integrals_1 = 0 endif else @@ -169,7 +391,7 @@ subroutine mo_map_fill_from_df_single endif if (n_integrals_2 >= size(buffer_i_2)-1) then !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) - call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) n_integrals_2 = 0 endif endif @@ -183,11 +405,11 @@ subroutine mo_map_fill_from_df_single if (n_integrals_1 > 0) then !call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1) - call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1) + call insert_into_mo_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1,mo_integrals_threshold) endif if (n_integrals_2 > 0) then !call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2) - call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2) + call insert_into_mo_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2,mo_integrals_threshold) endif deallocate( & buffer_i_1, & diff --git a/src/mo_two_e_ints/mo_bi_integrals.irp.f b/src/mo_two_e_ints/mo_bi_integrals.irp.f index a4b3530e..16322c19 100644 --- a/src/mo_two_e_ints/mo_bi_integrals.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals.irp.f @@ -44,7 +44,8 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_in_map ] else if (read_df_mo_integrals.or.read_df_ao_integrals) then PROVIDE df_mo_integrals_complex !call mo_map_fill_from_df - call mo_map_fill_from_df_single + !call mo_map_fill_from_df_single + call mo_map_fill_from_df_dot return else PROVIDE ao_two_e_integrals_in_map From 335386fa784bd04f1da38bf5c247395635e47891 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 11 Jun 2020 13:32:24 -0500 Subject: [PATCH 219/256] fixed integral transformation; added complex fcidump; fixed kpts bitmasks --- src/bitmask/core_inact_act_virt.irp.f | 10 +-- src/mo_two_e_ints/df_mo_ints.irp.f | 6 +- src/tools/fcidump.irp.f | 91 +++++++++++++++++++++++++++ 3 files changed, 100 insertions(+), 7 deletions(-) diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index d2efef89..ae00d774 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -448,7 +448,7 @@ BEGIN_PROVIDER [ integer, n_core_orb_kpts, (kpt_num)] do k=1,kpt_num n_core_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Core')then n_core_orb_kpts(k) += 1 @@ -469,7 +469,7 @@ BEGIN_PROVIDER [ integer, n_inact_orb_kpts, (kpt_num)] do k=1,kpt_num n_inact_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Inactive')then n_inact_orb_kpts(k) += 1 @@ -490,7 +490,7 @@ BEGIN_PROVIDER [ integer, n_act_orb_kpts, (kpt_num)] do k=1,kpt_num n_act_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Active')then n_act_orb_kpts(k) += 1 @@ -511,7 +511,7 @@ BEGIN_PROVIDER [ integer, n_virt_orb_kpts, (kpt_num)] do k=1,kpt_num n_virt_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Virtual')then n_virt_orb_kpts(k) += 1 @@ -532,7 +532,7 @@ BEGIN_PROVIDER [ integer, n_del_orb_kpts, (kpt_num)] do k=1,kpt_num n_del_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Deleted')then n_del_orb_kpts(k) += 1 diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 3a61911e..eba3b3da 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -48,7 +48,8 @@ subroutine mo_map_fill_from_df_dot logical :: use_map1 integer(key_kind) :: idx_tmp double precision :: sign - complex*16, external :: zdotc + !complex*16, external :: zdotc + complex*16, external :: zdotu mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt @@ -145,7 +146,8 @@ subroutine mo_map_fill_from_df_dot if ((j==l) .and. (i>k)) exit call idx2_tri_int(i,k,ik2) if (ik2 > jl2) exit - integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) + !integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) + integral = zdotu(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) ! print*,i,k,j,l,real(integral),imag(integral) if (cdabs(integral) < mo_integrals_threshold) then cycle diff --git a/src/tools/fcidump.irp.f b/src/tools/fcidump.irp.f index bf4d07fb..de878dc6 100644 --- a/src/tools/fcidump.irp.f +++ b/src/tools/fcidump.irp.f @@ -18,6 +18,97 @@ program fcidump ! electrons ! END_DOC + if (is_complex) then + call fcidump_complex + else + call fcidump_real + endif +end + +subroutine fcidump_complex + implicit none + character*(128) :: output + integer :: i_unit_output,getUnitAndOpen + output=trim(ezfio_filename)//'.FCIDUMP' + i_unit_output = getUnitAndOpen(output,'w') + + integer :: i,j,k,l + integer :: i1,j1,k1,l1 + integer :: i2,j2,k2,l2,ik2,jl2 + integer :: ki,kj,kk,kl + integer :: ii,ij,ik,il + integer*8 :: m + character*(2), allocatable :: A(:) + + write(i_unit_output,*) '&FCI NORB=', n_act_orb, ', NELEC=', elec_num-n_core_orb*2, & + ', MS2=', (elec_alpha_num-elec_beta_num), ',' + allocate (A(n_act_orb)) + A = '1,' + write(i_unit_output,*) 'ORBSYM=', (A(i), i=1,n_act_orb) + write(i_unit_output,*) 'ISYM=0,' + write(i_unit_output,*) '/' + deallocate(A) + + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + integer(cache_map_size_kind) :: n_elements, n_elements_max + PROVIDE mo_two_e_integrals_in_map + + complex*16 :: get_two_e_integral_complex, integral + + do kl=1,kpt_num + do kj=1,kl + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + do l1=1,n_act_orb_kpts(kl) + il=list_act_kpts(l1,kl) + l = (kl-1)*mo_num_per_kpt + il + do j1=1,n_act_orb_kpts(kj) + ij=list_act_kpts(j1,kj) + j = (kj-1)*mo_num_per_kpt + ij + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do k1=1,n_act_orb_kpts(kk) + ik=list_act_kpts(k1,kk) + k = (kk-1)*mo_num_per_kpt + ik + if (k>l) exit + do i1=1,n_act_orb_kpts(ki) + ii=list_act_kpts(i1,ki) + i = (ki-1)*mo_num_per_kpt + ii + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + if (cdabs(integral) > mo_integrals_threshold) then + write(i_unit_output,'(2(E25.15,X),4(I6,X))') dble(integral), dimag(integral),i,k,j,l + endif + enddo + enddo + enddo + enddo + enddo + enddo + enddo + + do kj=1,kpt_num + do j1=1,n_act_orb_kpts(kj) + ij = list_act_kpts(j1,kj) + j = (kj-1)*mo_num_per_kpt + ij + do i1=j1,n_act_orb_kpts(kj) + ii = list_act_kpts(i1,kj) + i = (kj-1)*mo_num_per_kpt + ii + integral = mo_one_e_integrals_kpts(ii,ij,kj) + core_fock_operator_complex(i,j) + if (cdabs(integral) > mo_integrals_threshold) then + write(i_unit_output,'(2(E25.15,X),4(I6,X))') dble(integral),dimag(integral), i,j,0,0 + endif + enddo + enddo + enddo + write(i_unit_output,*) core_energy, 0, 0, 0, 0 +end +subroutine fcidump_real + implicit none character*(128) :: output integer :: i_unit_output,getUnitAndOpen output=trim(ezfio_filename)//'.FCIDUMP' From d3286b7e4996a77a2fd785f84c2468666f6f257b Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 11 Jun 2020 13:45:24 -0500 Subject: [PATCH 220/256] remove green from base (untested) --- src/green/EZFIO.cfg | 101 ---- src/green/NEED | 1 - src/green/README.rst | 6 - src/green/green.main.irp.f | 51 -- src/green/hu0_hp.irp.f | 847 -------------------------- src/green/hu0_lanczos.irp.f | 405 ------------- src/green/lanczos.irp.f | 883 ---------------------------- src/green/plot-spec-dens.py | 90 --- src/green/print_dets_test.irp.f | 15 - src/green/print_e_mo_debug.irp.f | 15 - src/green/print_h_debug.irp.f | 178 ------ src/green/print_h_omp_debug.irp.f | 41 -- src/green/print_spectral_dens.irp.f | 43 -- src/green/utils_hp.irp.f | 614 ------------------- 14 files changed, 3290 deletions(-) delete mode 100644 src/green/EZFIO.cfg delete mode 100644 src/green/NEED delete mode 100644 src/green/README.rst delete mode 100644 src/green/green.main.irp.f delete mode 100644 src/green/hu0_hp.irp.f delete mode 100644 src/green/hu0_lanczos.irp.f delete mode 100644 src/green/lanczos.irp.f delete mode 100755 src/green/plot-spec-dens.py delete mode 100644 src/green/print_dets_test.irp.f delete mode 100644 src/green/print_e_mo_debug.irp.f delete mode 100644 src/green/print_h_debug.irp.f delete mode 100644 src/green/print_h_omp_debug.irp.f delete mode 100644 src/green/print_spectral_dens.irp.f delete mode 100644 src/green/utils_hp.irp.f diff --git a/src/green/EZFIO.cfg b/src/green/EZFIO.cfg deleted file mode 100644 index 0ad57888..00000000 --- a/src/green/EZFIO.cfg +++ /dev/null @@ -1,101 +0,0 @@ -[n_lanczos_complete] -type: integer -doc: number of lanczos iterations completed -interface: ezfio,provider,ocaml -default: 0 - -[n_lanczos_iter] -type: integer -doc: number of lanczos iterations -interface: ezfio,provider,ocaml -default: 10 - -[omega_min] -type: double precision -doc: lower limit of frequency for spectral density calculation -interface: ezfio,provider,ocaml -default: -2.e-1 - -[omega_max] -type: double precision -doc: upper limit of frequency for spectral density calculation -interface: ezfio,provider,ocaml -default: 1.2e1 - -[n_omega] -type: integer -doc: number of points for spectral density calculation -interface: ezfio,provider,ocaml -default: 1000 - -[gf_epsilon] -type: double precision -doc: infinitesimal imaginary frequency term in Green's function -interface: ezfio,provider,ocaml -default: 1.e-2 - -[n_green_vec] -type: integer -doc: number of holes/particles -interface: ezfio -default: 2 - -[green_idx] -interface: ezfio -doc: homo/lumo indices -type: integer -size: (green.n_green_vec) - -[green_spin] -interface: ezfio -doc: homo/lumo spin -type: integer -size: (green.n_green_vec) - -[green_sign] -interface: ezfio -doc: homo/lumo sign -type: double precision -size: (green.n_green_vec) - -[alpha_lanczos] -interface: ezfio -doc: lanczos alpha values -type: double precision -size: (green.n_lanczos_iter,green.n_green_vec) - -[beta_lanczos] -interface: ezfio -doc: lanczos beta values -type: double precision -size: (green.n_lanczos_iter,green.n_green_vec) - -[un_lanczos] -interface: ezfio -doc: saved lanczos u vector -type: double precision -size: (2,determinants.n_det,green.n_green_vec) - -[vn_lanczos] -interface: ezfio -doc: saved lanczos v vector -type: double precision -size: (2,determinants.n_det,green.n_green_vec) - -[lanczos_eigvals] -interface: ezfio -doc: eigvals of tridiagonal form of H -type: double precision -size: (green.n_lanczos_iter,green.n_green_vec) - -[lanczos_debug_print] -interface: ezfio,provider,ocaml -type: logical -doc: printing of lanczos vectors at every step -default: False - -[n_lanczos_debug] -interface: ezfio,provider,ocaml -type: integer -doc: number of elements to print -default: 10 diff --git a/src/green/NEED b/src/green/NEED deleted file mode 100644 index 4315d882..00000000 --- a/src/green/NEED +++ /dev/null @@ -1 +0,0 @@ -davidson fci diff --git a/src/green/README.rst b/src/green/README.rst deleted file mode 100644 index 6bdb2ca7..00000000 --- a/src/green/README.rst +++ /dev/null @@ -1,6 +0,0 @@ -===== -dummy -===== - -Module necessary to avoid the ``xxx is a root module but does not contain a main file`` message. - diff --git a/src/green/green.main.irp.f b/src/green/green.main.irp.f deleted file mode 100644 index 3fe26424..00000000 --- a/src/green/green.main.irp.f +++ /dev/null @@ -1,51 +0,0 @@ -program green - implicit none - BEGIN_DOC -! TODO - END_DOC - read_wf = .True. - touch read_wf - provide n_green_vec - print*,'ref_bitmask_energy = ',ref_bitmask_energy -! call psicoefprinttest - call print_lanczos_eigvals - call print_spec -end - -subroutine psicoefprinttest - implicit none - integer :: i - TOUCH psi_coef_complex - print *, 'printing ndet', N_det -end -subroutine print_lanczos_eigvals - implicit none - integer :: i, iunit, j - integer :: getunitandopen - character(5) :: jstr - - do j=1,n_green_vec - write(jstr,'(I0.3)') j - iunit = getunitandopen('lanczos_eigval_alpha_beta.out.'//trim(jstr),'w') - print *, 'printing lanczos eigenvalues, alpha, beta to "lanczos_eigval_alpha_beta.out.'//trim(jstr)//'"' - do i=1,n_lanczos_iter - write(iunit,'(I6,3(E25.15))') i, lanczos_eigvals(i,j), alpha_lanczos(i,j), beta_lanczos(i,j) - enddo - close(iunit) - enddo -end -subroutine print_spec - implicit none - integer :: i, iunit, j - integer :: getunitandopen - character(5) :: jstr - do j=1,n_green_vec - write(jstr,'(I0.3)') j - iunit = getunitandopen('omega_A.out.'//trim(jstr),'w') - print *, 'printing frequency, spectral density to "omega_A.out.'//trim(jstr)//'"' - do i=1,n_omega - write(iunit,'(2(E25.15))') omega_list(i), spectral_lanczos(i,j) - enddo - close(iunit) - enddo -end diff --git a/src/green/hu0_hp.irp.f b/src/green/hu0_hp.irp.f deleted file mode 100644 index 4fa7275f..00000000 --- a/src/green/hu0_hp.irp.f +++ /dev/null @@ -1,847 +0,0 @@ -! modified from H_S2_u_0_nstates_openmp in Davidson/u0Hu0.irp.f - -subroutine h_u_0_hp_openmp(v_0,u_0,N_hp,sze,spin_hp,sign_hp,idx_hp) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> - ! - ! Assumes that the determinants are in psi_det - ! - ! istart, iend, ishift, istep are used in ZMQ parallelization. - ! - ! N_hp is number of holes and particles to be applied - ! each element of spin_hp is either 1(alpha) or 2(beta) - ! each element of sign_hp is either 1(particle) or -1(hole) - ! idx_hp contains orbital indices for holes and particles - END_DOC - integer, intent(in) :: N_hp,sze - complex*16, intent(inout) :: v_0(sze,N_hp), u_0(sze,N_hp) - integer :: k - complex*16, allocatable :: u_t(:,:), v_t(:,:) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t - allocate(u_t(N_hp,N_det),v_t(N_hp,N_det)) - do k=1,N_hp - call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) - enddo - v_t = (0.d0,0.d0) - call cdtranspose( & - u_0, & - size(u_0, 1), & - u_t, & - size(u_t, 1), & - N_det, N_hp) - - call h_u_0_hp_openmp_work(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,1,N_det,0,1) - deallocate(u_t) - - call cdtranspose( & - v_t, & - size(v_t, 1), & - v_0, & - size(v_0, 1), & - N_hp, N_det) - deallocate(v_t) - - do k=1,N_hp - call cdset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det) - call cdset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det) - enddo - -end - - -subroutine h_u_0_hp_openmp_work(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_t = H|u_t> - ! - ! Default should be 1,N_det,0,1 - END_DOC - integer, intent(in) :: N_hp,sze,istart,iend,ishift,istep - complex*16, intent(in) :: u_t(N_hp,N_det) - complex*16, intent(out) :: v_t(N_hp,sze) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - - - PROVIDE ref_bitmask_energy N_int - - select case (N_int) - case (1) - call H_u_0_hp_openmp_work_1(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - case (2) - call H_u_0_hp_openmp_work_2(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - case (3) - call H_u_0_hp_openmp_work_3(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - case (4) - call H_u_0_hp_openmp_work_4(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - case default - call H_u_0_hp_openmp_work_N_int(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - end select -end -BEGIN_TEMPLATE - -subroutine h_u_0_hp_openmp_work_$N_int(v_t,u_t,N_hp,sze,spin_hp,sign_hp,idx_hp,istart,iend,ishift,istep) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_t = H|u_t> and s_t = S^2 |u_t> - ! - ! Default should be 1,N_det,0,1 - END_DOC - integer, intent(in) :: N_hp,sze,istart,iend,ishift,istep - complex*16, intent(in) :: u_t(N_hp,N_det) - complex*16, intent(out) :: v_t(N_hp,sze) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - - complex*16 :: hij - double precision :: hii - integer :: i,j,k,l - integer :: k_a, k_b, l_a, l_b, m_a, m_b - integer :: istate - integer :: krow, kcol, krow_b, kcol_b - integer :: lrow, lcol - integer :: mrow, mcol - integer(bit_kind) :: spindet($N_int) - integer(bit_kind) :: tmp_det($N_int,2) - integer(bit_kind) :: tmp_det2($N_int,2) - integer(bit_kind) :: tmp_det3($N_int,2) - integer(bit_kind), allocatable :: buffer(:,:) - integer :: n_doubles - integer, allocatable :: doubles(:) - integer, allocatable :: singles_a(:) - integer, allocatable :: singles_b(:) - integer, allocatable :: idx(:), idx0(:) - integer :: maxab, n_singles_a, n_singles_b, kcol_prev - integer*8 :: k8 - - logical, allocatable :: exc_is_banned_a1(:),exc_is_banned_b1(:),exc_is_banned_a2(:),exc_is_banned_b2(:) - logical, allocatable :: exc_is_banned_ab1(:),exc_is_banned_ab12(:),allowed_hp(:) - logical :: all_banned_a1,all_banned_b1,all_banned_a2,all_banned_b2 - logical :: all_banned_ab12,all_banned_ab1 - integer :: ii,na,nb - double precision, allocatable :: hii_hp(:) - complex*16, allocatable :: hij_hp(:) - - maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 - allocate(idx0(maxab)) - - do i=1,maxab - idx0(i) = i - enddo - - ! Prepare the array of all alpha single excitations - ! ------------------------------------------------- - - PROVIDE N_int nthreads_davidson elec_num - !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthreads_davidson) & - !$OMP SHARED(psi_bilinear_matrix_rows, N_det, & - !$OMP psi_bilinear_matrix_columns, & - !$OMP psi_det_alpha_unique, psi_det_beta_unique, & - !$OMP n_det_alpha_unique, n_det_beta_unique, N_int, & - !$OMP psi_bilinear_matrix_transp_rows, & - !$OMP psi_bilinear_matrix_transp_columns, & - !$OMP psi_bilinear_matrix_transp_order, N_hp, & - !$OMP psi_bilinear_matrix_order_transp_reverse, & - !$OMP psi_bilinear_matrix_columns_loc, & - !$OMP psi_bilinear_matrix_transp_rows_loc, & - !$OMP istart, iend, istep, irp_here, v_t, & - !$OMP spin_hp,sign_hp,idx_hp, & - !$OMP elec_num_tab,nuclear_repulsion, & - !$OMP ishift, idx0, u_t, maxab) & - !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & - !$OMP lcol, lrow, l_a, l_b, & - !$OMP buffer, doubles, n_doubles, & - !$OMP tmp_det2, hii, hij, idx, l, kcol_prev, & - !$OMP singles_a, n_singles_a, singles_b, & - !$OMP exc_is_banned_a1,exc_is_banned_b1,exc_is_banned_ab1, & - !$OMP exc_is_banned_a2,exc_is_banned_b2,exc_is_banned_ab12, & - !$OMP all_banned_a1,all_banned_b1,all_banned_ab1, & - !$OMP all_banned_a2,all_banned_b2,all_banned_ab12, & - !$OMP allowed_hp, & - !$OMP ii, hij_hp, j, hii_hp,na,nb, & - !$OMP n_singles_b, k8) - - ! Alpha/Beta double excitations - ! ============================= - - allocate( buffer($N_int,maxab), & - singles_a(maxab), & - singles_b(maxab), & - doubles(maxab), & - idx(maxab), & - exc_is_banned_a1(N_hp), & - exc_is_banned_b1(N_hp), & - exc_is_banned_a2(N_hp), & - exc_is_banned_b2(N_hp), & - exc_is_banned_ab1(N_hp), & - exc_is_banned_ab12(N_hp), & - allowed_hp(N_hp), & - hij_hp(N_hp), & - hii_hp(N_hp)) - - kcol_prev=-1 - all_banned_b1=.False. - ASSERT (iend <= N_det) - ASSERT (istart > 0) - ASSERT (istep > 0) - - !$OMP DO SCHEDULE(dynamic,64) - do k_a=istart+ishift,iend,istep - ! iterate over dets in psi - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - if (kcol /= kcol_prev) then !if we've moved to a new unique beta determinant - call get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned_b1,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b1) - if (all_banned_b1) then - kcol_prev = kcol - cycle - else ! get all unique beta dets connected to this one by a single excitation - call get_all_spin_singles_$N_int( & - psi_det_beta_unique, idx0, & - tmp_det(1,2), N_det_beta_unique, & - singles_b, n_singles_b) - kcol_prev = kcol - endif - else - if (all_banned_b1) cycle - endif - - ! at least some beta allowed - ! check alpha - call get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned_a1,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a1) - if (all_banned_a1) cycle - - all_banned_ab1=.True. - do ii=1,N_hp - exc_is_banned_ab1(ii)=(exc_is_banned_a1(ii).or.exc_is_banned_b1(ii)) - all_banned_ab1 = (all_banned_ab1.and.exc_is_banned_ab1(ii)) - enddo - if (all_banned_ab1) cycle -! kcol_prev = kcol ! keep track of old col to see when we've moved to a new one - - ! Loop over singly excited beta columns - ! ------------------------------------- - - do i=1,n_singles_b ! loop over other columns in this row - lcol = singles_b(i) - - tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol) - - call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) - if (all_banned_b2) cycle - - l_a = psi_bilinear_matrix_columns_loc(lcol) ! location of start of this column within psi_bilinear_mat - ASSERT (l_a <= N_det) - - do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - l_a ! loop over rows in this column - lrow = psi_bilinear_matrix_rows(l_a) ! get row (index of unique alpha det) - ASSERT (lrow <= N_det_alpha_unique) - - buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! get alpha det - - ASSERT (l_a <= N_det) - idx(j) = l_a ! indices of dets within psi_bilinear_mat - l_a = l_a+1 - enddo - j = j-1 - ! get all alpha dets in this column that are connected to ref alpha by a single exc. - call get_all_spin_singles_$N_int( & - buffer, idx, tmp_det(1,1), j, & - singles_a, n_singles_a ) - - ! Loop over alpha singles - ! ----------------------- - - do k = 1,n_singles_a - l_a = singles_a(k) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) - if (all_banned_a2) cycle - all_banned_ab12 = .True. - do ii=1,N_hp - exc_is_banned_ab12(ii)=((exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)).or.exc_is_banned_a2(ii)) - allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) - all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) - enddo - if (all_banned_ab12) cycle - call i_h_j_double_alpha_beta_hp(tmp_det,tmp_det2,$N_int,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - do l=1,N_hp - v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP DO SCHEDULE(dynamic,64) - do k_a=istart+ishift,iend,istep - - - ! Single and double alpha excitations - ! =================================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) - if (all_banned_ab1) cycle - - - ! Initial determinant is at k_b in beta-major representation - ! ---------------------------------------------------------------------- - - k_b = psi_bilinear_matrix_order_transp_reverse(k_a) - ASSERT (k_b <= N_det) - - spindet(1:$N_int) = tmp_det(1:$N_int,1) - - ! Loop inside the beta column to gather all the connected alphas - lcol = psi_bilinear_matrix_columns(k_a) - l_a = psi_bilinear_matrix_columns_loc(lcol) - do i=1,N_det_alpha_unique - if (l_a > N_det) exit - lcol = psi_bilinear_matrix_columns(l_a) - if (lcol /= kcol) exit - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) - idx(i) = l_a - l_a = l_a+1 - enddo - i = i-1 - - !call get_all_spin_singles_and_doubles_$N_int( & - ! buffer, idx, spindet, i, & - ! singles_a, doubles, n_singles_a, n_doubles ) - call get_all_spin_singles_and_doubles( & - buffer, idx, spindet, $N_int, i, & - singles_a, doubles, n_singles_a, n_doubles ) - - ! Compute Hij for all alpha singles - ! ---------------------------------- - - tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - do i=1,n_singles_a - l_a = singles_a(i) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) - if (all_banned_a2) cycle - all_banned_ab12 = .True. - do ii=1,N_hp - exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_a2(ii)) - allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) - all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) - enddo - if (all_banned_ab12) cycle - call i_h_j_mono_spin_hp(tmp_det,tmp_det2,$N_int,1, hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - - do l=1,N_hp - v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) - ! single => sij = 0 - enddo - enddo - - ! Compute Hij for all alpha doubles - ! ---------------------------------- - - do i=1,n_doubles - l_a = doubles(i) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - call get_list_hp_banned_single_spin(psi_det_alpha_unique(1,lrow),N_hp,exc_is_banned_a2,spin_hp,sign_hp,idx_hp,1,$N_int,all_banned_a2) - if (all_banned_a2) cycle - all_banned_ab12 = .True. - do ii=1,N_hp - exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_a2(ii)) - allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) - all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) - enddo - if (all_banned_ab12) cycle - call i_h_j_double_spin_hp( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int,1,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - do l=1,N_hp - v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) - ! same spin => sij = 0 - enddo - enddo - - - ! Single and double beta excitations - ! ================================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - kcol = psi_bilinear_matrix_columns(k_a) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - !! should already be done from top of loop? - !call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) - !if (all_banned_ab1) cycle - - spindet(1:$N_int) = tmp_det(1:$N_int,2) - - ! Initial determinant is at k_b in beta-major representation - ! ----------------------------------------------------------------------- - - k_b = psi_bilinear_matrix_order_transp_reverse(k_a) - ASSERT (k_b <= N_det) - - ! Loop inside the alpha row to gather all the connected betas - lrow = psi_bilinear_matrix_transp_rows(k_b) - l_b = psi_bilinear_matrix_transp_rows_loc(lrow) - do i=1,N_det_beta_unique - if (l_b > N_det) exit - lrow = psi_bilinear_matrix_transp_rows(l_b) - if (lrow /= krow) exit - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol) - idx(i) = l_b - l_b = l_b+1 - enddo - i = i-1 - - !call get_all_spin_singles_and_doubles_$N_int( & - ! buffer, idx, spindet, i, & - ! singles_b, doubles, n_singles_b, n_doubles ) - call get_all_spin_singles_and_doubles( & - buffer, idx, spindet, $N_int, i, & - singles_b, doubles, n_singles_b, n_doubles ) - - ! Compute Hij for all beta singles - ! ---------------------------------- - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - do i=1,n_singles_b - l_b = singles_b(i) - ASSERT (l_b <= N_det) - - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) - call get_list_hp_banned_spin(tmp_det2,N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) - if (all_banned_b2) cycle - all_banned_ab12 = .True. - do ii=1,N_hp - exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)) - allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) - all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) - enddo - if (all_banned_ab12) cycle - call i_h_j_mono_spin_hp(tmp_det,tmp_det2,$N_int,2, hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - l_a = psi_bilinear_matrix_transp_order(l_b) - ASSERT (l_a <= N_det) - do l=1,N_hp - v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) - ! single => sij = 0 - enddo - enddo - - ! Compute Hij for all beta doubles - ! ---------------------------------- - - do i=1,n_doubles - l_b = doubles(i) - ASSERT (l_b <= N_det) - - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - call get_list_hp_banned_single_spin(psi_det_beta_unique(1,lcol),N_hp,exc_is_banned_b2,spin_hp,sign_hp,idx_hp,2,$N_int,all_banned_b2) - if (all_banned_b2) cycle - all_banned_ab12 = .True. - do ii=1,N_hp - exc_is_banned_ab12(ii)=(exc_is_banned_ab1(ii).or.exc_is_banned_b2(ii)) - allowed_hp(ii)=(.not.exc_is_banned_ab12(ii)) - all_banned_ab12 = (all_banned_ab12.and.exc_is_banned_ab12(ii)) - enddo - if (all_banned_ab12) cycle - call i_h_j_double_spin_hp( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int,2,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - l_a = psi_bilinear_matrix_transp_order(l_b) - ASSERT (l_a <= N_det) - - do l=1,N_hp - v_t(l,k_a) = v_t(l,k_a) + hij_hp(l) * u_t(l,l_a) - ! same spin => sij = 0 - enddo - enddo - - - ! Diagonal contribution - ! ===================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - call get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned_ab1,spin_hp,sign_hp,idx_hp,$N_int,all_banned_ab1) - if (all_banned_ab1) cycle - - double precision, external :: diag_H_mat_elem, diag_S_mat_elem - hii = diag_h_mat_elem(tmp_det,$N_int) - - do ii=1,N_hp - if(exc_is_banned_ab1(ii)) then - hii_hp(ii)=0.d0 - else - tmp_det2=tmp_det - na=elec_num_tab(spin_hp(ii)) - nb=elec_num_tab(iand(spin_hp(ii),1)+1) - hii_hp(ii)=hii - if (sign_hp(ii)>0) then - call ac_operator(idx_hp(ii),spin_hp(ii),tmp_det2,hii_hp(ii),$N_int,na,nb) - else - call a_operator(idx_hp(ii),spin_hp(ii),tmp_det2,hii_hp(ii),$N_int,na,nb) - endif - endif - v_t(ii,k_a) = v_t(ii,k_a) + (nuclear_repulsion + hii_hp(ii)) * u_t(ii,k_a) - enddo - - - end do - !$OMP END DO - deallocate(buffer, singles_a, singles_b, doubles, idx, & - exc_is_banned_a1, & - exc_is_banned_b1, & - exc_is_banned_a2, & - exc_is_banned_b2, & - exc_is_banned_ab1, & - exc_is_banned_ab12, & - allowed_hp, & - hij_hp, hii_hp ) - !$OMP END PARALLEL - deallocate(idx0) -end - -SUBST [ N_int ] - -1;; -2;; -3;; -4;; -N_int;; - -END_TEMPLATE - - - -subroutine i_h_j_double_spin_hp(key_i,key_j,Nint,ispin,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - use bitmasks - implicit none - BEGIN_DOC - ! todo: maybe make new get_double_excitation_spin? - ! the 4 index ordering is already done in there, so we could avoid duplicating that work - ! Returns where i and j are determinants differing by a same-spin double excitation - END_DOC - integer, intent(in) :: Nint,ispin,N_hp - integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint) - complex*16, intent(out) :: hij_hp(N_hp) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - logical, intent(in) :: allowed_hp(N_hp) - complex*16 :: hij0 - double precision :: phase_hp(N_hp) - integer :: exc(0:2,2) - double precision :: phase - complex*16, external :: mo_two_e_integral_complex - integer :: i1,i2,i3,i4,j2,j3,ii - - PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map - - call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) - hij0 = phase*(mo_two_e_integral_complex( & - exc(1,1), & - exc(2,1), & - exc(1,2), & - exc(2,2)) - & - mo_two_e_integral_complex( & - exc(1,1), & - exc(2,1), & - exc(2,2), & - exc(1,2)) ) - - ASSERT (exc(1,1) < exc(2,1)) - ASSERT (exc(1,2) < exc(2,2)) - i1=min(exc(1,1),exc(1,2)) - j2=max(exc(1,1),exc(1,2)) - j3=min(exc(2,1),exc(2,2)) - i4=max(exc(2,1),exc(2,2)) - i2=min(j2,j3) - i3=max(j2,j3) - - do ii=1,N_hp - if (allowed_hp(ii)) then - if (ispin.eq.spin_hp(ii)) then - if ((idx_hp(ii).lt.i1).or.(idx_hp(ii).gt.i4)) then - phase_hp(ii)=1.d0 - else if ((idx_hp(ii).lt.i2).or.(idx_hp(ii).gt.i3)) then - phase_hp(ii)=-1.d0 - else - phase_hp(ii)=1.d0 - endif - else - phase_hp(ii)=1.d0 - endif - else - phase_hp(ii)=0.d0 - endif - hij_hp(ii) = hij0 * phase_hp(ii) - enddo -end - -subroutine i_h_j_mono_spin_hp(key_i,key_j,Nint,spin,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - use bitmasks - implicit none - BEGIN_DOC - ! todo: change this to use normal version of get_mono_excitation_from_fock - ! all info needed is in phase and hij, h/p part can happen after getting hij the normal way - ! Returns where i and j are determinants differing by a single excitation - END_DOC - integer, intent(in) :: Nint, spin, N_hp - integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - complex*16, intent(out) :: hij_hp(N_hp) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - logical, intent(in) :: allowed_hp(N_hp) - !double precision :: phase_hp(N_hp) - complex*16 :: hij0 - - integer :: exc(0:2,2) - double precision :: phase - - PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map - - call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) - - call get_single_excitation_from_fock_hp(key_i,key_j,exc(1,1),exc(1,2),spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) -end - -subroutine get_single_excitation_from_fock_hp(det_1,det_2,h,p,spin,phase,N_hp,hij_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - use bitmasks - implicit none - integer,intent(in) :: h,p,spin,N_hp - double precision, intent(in) :: phase - integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2) - complex*16, intent(out) :: hij_hp(N_hp) - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - logical, intent(in) :: allowed_hp(N_hp) - double precision :: phase_hp(N_hp) - complex*16 :: hij0 - integer :: low,high - - integer(bit_kind) :: differences(N_int,2) - integer(bit_kind) :: hole(N_int,2) - integer(bit_kind) :: partcl(N_int,2) - integer :: occ_hole(N_int*bit_kind_size,2) - integer :: occ_partcl(N_int*bit_kind_size,2) - integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) - integer :: i0,i,ii - do i = 1, N_int - differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1)) - differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2)) - hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1)) - hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2)) - partcl(i,1) = iand(differences(i,1),det_1(i,1)) - partcl(i,2) = iand(differences(i,2),det_1(i,2)) - enddo - call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) - call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij0 = fock_op_cshell_ref_bitmask_cplx(h,p) - ! holes :: direct terms - do i0 = 1, n_occ_ab_hole(1) - i = occ_hole(i0,1) - hij0 -= big_array_coulomb_integrals_complex(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) - enddo - do i0 = 1, n_occ_ab_hole(2) - i = occ_hole(i0,2) - hij0 -= big_array_coulomb_integrals_complex(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) - enddo - - ! holes :: exchange terms - do i0 = 1, n_occ_ab_hole(spin) - i = occ_hole(i0,spin) - hij0 += big_array_exchange_integrals_complex(i,h,p) ! get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) - enddo - - ! particles :: direct terms - do i0 = 1, n_occ_ab_partcl(1) - i = occ_partcl(i0,1) - hij0 += big_array_coulomb_integrals_complex(i,h,p)!get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) - enddo - do i0 = 1, n_occ_ab_partcl(2) - i = occ_partcl(i0,2) - hij0 += big_array_coulomb_integrals_complex(i,h,p) !get_mo_bielec_integral_schwartz(h,i,p,i,mo_integrals_map) - enddo - - ! particles :: exchange terms - do i0 = 1, n_occ_ab_partcl(spin) - i = occ_partcl(i0,spin) - hij0 -= big_array_exchange_integrals_complex(i,h,p)!get_mo_bielec_integral_schwartz(h,i,i,p,mo_integrals_map) - enddo - - low=min(h,p) - high=max(h,p) - -!! do ii=1,N_hp -!! if (.not.allowed_hp(ii)) then -!! phase_hp(ii) = 0.d0 -!! cycle -!! else if (spin_hp(ii).ne.spin) then -!! phase_hp(ii) = 1.d0 -!! else -!! if ((low.lt.idx_hp(ii)).and.(high.gt.idx_hp(ii))) then -!! phase_hp(ii) = -1.d0 -!! else -!! phase_hp(ii) = 1.d0 -!! endif -!! endif -!! enddo -!! -!! do ii=1,N_hp -!! if (allowed_hp(ii)) then -!! hij_hp(ii) = hij + sign_hp(ii) * big_array_coulomb_integrals(idx_hp(ii),h,p) -!! if (spin.eq.spin_hp(ii)) then -!! hij_hp(ii) = hij_hp(ii) - sign_hp(ii) * big_array_exchange_integrals(idx_hp(ii),h,p) -!! endif -!! else -!! hij_hp(ii) = 0.d0 -!! endif -!! enddo -!! -!! do ii=1,N_hp -!! hij_hp(ii) = hij_hp(ii) * phase_hp(ii) * phase -!! enddo - - do ii=1,N_hp - if (.not.allowed_hp(ii)) then - phase_hp(ii) = 0.d0 - hij_hp(ii) = 0.d0 - cycle - else if (spin.eq.spin_hp(ii)) then - hij_hp(ii) = hij0 + sign_hp(ii) *(big_array_coulomb_integrals_complex(idx_hp(ii),h,p) - big_array_exchange_integrals_complex(idx_hp(ii),h,p)) - if ((low.lt.idx_hp(ii)).and.(high.gt.idx_hp(ii))) then - phase_hp(ii) = -1.d0 - else - phase_hp(ii) = 1.d0 - endif - else - phase_hp(ii) = 1.d0 - hij_hp(ii) = hij0 + sign_hp(ii) * big_array_coulomb_integrals_complex(idx_hp(ii),h,p) - endif - hij_hp(ii) = hij_hp(ii) * phase * phase_hp(ii) - enddo - -end - - -subroutine i_H_j_double_alpha_beta_hp(key_i,key_j,Nint,hij_hp,N_hp,spin_hp,sign_hp,idx_hp,allowed_hp) - use bitmasks - implicit none - BEGIN_DOC - ! Returns where i and j are determinants differing by an opposite-spin double excitation - END_DOC - integer, intent(in) :: Nint,N_hp - integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) - complex*16, intent(out) :: hij_hp(N_hp) - complex*16 :: hij0 - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - logical, intent(in) :: allowed_hp(N_hp) - double precision :: phase_hp(N_hp) - integer :: i - - integer :: lowhigh(2,2) - integer :: exc(0:2,2,2) - double precision :: phase, phase2 - complex*16, external :: mo_two_e_integral_complex - - PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map - - call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) - call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint) - phase = phase*phase2 - - if (exc(1,1,1) == exc(1,2,2)) then - hij0 = big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) - else if (exc(1,2,1) == exc(1,1,2)) then - hij0 = big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2)) - else - hij0 = mo_two_e_integral_complex( & - exc(1,1,1), & - exc(1,1,2), & - exc(1,2,1), & - exc(1,2,2)) - endif - - !todo: clean this up - ! if new particle/hole is between p/h of single exc of same spin, then parity changes, otherwise stays the same - ! value of Hij for double excitation is unchanged (new p/h is not one of the indices involved in the excitation) - - lowhigh(1,1)=min(exc(1,1,1),exc(1,2,1)) - lowhigh(2,1)=max(exc(1,1,1),exc(1,2,1)) - lowhigh(1,2)=min(exc(1,1,2),exc(1,2,2)) - lowhigh(2,2)=max(exc(1,1,2),exc(1,2,2)) - do i=1,N_hp - if (.not.allowed_hp(i)) then - phase_hp(i)=0.d0 - else if ((idx_hp(i).gt.lowhigh(1,spin_hp(i))).and.(idx_hp(i).lt.lowhigh(2,spin_hp(i)))) then - phase_hp(i)=-1.d0 - else - phase_hp(i)=1.d0 - endif - hij_hp(i)=hij0*phase*phase_hp(i) - enddo -end diff --git a/src/green/hu0_lanczos.irp.f b/src/green/hu0_lanczos.irp.f deleted file mode 100644 index 6f7ebf1d..00000000 --- a/src/green/hu0_lanczos.irp.f +++ /dev/null @@ -1,405 +0,0 @@ -! modified from H_S2_u_0_nstates_openmp in Davidson/u0Hu0.irp.f - -subroutine H_u_0_openmp(v_0,u_0,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> - ! - ! Assumes that the determinants are in psi_det - ! - ! istart, iend, ishift, istep are used in ZMQ parallelization. - END_DOC - integer :: N_st=1 - integer, intent(in) :: sze - complex*16, intent(inout) :: v_0(sze), u_0(sze) - integer :: k - call cdset_order(u_0(1),psi_bilinear_matrix_order,N_det) - v_0 = (0.d0,0.d0) - - call h_u_0_openmp_work(v_0,u_0,sze,1,N_det,0,1) - - call cdset_order(v_0(1),psi_bilinear_matrix_order_reverse,N_det) - call cdset_order(u_0(1),psi_bilinear_matrix_order_reverse,N_det) - -end - - -subroutine H_u_0_openmp_work(v_t,u_t,sze,istart,iend,ishift,istep) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_t = H|u_t> - ! - ! Default should be 1,N_det,0,1 - END_DOC - integer :: N_st=1 - integer, intent(in) :: sze,istart,iend,ishift,istep - complex*16, intent(in) :: u_t(N_det) - complex*16, intent(out) :: v_t(sze) - - - PROVIDE ref_bitmask_energy N_int - - select case (N_int) - case (1) - call H_u_0_openmp_work_1(v_t,u_t,sze,istart,iend,ishift,istep) - case (2) - call H_u_0_openmp_work_2(v_t,u_t,sze,istart,iend,ishift,istep) - case (3) - call H_u_0_openmp_work_3(v_t,u_t,sze,istart,iend,ishift,istep) - case (4) - call H_u_0_openmp_work_4(v_t,u_t,sze,istart,iend,ishift,istep) - case default - call H_u_0_openmp_work_N_int(v_t,u_t,sze,istart,iend,ishift,istep) - end select -end -BEGIN_TEMPLATE - -subroutine H_u_0_openmp_work_$N_int(v_t,u_t,sze,istart,iend,ishift,istep) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_t = H|u_t> - ! - ! Default should be 1,N_det,0,1 - END_DOC - integer :: N_st=1 - integer, intent(in) :: sze,istart,iend,ishift,istep - complex*16, intent(in) :: u_t(N_det) - complex*16, intent(out) :: v_t(sze) - - complex*16 :: hij - double precision :: hii - integer :: i,j,k,l - integer :: k_a, k_b, l_a, l_b, m_a, m_b - integer :: istate - integer :: krow, kcol, krow_b, kcol_b - integer :: lrow, lcol - integer :: mrow, mcol - integer(bit_kind) :: spindet($N_int) - integer(bit_kind) :: tmp_det($N_int,2) - integer(bit_kind) :: tmp_det2($N_int,2) - integer(bit_kind) :: tmp_det3($N_int,2) - integer(bit_kind), allocatable :: buffer(:,:) - integer :: n_doubles - integer, allocatable :: doubles(:) - integer, allocatable :: singles_a(:) - integer, allocatable :: singles_b(:) - integer, allocatable :: idx(:), idx0(:) - integer :: maxab, n_singles_a, n_singles_b, kcol_prev - integer*8 :: k8 - - maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 - allocate(idx0(maxab)) - - do i=1,maxab - idx0(i) = i - enddo - - ! Prepare the array of all alpha single excitations - ! ------------------------------------------------- - - PROVIDE N_int nthreads_davidson - !$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthreads_davidson) & - !$OMP SHARED(psi_bilinear_matrix_rows, N_det, & - !$OMP psi_bilinear_matrix_columns, & - !$OMP psi_det_alpha_unique, psi_det_beta_unique, & - !$OMP n_det_alpha_unique, n_det_beta_unique, N_int, & - !$OMP psi_bilinear_matrix_transp_rows, & - !$OMP psi_bilinear_matrix_transp_columns, & - !$OMP psi_bilinear_matrix_transp_order, N_st, & - !$OMP psi_bilinear_matrix_order_transp_reverse, & - !$OMP psi_bilinear_matrix_columns_loc, & - !$OMP psi_bilinear_matrix_transp_rows_loc, & - !$OMP istart, iend, istep, irp_here, v_t, & - !$OMP ishift, idx0, u_t, maxab) & - !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & - !$OMP lcol, lrow, l_a, l_b, & - !$OMP buffer, doubles, n_doubles, & - !$OMP tmp_det2, hii, hij, idx, l, kcol_prev, & - !$OMP singles_a, n_singles_a, singles_b, & - !$OMP n_singles_b, k8) - - ! Alpha/Beta double excitations - ! ============================= - - allocate( buffer($N_int,maxab), & - singles_a(maxab), & - singles_b(maxab), & - doubles(maxab), & - idx(maxab)) - - kcol_prev=-1 - - ASSERT (iend <= N_det) - ASSERT (istart > 0) - ASSERT (istep > 0) - - !$OMP DO SCHEDULE(dynamic,64) - do k_a=istart+ishift,iend,istep - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - if (kcol /= kcol_prev) then - call get_all_spin_singles_$N_int( & - psi_det_beta_unique, idx0, & - tmp_det(1,2), N_det_beta_unique, & - singles_b, n_singles_b) - endif - kcol_prev = kcol - - ! Loop over singly excited beta columns - ! ------------------------------------- - - do i=1,n_singles_b - lcol = singles_b(i) - - tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol) - - l_a = psi_bilinear_matrix_columns_loc(lcol) - ASSERT (l_a <= N_det) - - do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - l_a - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) - - ASSERT (l_a <= N_det) - idx(j) = l_a - l_a = l_a+1 - enddo - j = j-1 - - call get_all_spin_singles_$N_int( & - buffer, idx, tmp_det(1,1), j, & - singles_a, n_singles_a ) - - ! Loop over alpha singles - ! ----------------------- - - do k = 1,n_singles_a - l_a = singles_a(k) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij) - v_t(k_a) = v_t(k_a) + hij * u_t(l_a) - enddo - enddo - enddo - !$OMP END DO - - !$OMP DO SCHEDULE(dynamic,64) - do k_a=istart+ishift,iend,istep - - - ! Single and double alpha excitations - ! =================================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - ! Initial determinant is at k_b in beta-major representation - ! ---------------------------------------------------------------------- - - k_b = psi_bilinear_matrix_order_transp_reverse(k_a) - ASSERT (k_b <= N_det) - - spindet(1:$N_int) = tmp_det(1:$N_int,1) - - ! Loop inside the beta column to gather all the connected alphas - lcol = psi_bilinear_matrix_columns(k_a) - l_a = psi_bilinear_matrix_columns_loc(lcol) - do i=1,N_det_alpha_unique - if (l_a > N_det) exit - lcol = psi_bilinear_matrix_columns(l_a) - if (lcol /= kcol) exit - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) - idx(i) = l_a - l_a = l_a+1 - enddo - i = i-1 - - !call get_all_spin_singles_and_doubles_$N_int( & - ! buffer, idx, spindet, i, & - ! singles_a, doubles, n_singles_a, n_doubles ) - call get_all_spin_singles_and_doubles( & - buffer, idx, spindet, $N_int, i, & - singles_a, doubles, n_singles_a, n_doubles ) - - ! Compute Hij for all alpha singles - ! ---------------------------------- - - tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - do i=1,n_singles_a - l_a = singles_a(i) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) - call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij) - - v_t(k_a) = v_t(k_a) + hij * u_t(l_a) - enddo - - - ! Compute Hij for all alpha doubles - ! ---------------------------------- - - do i=1,n_doubles - l_a = doubles(i) - ASSERT (l_a <= N_det) - - lrow = psi_bilinear_matrix_rows(l_a) - ASSERT (lrow <= N_det_alpha_unique) - - call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij) - v_t(k_a) = v_t(k_a) + hij * u_t(l_a) - enddo - - - ! Single and double beta excitations - ! ================================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - kcol = psi_bilinear_matrix_columns(k_a) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - spindet(1:$N_int) = tmp_det(1:$N_int,2) - - ! Initial determinant is at k_b in beta-major representation - ! ----------------------------------------------------------------------- - - k_b = psi_bilinear_matrix_order_transp_reverse(k_a) - ASSERT (k_b <= N_det) - - ! Loop inside the alpha row to gather all the connected betas - lrow = psi_bilinear_matrix_transp_rows(k_b) - l_b = psi_bilinear_matrix_transp_rows_loc(lrow) - do i=1,N_det_beta_unique - if (l_b > N_det) exit - lrow = psi_bilinear_matrix_transp_rows(l_b) - if (lrow /= krow) exit - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol) - idx(i) = l_b - l_b = l_b+1 - enddo - i = i-1 - - !call get_all_spin_singles_and_doubles_$N_int( & - ! buffer, idx, spindet, i, & - ! singles_b, doubles, n_singles_b, n_doubles ) - call get_all_spin_singles_and_doubles( & - buffer, idx, spindet, $N_int, i, & - singles_b, doubles, n_singles_b, n_doubles ) - - ! Compute Hij for all beta singles - ! ---------------------------------- - - tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - do i=1,n_singles_b - l_b = singles_b(i) - ASSERT (l_b <= N_det) - - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) - call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij) - l_a = psi_bilinear_matrix_transp_order(l_b) - ASSERT (l_a <= N_det) - v_t(k_a) = v_t(k_a) + hij * u_t(l_a) - enddo - - ! Compute Hij for all beta doubles - ! ---------------------------------- - - do i=1,n_doubles - l_b = doubles(i) - ASSERT (l_b <= N_det) - - lcol = psi_bilinear_matrix_transp_columns(l_b) - ASSERT (lcol <= N_det_beta_unique) - - call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij) - l_a = psi_bilinear_matrix_transp_order(l_b) - ASSERT (l_a <= N_det) - - v_t(k_a) = v_t(k_a) + hij * u_t(l_a) - enddo - - - ! Diagonal contribution - ! ===================== - - - ! Initial determinant is at k_a in alpha-major representation - ! ----------------------------------------------------------------------- - - krow = psi_bilinear_matrix_rows(k_a) - ASSERT (krow <= N_det_alpha_unique) - - kcol = psi_bilinear_matrix_columns(k_a) - ASSERT (kcol <= N_det_beta_unique) - - tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow) - tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol) - - !double precision, external :: diag_H_mat_elem, diag_S_mat_elem - double precision, external :: diag_H_mat_elem - hii = diag_H_mat_elem(tmp_det,$N_int) - v_t(k_a) = v_t(k_a) + hii * u_t(k_a) - - end do - !$OMP END DO - deallocate(buffer, singles_a, singles_b, doubles, idx) - !$OMP END PARALLEL - -end - -SUBST [ N_int ] - -1;; -2;; -3;; -4;; -N_int;; - -END_TEMPLATE - diff --git a/src/green/lanczos.irp.f b/src/green/lanczos.irp.f deleted file mode 100644 index baf66d80..00000000 --- a/src/green/lanczos.irp.f +++ /dev/null @@ -1,883 +0,0 @@ - - -BEGIN_PROVIDER [ integer, n_green_vec ] - implicit none - BEGIN_DOC - ! number of particles/holes to use for spectral density calc. - ! just set to 2 for now (homo and lumo) - END_DOC - n_green_vec = 2 -END_PROVIDER - - BEGIN_PROVIDER [ integer, green_idx, (n_green_vec) ] -&BEGIN_PROVIDER [ integer, green_idx_int, (n_green_vec) ] -&BEGIN_PROVIDER [ integer, green_idx_bit, (n_green_vec) ] -&BEGIN_PROVIDER [ integer, green_spin, (n_green_vec) ] -&BEGIN_PROVIDER [ double precision, green_sign, (n_green_vec) ] - implicit none - BEGIN_DOC - ! description of particles/holes to be used in spectral density calculation - ! green_idx: orbital index of particle/hole - ! green_idx_{int,bit}: location of idx within determinant bitstring - ! green_spin: 1(alpha) or 2(beta) - ! green_sign: 1(particle) or -1(hole) - END_DOC - integer :: s1,s2,i1,i2 - integer :: i - - integer :: idx_homo_lumo(2), spin_homo_lumo(2) - logical :: has_idx,has_spin,has_sign,has_lanc - integer :: nlanc - ! needs psi_det, mo_num, N_int, mo_bielec_integral_jj, mo_mono_elec_integral_diag - call ezfio_has_green_green_idx(has_idx) - call ezfio_has_green_green_spin(has_spin) - call ezfio_has_green_green_sign(has_sign) -! call ezfio_has_green_n_lanczos_complete(has_lanc) - call ezfio_get_green_n_lanczos_complete(nlanc) - if (has_idx.and.has_spin.and.has_sign) then - print*,'reading idx,spin,sign' - call ezfio_get_green_green_idx(green_idx) - call ezfio_get_green_green_spin(green_spin) - call ezfio_get_green_green_sign(green_sign) - else if (nlanc.gt.0) then - stop 'problem with lanczos restart; need idx, spin, sign' - else - print*,'new lanczos calculation, finding homo/lumo' - call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_num,idx_homo_lumo,spin_homo_lumo) - - ! homo - green_idx(1)=idx_homo_lumo(1) - green_spin(1)=spin_homo_lumo(1) - green_sign(1)=-1.d0 - - ! lumo - green_idx(2)=idx_homo_lumo(2) - green_spin(2)=spin_homo_lumo(2) - green_sign(2)=1.d0 - - call ezfio_set_green_green_idx(green_idx) - call ezfio_set_green_green_spin(green_spin) - call ezfio_set_green_green_sign(green_sign) - endif - - - -! if (nlanc.gt.0) then -! ! call ezfio_get_green_n_lanczos_complete(nlanc) -! print*,'restarting from previous lanczos',nlanc -! if (has_idx.and.has_spin.and.has_sign) then -! print*,'reading idx,spin,sign' -! call ezfio_get_green_green_idx(green_idx) -! call ezfio_get_green_green_spin(green_spin) -! call ezfio_get_green_green_sign(green_sign) -! else -! stop 'problem with lanczos restart; need idx, spin, sign' -! endif -! else -! print*,'new lanczos calculation, finding homo/lumo' -! call get_homo_lumo(psi_det(1:N_int,1:2,1),N_int,mo_num,idx_homo_lumo,spin_homo_lumo) -! -! ! homo -! green_idx(1)=idx_homo_lumo(1) -! green_spin(1)=spin_homo_lumo(1) -! green_sign(1)=-1.d0 -! -! ! lumo -! green_idx(2)=idx_homo_lumo(2) -! green_spin(2)=spin_homo_lumo(2) -! green_sign(2)=1.d0 -! -! call ezfio_set_green_green_idx(green_idx) -! call ezfio_set_green_green_spin(green_spin) -! call ezfio_set_green_green_sign(green_sign) -! endif - - do i=1,n_green_vec - call get_orb_int_bit(green_idx(i),green_idx_int(i),green_idx_bit(i)) - print*,i,green_idx(i),green_idx_int(i),green_idx_bit(i),green_spin(i),green_sign(i) - enddo - -END_PROVIDER - - -BEGIN_PROVIDER [ double precision, green_det_phase, (N_det,n_green_vec) ] - implicit none - BEGIN_DOC - ! for each det in psi, compute phase for each particle/hole excitation - ! each element should be +/-1 or 0 - END_DOC - integer :: i - double precision :: phase_tmp(n_green_vec) - PROVIDE psi_det green_idx - - do i=1,N_det - call get_phase_hp(green_idx_int,green_idx_bit,green_spin,green_sign,psi_det(1,1,i),phase_tmp,N_int,n_green_vec) - green_det_phase(i,1:n_green_vec) = phase_tmp(1:n_green_vec) - enddo - -END_PROVIDER - -BEGIN_PROVIDER [ complex*16, u1_lanczos, (N_det,n_green_vec) ] - implicit none - BEGIN_DOC - ! initial lanczos vectors - ! must be normalized - END_DOC - - integer :: i,j - - do j=1,n_green_vec - do i=1,N_det - u1_lanczos(i,j)=green_det_phase(i,j)*psi_coef(i,1) - enddo - call normalize_complex(u1_lanczos(:,j),N_det) - enddo - -END_PROVIDER - -! BEGIN_PROVIDER [ double precision, alpha_lanczos, (n_green_vec,n_lanczos_iter) ] -!&BEGIN_PROVIDER [ double precision, beta_lanczos, (n_green_vec,n_lanczos_iter) ] - BEGIN_PROVIDER [ double precision, alpha_lanczos, (n_lanczos_iter,n_green_vec) ] -&BEGIN_PROVIDER [ double precision, beta_lanczos, (n_lanczos_iter,n_green_vec) ] -&BEGIN_PROVIDER [ complex*16, un_lanczos, (N_det,n_green_vec) ] -&BEGIN_PROVIDER [ complex*16, vn_lanczos, (N_det,n_green_vec) ] -&BEGIN_PROVIDER [ double precision, lanczos_eigvals, (n_lanczos_iter,n_green_vec) ] - implicit none - BEGIN_DOC - ! for each particle/hole: - ! provide alpha and beta for tridiagonal form of H - ! un, vn lanczos vectors from latest iteration - ! lanczos_eigvals: eigenvalues of tridiagonal form of H - END_DOC - PROVIDE lanczos_debug_print n_lanczos_debug - complex*16, allocatable :: work(:,:) -! double precision :: alpha_tmp,beta_tmp - double precision, allocatable :: alpha_tmp(:),beta_tmp(:) - double precision, allocatable :: alpha_tmp_vec(:,:), beta_tmp_vec(:,:) - integer :: i,j - integer :: n_lanc_new_tmp, n_lanc_old_tmp - call ezfio_get_green_n_lanczos_iter(n_lanc_new_tmp) - call ezfio_get_green_n_lanczos_complete(n_lanc_old_tmp) - - if ((n_lanczos_complete).gt.0) then -! allocate(alpha_tmp_vec(n_green_vec,n_lanczos_complete),beta_tmp_vec(n_green_vec,n_lanczos_complete)) - allocate(alpha_tmp_vec(n_lanczos_complete,n_green_vec),beta_tmp_vec(n_lanczos_complete,n_green_vec)) - logical :: has_un_lanczos, has_vn_lanczos - call ezfio_has_green_un_lanczos(has_un_lanczos) - call ezfio_has_green_vn_lanczos(has_vn_lanczos) - if (has_un_lanczos.and.has_vn_lanczos) then - call ezfio_get_green_un_lanczos(un_lanczos) - call ezfio_get_green_vn_lanczos(vn_lanczos) -! if (lanczos_debug_print) then -! print*,'uu,vv read from disk' -! do i=1,n_lanczos_debug -! write(6,'(4(E25.15))')un_lanczos(i),vn_lanczos(i) -! enddo -! endif - else - print*,'problem reading lanczos vectors for restart' - stop - endif - logical :: has_alpha_lanczos, has_beta_lanczos - call ezfio_has_green_alpha_lanczos(has_alpha_lanczos) - call ezfio_has_green_beta_lanczos(has_beta_lanczos) - if (has_alpha_lanczos.and.has_beta_lanczos) then - call ezfio_set_green_n_lanczos_iter(n_lanc_old_tmp) - call ezfio_get_green_alpha_lanczos(alpha_tmp_vec) - call ezfio_get_green_beta_lanczos(beta_tmp_vec) - call ezfio_set_green_n_lanczos_iter(n_lanc_new_tmp) - do j=1,n_green_vec - do i=1,n_lanczos_complete - alpha_lanczos(i,j)=alpha_tmp_vec(i,j) - beta_lanczos(i,j)=beta_tmp_vec(i,j) - enddo - enddo - else - print*,'problem reading lanczos alpha, beta for restart' - stop - endif - deallocate(alpha_tmp_vec,beta_tmp_vec) - else - call write_time(6) - print*,'no saved lanczos vectors. starting lanczos' - PROVIDE u1_lanczos - un_lanczos=u1_lanczos - allocate(work(N_det,n_green_vec),alpha_tmp(n_green_vec),beta_tmp(n_green_vec)) - call lanczos_h_init_hp(un_lanczos,vn_lanczos,work,N_det,alpha_tmp,beta_tmp,& - n_green_vec,green_spin,green_sign,green_idx) - do i=1,n_green_vec - alpha_lanczos(1,i)=alpha_tmp(i) - beta_lanczos(1,i)=beta_tmp(i) - enddo - n_lanczos_complete=1 - deallocate(work,alpha_tmp,beta_tmp) - endif - - allocate(work(N_det,n_green_vec),alpha_tmp(n_green_vec),beta_tmp(n_green_vec)) - do i=n_lanczos_complete+1,n_lanczos_iter - call write_time(6) - print*,'starting lanczos iteration',i - call lanczos_h_step_hp(un_lanczos,vn_lanczos,work,N_det,alpha_tmp,beta_tmp,& - n_green_vec,green_spin,green_sign,green_idx) - do j=1,n_green_vec - alpha_lanczos(i,j)=alpha_tmp(j) - beta_lanczos(i,j)=beta_tmp(j) - enddo - n_lanczos_complete=n_lanczos_complete+1 - enddo - deallocate(work,alpha_tmp,beta_tmp) - - call ezfio_set_green_alpha_lanczos(alpha_lanczos) - call ezfio_set_green_beta_lanczos(beta_lanczos) - call ezfio_set_green_un_lanczos(un_lanczos) - call ezfio_set_green_vn_lanczos(vn_lanczos) - call ezfio_set_green_n_lanczos_complete(n_lanczos_complete) - - call diag_lanczos_vals_hp(alpha_lanczos, beta_lanczos, n_lanczos_complete, lanczos_eigvals,& - n_lanczos_iter,n_green_vec) - call ezfio_set_green_lanczos_eigvals(lanczos_eigvals) - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, delta_omega ] - implicit none - BEGIN_DOC - ! step size between frequency points for spectral density calculation - ! calculated from min, max, and number of steps - END_DOC - delta_omega=(omega_max-omega_min)/n_omega -END_PROVIDER - -BEGIN_PROVIDER [ double precision, omega_list, (n_omega) ] - implicit none - BEGIN_DOC - ! list of frequencies at which to compute spectral density - END_DOC - - integer :: i - double precision :: omega_i - PROVIDE delta_omega - do i=1,n_omega - omega_list(i) = omega_min + (i-1)*delta_omega - enddo - -END_PROVIDER - - -BEGIN_PROVIDER [ double precision, spectral_lanczos, (n_omega,n_green_vec) ] - implicit none - BEGIN_DOC - ! spectral density A(omega) calculated from lanczos alpha/beta - ! calculated for n_omega points between omega_min and omega_max - END_DOC - - integer :: i,j - double precision :: omega_i - complex*16 :: z_i - !double precision :: spec_lanc_rev - double precision :: spec_lanc_rev_sign - logical :: has_ci_energy - double precision :: ref_energy_0 - PROVIDE delta_omega alpha_lanczos beta_lanczos omega_list - call ezfio_has_fci_energy(has_ci_energy) - if (has_ci_energy) then - call ezfio_get_fci_energy(ref_energy_0) - else - print*,'no reference energy from full_ci_zmq, exiting' - stop - endif - - - do i=1,n_omega - omega_i = omega_list(i) - z_i = dcmplx(omega_i,gf_epsilon) - do j=1,n_green_vec -! spectral_lanczos(i,j) = spec_lanc_rev(n_lanczos_iter,alpha_lanczos(:,j),beta_lanczos(:,j),z_i) - spectral_lanczos(i,j) = spec_lanc_rev_sign(n_lanczos_iter, & - alpha_lanczos(:,j), & - beta_lanczos(:,j), & - z_i - green_sign(j)*ref_energy_0, & - green_sign(j)) - enddo - enddo - -END_PROVIDER - -double precision function spec_lanc(n_lanc_iter,alpha,beta,z) - include 'constants.include.F' - implicit none - BEGIN_DOC - ! input: - ! alpha, beta: from tridiagonal form of H (obtain via lanczos) - ! beta and alpha same size (beta(1) is not used) - ! n_lanc_iter: size of alpha, beta - ! z: omega + i*epsilon - ! omega is frequency for which spectral density is to be computed - ! epsilon is magnitude of infinitesimal imaginary term - ! output: - ! spec_lanc: spectral density A(omega) - ! - ! uses inv_pi=(1.d0/pi) from constants - END_DOC - integer, intent(in) :: n_lanc_iter - double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) - complex*16, intent(in) :: z - - complex*16 bigAj2,bigAj1,bigAj0 - complex*16 bigBj2,bigBj1,bigBj0 - integer :: j - ! init for j=1 - ! bigAj2 is A(j-2) - ! bigAj1 is A(j-1) - ! etc. - - bigAj2=1.d0 ! A(-1) - bigAj1=0.d0 ! A(0) - bigAj0=1.d0 ! A(1) - - bigBj2=0.d0 ! B(-1) - bigBj1=1.d0 ! B(0) - bigBj0=z-alpha(1) ! B(1) - - do j=2,n_lanc_iter - bigAj2=bigAj1 - bigAj1=bigAj0 - bigAj0=(z-alpha(j))*bigAj1 - beta(j)**2*bigAj2 - - bigBj2=bigBj1 - bigBj1=bigBj0 - bigBj0=(z-alpha(j))*bigBj1 - beta(j)**2*bigBj2 - enddo - spec_lanc=-imag(bigAj0/bigBj0)*inv_pi -end - -double precision function spec_lanc_rev(n_lanc_iter,alpha,beta,z) - include 'constants.include.F' - implicit none - BEGIN_DOC - ! reverse iteration is more numerically stable - ! input: - ! alpha, beta: from tridiagonal form of H (obtain via lanczos) - ! beta and alpha same size (beta(1) is not used) - ! n_lanc_iter: size of alpha, beta - ! z: omega + i*epsilon - ! omega is frequency for which spectral density is to be computed - ! epsilon is magnitude of infinitesimal imaginary term - ! output: - ! spec_lanc: spectral density A(omega) - ! - ! uses inv_pi=(1.d0/pi) from constants - END_DOC - integer, intent(in) :: n_lanc_iter - double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) - complex*16, intent(in) :: z - - complex*16 :: tmp - integer :: j - - tmp=(0.d0,0.d0) - do j=n_lanc_iter,2,-1 - tmp=-beta(j)**2/(z-alpha(j)+tmp) - enddo - tmp=1.d0/(z-alpha(1)+tmp) - spec_lanc_rev=-imag(tmp)*inv_pi -end - -double precision function spec_lanc_rev_sign(n_lanc_iter,alpha,beta,z,g_sign) - include 'constants.include.F' - implicit none - BEGIN_DOC - ! reverse iteration is more numerically stable - ! input: - ! alpha, beta: from tridiagonal form of H (obtain via lanczos) - ! beta and alpha same size (beta(1) is not used) - ! n_lanc_iter: size of alpha, beta - ! z: omega + i*epsilon - ! omega is frequency for which spectral density is to be computed - ! epsilon is magnitude of infinitesimal imaginary term - ! output: - ! spec_lanc: spectral density A(omega) - ! - ! uses inv_pi=(1.d0/pi) from constants - END_DOC - integer, intent(in) :: n_lanc_iter - double precision, intent(in) :: alpha(n_lanc_iter), beta(n_lanc_iter) - complex*16, intent(in) :: z - double precision, intent(in) :: g_sign - - complex*16 :: tmp - integer :: j - - tmp=(0.d0,0.d0) - do j=n_lanc_iter,2,-1 - tmp=-beta(j)**2/(z+g_sign*alpha(j)+tmp) - enddo - tmp=1.d0/(z+g_sign*alpha(1)+tmp) - spec_lanc_rev_sign=-imag(tmp)*inv_pi -end - - -subroutine lanczos_h_init_hp(uu,vv,work,sze,alpha_i,beta_i,ng,spin_hp,sign_hp,idx_hp) - implicit none - integer, intent(in) :: sze,ng - complex*16, intent(in) :: uu(sze,ng) - complex*16, intent(out) :: vv(sze,ng) - complex*16 :: work(sze,ng) - double precision, intent(out) :: alpha_i(ng), beta_i(ng) - integer, intent(in) :: spin_hp(ng), idx_hp(ng) - double precision, intent(in) :: sign_hp(ng) - - double precision, external :: dznrm2 - complex*16, external :: u_dot_v_complex - integer :: i,j - - BEGIN_DOC - ! initial step for lanczos tridiagonalization of H for multiple holes/particles - ! uu is array of initial vectors u1 (creation/annihilation operator applied to psi) - ! output vv is array of lanczos v1 (one for each hole/particle) - END_DOC - - print *,'starting lanczos' - print *,'sze = ',sze - - ! |uu> is |u(1)> - - ! |w(1)> = H|u(1)> - ! |work> is now |w(1)> - call compute_hu_hp(uu,work,ng,sze,spin_hp,sign_hp,idx_hp) - - ! alpha(n+1) = - do i=1,ng - alpha_i(i)=real(u_dot_v_complex(uu(1:sze,i),work(1:sze,i),sze)) - enddo - - do j=1,ng - do i=1,sze - vv(i,j)=work(i,j)-alpha_i(j)*uu(i,j) -! write(6,'(7(E25.15))')uu(i,j),vv(i,j),work(i,j),alpha_i(j) - enddo - enddo - - beta_i=0.d0 - ! |vv> is |v(1)> - ! |uu> is |u(1)> -end - -subroutine lanczos_h_step_hp(uu,vv,work,sze,alpha_i,beta_i,ng,spin_hp,sign_hp,idx_hp) - implicit none - integer, intent(in) :: sze,ng - complex*16, intent(inout) :: uu(sze,ng),vv(sze,ng) - complex*16, intent(out) :: work(sze,ng) - double precision, intent(out) :: alpha_i(ng), beta_i(ng) - integer, intent(in) :: spin_hp(ng), idx_hp(ng) - double precision, intent(in) :: sign_hp(ng) - - double precision, external :: dznrm2 - complex*16, external :: u_dot_v_complex - integer :: i,j - complex*16 :: tmp_c16 - BEGIN_DOC - ! lanczos tridiagonalization of H - ! n_lanc_iter is number of lanczos iterations - ! u1 is initial lanczos vector - ! u1 should be normalized - END_DOC - - ! |vv> is |v(n)> - ! |uu> is |u(n)> - - ! compute beta(n+1) - do j=1,ng - beta_i(j)=dznrm2(sze,vv(:,j),1) - ! |vv> is now |u(n+1)> - call zdscal(sze,(1.d0/beta_i(j)),vv(:,j),1) - enddo - - ! |w(n+1)> = H|u(n+1)> - ! |work> is now |w(n+1)> - call compute_hu_hp(vv,work,ng,sze,spin_hp,sign_hp,idx_hp) - - ! alpha(n+1) = - do i=1,ng - alpha_i(i)=real(u_dot_v_complex(vv(1:sze,i),work(1:sze,i),sze)) - enddo - - do j=1,ng - do i=1,sze - tmp_c16=work(i,j)-alpha_i(j)*vv(i,j)-beta_i(j)*uu(i,j) - uu(i,j)=vv(i,j) - vv(i,j)=tmp_c16 - enddo - enddo - ! |vv> is |v(n+1)> - ! |uu> is |u(n+1)> -end - - -subroutine lanczos_h_init(uu,vv,work,sze,alpha_i,beta_i) - implicit none - integer, intent(in) :: sze - complex*16, intent(inout) :: uu(sze) - complex*16, intent(out) :: vv(sze) - complex*16 :: work(sze) - double precision, intent(out) :: alpha_i, beta_i - - double precision, external :: dznrm2 - complex*16, external :: u_dot_v_complex - integer :: i - - BEGIN_DOC - ! lanczos tridiagonalization of H - ! n_lanc_iter is number of lanczos iterations - ! u1 is initial lanczos vector - ! u1 should be normalized - END_DOC - - print *,'starting lanczos' - print *,'sze = ',sze - ! exit if u1 is not normalized -! beta_norm = dznrm2(h_size,u1,1) -! if (dabs(beta_norm-1.d0) .gt. 1.d-6) then -! print *, 'Error: initial Lanczos vector is not normalized' -! stop -1 -! endif - - ! |uu> is |u(1)> - - ! |w(1)> = H|u(1)> - ! |work> is now |w(1)> - call compute_hu(uu,work,sze) - - ! alpha(n+1) = - alpha_i=real(u_dot_v_complex(uu,work,sze)) - - do i=1,sze - vv(i)=work(i)-alpha_i*uu(i) - enddo - beta_i=0.d0 - if (lanczos_debug_print) then - print*,'init uu,vv,work' - do i=1,n_lanczos_debug - write(6,'(6(E25.15))')uu(i),vv(i),work(i) - enddo - endif - ! |vv> is |v(1)> - ! |uu> is |u(1)> -end - -subroutine lanczos_h_step(uu,vv,work,sze,alpha_i,beta_i) - implicit none - integer, intent(in) :: sze - complex*16, intent(inout) :: uu(sze),vv(sze) - complex*16, intent(out) :: work(sze) - double precision, intent(out) :: alpha_i, beta_i - - double precision, external :: dznrm2 - complex*16, external :: u_dot_v_complex - integer :: i - complex*16 :: tmp_c16 - BEGIN_DOC - ! lanczos tridiagonalization of H - ! n_lanc_iter is number of lanczos iterations - ! u1 is initial lanczos vector - ! u1 should be normalized - END_DOC - - ! exit if u1 is not normalized -! beta_norm = dznrm2(h_size,u1,1) -! if (dabs(beta_norm-1.d0) .gt. 1.d-6) then -! print *, 'Error: initial Lanczos vector is not normalized' -! stop -1 -! endif - - ! |vv> is |v(n)> - ! |uu> is |u(n)> - - ! compute beta(n+1) - beta_i=dznrm2(sze,vv,1) - if (lanczos_debug_print) then - print*,'uu,vv in' - do i=1,n_lanczos_debug - write(6,'(4(E25.15))')uu(i),vv(i) - enddo - endif - ! |vv> is now |u(n+1)> - call zdscal(sze,(1.d0/beta_i),vv,1) - - ! |w(n+1)> = H|u(n+1)> - ! |work> is now |w(n+1)> - call compute_hu(vv,work,sze) - - if (lanczos_debug_print) then - print*,'vv,work' - do i=1,n_lanczos_debug - write(6,'(4(E25.15))')vv(i),work(i) - enddo - endif - - ! alpha(n+1) = - alpha_i=real(u_dot_v_complex(vv,work,sze)) - - do i=1,sze - tmp_c16=work(i)-alpha_i*vv(i)-beta_i*uu(i) - uu(i)=vv(i) - vv(i)=tmp_c16 - enddo - ! |vv> is |v(n+1)> - ! |uu> is |u(n+1)> -end - - - -subroutine lanczos_h(n_lanc_iter,alpha,beta,u1) - implicit none - integer, intent(in) :: n_lanc_iter - double precision, intent(out) :: alpha(n_lanc_iter), beta(n_lanc_iter) - complex*16, intent(in) :: u1(N_det) - integer :: h_size - double precision :: beta_norm, beta_norm_inv - complex*16, allocatable :: vec1(:), vec2(:), vec3(:) - complex*16 :: vec_tmp - double precision, external :: dznrm2 - complex*16, external :: u_dot_v_complex - - integer :: i,j,l - h_size=N_det - BEGIN_DOC - ! lanczos tridiagonalization of H - ! n_lanc_iter is number of lanczos iterations - ! u1 is initial lanczos vector - ! u1 should be normalized - END_DOC - - print *,'starting lanczos' - print *,'h_size = ',h_size -! print *,'initial vector:' -! do i=1,h_size -! print *,u1(i) -! enddo - ! exit if u1 is not normalized - beta_norm = dznrm2(h_size,u1,1) - if (dabs(beta_norm-1.d0) .gt. 1.d-6) then - print *, 'Error: initial Lanczos vector is not normalized' - stop -1 - endif - - allocate(vec1(h_size), & - vec2(h_size), & - vec3(h_size)) - - do i=1,h_size - vec1(i)=u1(i) - enddo - - ! |w1> = H|u1> - ! |vec2> = H|vec1> - call compute_hu(vec1,vec2,h_size)!! TODO: not implemented - - ! alpha(1) = = - ! = - alpha(1)=real(u_dot_v_complex(vec1,vec2,h_size)) - - ! |v1> = |w1> - alpha(1)*|u1> - ! |vec3> = |vec2> - alpha(1)*|vec1> - do i=1,h_size - vec3(i)=vec2(i)-alpha(1)*vec1(i) - enddo - do j=2,n_lanc_iter - call write_time(6) - print *,'starting lanczos iteration:',j - !! vec1 is |u(j-1)> - !! vec3 is |v(j-1)> - - ! beta(j) = sqrt() - beta_norm=dznrm2(h_size,vec3,1) - - ! TODO: check for beta=0? - beta_norm_inv=1.d0/beta_norm - - ! normalize |v(j-1)> to form |u(j)> - call zdscal(h_size,beta_norm_inv,vec3,1) - !! vec3 is |u(j)> - - ! |w(j)> = H|u(j)> - call compute_hu(vec3,vec2,h_size)!! TODO: not implemented - !! vec2 is |w(j)> - - alpha(j)=real(u_dot_v_complex(vec2,vec3,h_size)) - beta(j)=beta_norm - - ! |v(j)> = |w(j)> - alpha(j)*|u(j)> - beta(j)*|u(j-1)> - do l=1,h_size - vec_tmp=vec2(l)-alpha(j)*vec3(l)-beta(j)*vec1(l) - vec1(l)=vec3(l) - vec3(l)=vec_tmp - enddo - !! vec1 is |u(j)> - !! vec3 is |v(j)> - enddo - -end - - -subroutine compute_hu_hp(vec1,vec2,n_hp,h_size,spin_hp,sign_hp,idx_hp) - implicit none - integer, intent(in) :: h_size,n_hp - complex*16, intent(in) :: vec1(h_size,n_hp) - complex*16, intent(out) :: vec2(h_size,n_hp) - integer, intent(in) :: spin_hp(n_hp), idx_hp(n_hp) - double precision, intent (in) :: sign_hp(n_hp) - complex*16 :: vec1_tmp(h_size,n_hp) - integer :: i,j - BEGIN_DOC - ! |vec2> = H|vec1> - ! - ! TODO: implement - ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? - END_DOC - - vec1_tmp(1:h_size,1:n_hp) = vec1(1:h_size,1:n_hp) - call h_u_0_hp_openmp(vec2,vec1_tmp,n_hp,h_size,spin_hp,sign_hp,idx_hp) - - do j=1,n_hp - do i=1,h_size - if (cdabs(vec1_tmp(i,j) - vec1(i,j)).gt.1.d-6) then - print*,'ERROR: vec1 was changed by h_u_0_openmp' - endif - enddo - enddo -end - -subroutine compute_hu(vec1,vec2,h_size) - implicit none - integer, intent(in) :: h_size - complex*16, intent(in) :: vec1(h_size) - complex*16, intent(out) :: vec2(h_size) - complex*16 :: vec1_tmp(h_size) - integer :: i - BEGIN_DOC - ! |vec2> = H|vec1> - ! - ! TODO: implement - ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? - END_DOC - - vec1_tmp(1:h_size) = vec1(1:h_size) - call h_u_0_openmp(vec2,vec1_tmp,h_size) - - do i=1,h_size - if (cdabs(vec1_tmp(i) - vec1(i)).gt.1.d-6) then - print*,'ERROR: vec1 was changed by h_u_0_openmp' - endif - enddo -end - -subroutine compute_hu2(vec1,vec2,h_size) - implicit none - integer, intent(in) :: h_size - complex*16, intent(in) :: vec1(h_size) - complex*16, intent(out) :: vec2(h_size) - complex*16, allocatable :: u_tmp(:,:), s_tmp(:,:),v_tmp(:,:) - integer :: i - BEGIN_DOC - ! |vec2> = H|vec1> - ! - ! TODO: implement - ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? - END_DOC - - allocate(u_tmp(1,h_size),s_tmp(1,h_size),v_tmp(1,h_size)) - - u_tmp(1,1:h_size) = vec1(1:h_size) - call h_s2_u_0_nstates_openmp(v_tmp,s_tmp,u_tmp,1,h_size) - - do i=1,h_size - if (cdabs(u_tmp(1,i) - vec1(i)).gt.1.d-6) then - print*,'ERROR: vec1 was changed by h_u_0_openmp' - endif - enddo - vec2(1:h_size)=v_tmp(1,1:h_size) - deallocate(u_tmp,v_tmp,s_tmp) -end - - - -subroutine diag_lanczos_vals_vecs(alpha, beta, nlanc, vals, vecs, sze) - implicit none - BEGIN_DOC - ! diagonalization of tridiagonal form of H - ! this returns eigenvalues and eigenvectors in vals,vecs - END_DOC - integer, intent(in) :: nlanc,sze - double precision, intent(in) :: alpha(sze), beta(sze) - double precision, intent(out) :: vals(sze), vecs(sze,sze) - double precision :: work(2*nlanc-2), beta_tmp(nlanc-1) - integer :: i,info - - vals(1)=alpha(1) - do i=2,nlanc - vals(i)=alpha(i) - beta_tmp(i-1)=beta(i) - enddo - - call dstev('V', nlanc, vals, beta_tmp, vecs, sze, work, info) - if (info.gt.0) then - print *,'WARNING: diagonalization of tridiagonal form of H did not converge' - else if (info.lt.0) then - print *,'WARNING: argument to dstev had illegal value' - endif -end - -subroutine diag_lanczos_vals_hp(alpha, beta, nlanc, vals, sze,ng) - implicit none - BEGIN_DOC - ! diagonalization of tridiagonal form of H - ! this returns eigenvalues in vals - END_DOC - integer, intent(in) :: nlanc,sze,ng - !double precision, intent(in) :: alpha(ng,sze), beta(sze) - double precision, intent(in) :: alpha(sze,ng), beta(sze,ng) - double precision, intent(out) :: vals(sze,ng) - double precision :: work(1), beta_tmp(nlanc-1), vecs(1) - integer :: i,info,ig - - do ig=1,ng - vals(1,ig)=alpha(1,ig) - do i=2,nlanc - vals(i,ig)=alpha(i,ig) - beta_tmp(i-1)=beta(i,ig) - enddo - - call dstev('N', nlanc, vals(:,ig), beta_tmp, vecs, 1, work, info) - if (info.gt.0) then - print *,'WARNING: diagonalization of tridiagonal form of H did not converge' - else if (info.lt.0) then - print *,'WARNING: argument to dstev had illegal value' - endif - enddo -end -subroutine diag_lanczos_vals(alpha, beta, nlanc, vals, sze) - implicit none - BEGIN_DOC - ! diagonalization of tridiagonal form of H - ! this returns eigenvalues in vals - END_DOC - integer, intent(in) :: nlanc,sze - double precision, intent(in) :: alpha(sze), beta(sze) - double precision, intent(out) :: vals(sze) - double precision :: work(1), beta_tmp(nlanc-1), vecs(1) - integer :: i,info - - vals(1)=alpha(1) - do i=2,nlanc - vals(i)=alpha(i) - beta_tmp(i-1)=beta(i) - enddo - - call dstev('N', nlanc, vals, beta_tmp, vecs, 1, work, info) - if (info.gt.0) then - print *,'WARNING: diagonalization of tridiagonal form of H did not converge' - else if (info.lt.0) then - print *,'WARNING: argument to dstev had illegal value' - endif -end diff --git a/src/green/plot-spec-dens.py b/src/green/plot-spec-dens.py deleted file mode 100755 index bf4f2294..00000000 --- a/src/green/plot-spec-dens.py +++ /dev/null @@ -1,90 +0,0 @@ -#!/bin/env python - -import gzip -import sys -from math import pi -inv_pi = 1.0/pi - -def spec_dens(alpha,beta,z0,g_sign,e_shift): - sze=len(alpha) - sze_b=len(beta) - if (sze != sze_b): - print('Error: size mismatch',sze,sze_b) - sys.exit(1) - z=z0-g_sign*e_shift - tmp=0.0+0.0j - #for ai,bi in zip(reversed(a),reversed(b)) - for i in range(sze-1,0,-1): - tmp=-(beta[i]**2)/(z+g_sign*alpha[i]+tmp) - tmp=1.0/(z+g_sign*alpha[0]+tmp) - return -1.0 * tmp.imag * inv_pi - -def printspec(ezdir,wmin,wmax,nw,eps): - gdir=ezdir+'/green/' - with open(gdir+'n_green_vec') as infile: - ngvec=int(infile.readline().strip()) - with open(ezdir+'/fci/energy') as infile: - e0=float(infile.readline().strip()) - with open(gdir+'n_lanczos_complete') as infile: - nlanc=int(infile.readline().strip()) - - with gzip.open(gdir+'green_sign.gz') as infile: - gsign0=infile.read().split() - - with gzip.open(gdir+'alpha_lanczos.gz') as infile: - adata0=infile.read().split() - with gzip.open(gdir+'beta_lanczos.gz') as infile: - bdata0=infile.read().split() - - adim=int(adata0.pop(0)) - bdim=int(bdata0.pop(0)) - gsigndim=int(gsign0.pop(0)) - assert adim==2, 'dimension of alpha_lanczos should be 2' - assert bdim==2, 'dimension of beta_lanczos should be 2' - assert gsigndim==1, 'dimension of green_sign should be 1' - - ngvec_2=int(gsign0.pop(0)) - assert ngvec_2==ngvec, 'problem with size of green_sign.gz' - - ashape=tuple(map(int,adata0[:adim])) - bshape=tuple(map(int,bdata0[:bdim])) - assert ashape==(nlanc,ngvec), 'shape of alpha_lanczos should be (nlanc, ngvec)' - assert bshape==(nlanc,ngvec), 'shape of beta_lanczos should be (nlanc, ngvec)' - - amat=[] - for xi in range(ngvec): - amat.append(list(map(float,adata0[adim+xi*nlanc:adim+(xi+1)*nlanc]))) - - bmat=[] - b2mat=[] - for xi in range(ngvec): - #bmat.append(list(map(float,bdata0[bdim+xi*nlanc:bdim+(xi+1)*nlanc]))) - b_tmp=list(map(float,bdata0[bdim+xi*nlanc:bdim+(xi+1)*nlanc])) - b2_tmp=[i*i for i in b_tmp] - bmat.append(b_tmp) - b2mat.append(b2_tmp) - - gsign=list(map(float,gsign0)) - dw=(wmax-wmin)/(nw-1) - wlist = [wmin+iw*dw for iw in range(nw)] - densmat=[] - for ivec in range(ngvec): - densmat.append([spec_dens(amat[ivec],bmat[ivec],iw+1.j*eps,gsign[ivec],e0) for iw in wlist]) - - for i,dd in enumerate(zip(*densmat)): - print(('{:15.6E}'+ngvec*'{:25.15E}').format(wlist[i],*dd)) - -if __name__ == '__main__': - - if len(sys.argv) != 6: - print('bad args') - print('USAGE: plot-spec-dens.py ezfio omega_min omega_max n_omega epsilon') - sys.exit(1) - ezfio=sys.argv[1] - wmin=float(sys.argv[2]) - wmax=float(sys.argv[3]) - nw=int(sys.argv[4]) - eps=float(sys.argv[5]) - printspec(ezfio,wmin,wmax,nw,eps) - - diff --git a/src/green/print_dets_test.irp.f b/src/green/print_dets_test.irp.f deleted file mode 100644 index 6466141e..00000000 --- a/src/green/print_dets_test.irp.f +++ /dev/null @@ -1,15 +0,0 @@ -program print_dets_test - implicit none - read_wf = .True. - touch read_wf - call routine - -end - -subroutine routine - use bitmasks - implicit none - integer :: i - read*,i - print*,psi_det(:,:,i) -end diff --git a/src/green/print_e_mo_debug.irp.f b/src/green/print_e_mo_debug.irp.f deleted file mode 100644 index 1fe41e34..00000000 --- a/src/green/print_e_mo_debug.irp.f +++ /dev/null @@ -1,15 +0,0 @@ -program print_e_mo_debug - implicit none - read_wf = .True. - touch read_wf - call routine - -end - -subroutine routine - use bitmasks - implicit none - integer :: i - read*,i - call print_mo_energies(psi_det(:,:,i),N_int,mo_num) -end diff --git a/src/green/print_h_debug.irp.f b/src/green/print_h_debug.irp.f deleted file mode 100644 index 4dd394d7..00000000 --- a/src/green/print_h_debug.irp.f +++ /dev/null @@ -1,178 +0,0 @@ -program print_h_debug - implicit none - read_wf = .True. - touch read_wf - call routine - -end - -subroutine routine - use bitmasks - implicit none - integer :: i,j - integer, allocatable :: H_matrix_degree(:,:) - double precision, allocatable :: H_matrix_phase(:,:) - integer :: degree - integer(bit_kind), allocatable :: keys_tmp(:,:,:) - allocate(keys_tmp(N_int,2,N_det)) - do i = 1, N_det - print*,'' - call debug_det(psi_det(1,1,i),N_int) - do j = 1, N_int - keys_tmp(j,1,i) = psi_det(j,1,i) - keys_tmp(j,2,i) = psi_det(j,2,i) - enddo - enddo - if(N_det.gt.10000)then - print*,'Warning !!!' - print*,'Number of determinants is ',N_det - print*,'It means that the H matrix will be enormous !' - print*,'stoppping ..' - stop - endif - print*,'' - print*,'Determinants ' - do i = 1, N_det - enddo - allocate(H_matrix_degree(N_det,N_det),H_matrix_phase(N_det,N_det)) - integer :: exc(0:2,2,2) - double precision :: phase - do i = 1, N_det - do j = i, N_det - call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int) - H_matrix_degree(i,j) = degree - H_matrix_degree(j,i) = degree - phase = 0.d0 - if(degree==1.or.degree==2)then - call get_excitation(psi_det(1,1,i),psi_det(1,1,j),exc,degree,phase,N_int) - endif - H_matrix_phase(i,j) = phase - H_matrix_phase(j,i) = phase - enddo - enddo - print*,'H matrix ' - double precision :: s2 - complex*16 :: ref_h_matrix - ref_h_matrix = h_matrix_all_dets_complex(1,1) - print*,'HF like determinant energy = ',ref_bitmask_energy+nuclear_repulsion - print*,'Ref element of H_matrix = ',ref_h_matrix+nuclear_repulsion - print*,'Printing the H matrix ...' - print*,'' - print*,'' -!do i = 1, N_det -! H_matrix_all_dets(i,i) -= ref_h_matrix -!enddo - - do i = 1, N_det - H_matrix_all_dets_complex(i,i) += nuclear_repulsion - enddo - -!do i = 5,N_det -! H_matrix_all_dets(i,3) = 0.d0 -! H_matrix_all_dets(3,i) = 0.d0 -! H_matrix_all_dets(i,4) = 0.d0 -! H_matrix_all_dets(4,i) = 0.d0 -!enddo - - - - -! TODO: change for complex - do i = 1, N_det - write(*,'(I3,X,A3,2000(E24.15))')i,' | ',H_matrix_all_dets_complex(i,:) - enddo - -! print*,'' -! print*,'' -! print*,'' -! print*,'Printing the degree of excitations within the H matrix' -! print*,'' -! print*,'' -! do i = 1, N_det -! write(*,'(I3,X,A3,X,1000(I1,X))')i,' | ',H_matrix_degree(i,:) -! enddo -! -! -! print*,'' -! print*,'' -! print*,'Printing the phase of the Hamiltonian matrix elements ' -! print*,'' -! print*,'' -! do i = 1, N_det -! write(*,'(I3,X,A3,X,1000(F3.0,X))')i,' | ',H_matrix_phase(i,:) -! enddo -! print*,'' - - -! double precision, allocatable :: eigenvalues(:) -! complex*16, allocatable :: eigenvectors(:,:) -! double precision, allocatable :: s2_eigvalues(:) -! allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) -! allocate (eigenvalues(N_det),s2_eigvalues(N_det)) -! call lapack_diag_complex(eigenvalues,eigenvectors, & -! H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) -! print*,'Two first eigenvectors ' -! call u_0_S2_u_0(s2_eigvalues,eigenvectors,n_det,keys_tmp,N_int,N_det,size(eigenvectors,1)) -! do j =1, N_states -! print*,'s2 = ',s2_eigvalues(j) -! print*,'e = ',eigenvalues(j) -! print*,'coefs : ' -! do i = 1, N_det -! print*,'i = ',i,eigenvectors(i,j) -! enddo -! if(j>1)then -! print*,'Delta E(H) = ',eigenvalues(1) - eigenvalues(j) -! print*,'Delta E(eV) = ',(eigenvalues(1) - eigenvalues(j))*27.2114d0 -! endif -! enddo -! complex*16 :: get_mo_bielec_integral,k_a_iv,k_b_iv -! integer :: h1,p1,h2,p2 -! h1 = 10 -! p1 = 16 -! h2 = 14 -! p2 = 14 -!!h1 = 1 -!!p1 = 4 -!!h2 = 2 -!!p2 = 2 -! k_a_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) -! h2 = 15 -! p2 = 15 -! k_b_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) -! print*,'k_a_iv = ',k_a_iv -! print*,'k_b_iv = ',k_b_iv -! complex*16 :: k_av,k_bv,k_ai,k_bi -! h1 = 16 -! p1 = 14 -! h2 = 14 -! p2 = 16 -! k_av = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! h1 = 16 -! p1 = 15 -! h2 = 15 -! p2 = 16 -! k_bv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! -! h1 = 10 -! p1 = 14 -! h2 = 14 -! p2 = 10 -! k_ai = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! -! h1 = 10 -! p1 = 15 -! h2 = 15 -! p2 = 10 -! k_bi = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! -! print*,'k_av, k_bv = ',k_av,k_bv -! print*,'k_ai, k_bi = ',k_ai,k_bi -! complex*16 :: k_iv -! -! h1 = 10 -! p1 = 16 -! h2 = 16 -! p2 = 10 -! k_iv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! print*,'k_iv = ',k_iv -end diff --git a/src/green/print_h_omp_debug.irp.f b/src/green/print_h_omp_debug.irp.f deleted file mode 100644 index 0a9cd930..00000000 --- a/src/green/print_h_omp_debug.irp.f +++ /dev/null @@ -1,41 +0,0 @@ -program print_h_omp_debug - implicit none - read_wf = .True. - touch read_wf - call routine_omp - -end - -subroutine routine_omp - use bitmasks - implicit none - integer :: h_size - complex*16, allocatable :: u_tmp(:,:), s_tmp(:,:),v_tmp(:,:) - integer :: i,n_st - h_size=N_det - BEGIN_DOC - ! |vec2> = H|vec1> - ! - ! TODO: implement - ! maybe reuse parts of H_S2_u_0_nstates_{openmp,zmq}? - END_DOC - n_st=min(1000,h_size) - allocate(u_tmp(n_st,h_size),s_tmp(n_st,h_size),v_tmp(n_st,h_size)) - - u_tmp=(0.d0,0.d0) - v_tmp=(0.d0,0.d0) - s_tmp=(0.d0,0.d0) - - do i=1,n_st - u_tmp(i,i)=(1.d0,0.d0) - enddo - - call h_s2_u_0_nstates_openmp_complex(v_tmp,s_tmp,u_tmp,n_st,h_size) - do i = 1, n_st - v_tmp(i,i) += nuclear_repulsion - enddo - do i = 1, n_st - write(*,'(I3,X,A3,2000(E24.15))')i,' | ',v_tmp(i,:) - enddo - deallocate(u_tmp,v_tmp,s_tmp) -end diff --git a/src/green/print_spectral_dens.irp.f b/src/green/print_spectral_dens.irp.f deleted file mode 100644 index ca6826ce..00000000 --- a/src/green/print_spectral_dens.irp.f +++ /dev/null @@ -1,43 +0,0 @@ -program print_spectral_dens - implicit none - BEGIN_DOC -! TODO - END_DOC - read_wf = .True. - touch read_wf - provide n_green_vec - call print_lanczos_eigvals - call print_spec -end - -subroutine print_lanczos_eigvals - implicit none - integer :: i, iunit, j - integer :: getunitandopen - character(5) :: jstr - - do j=1,n_green_vec - write(jstr,'(I0.3)') j - iunit = getunitandopen('lanczos_eigval_alpha_beta.out.'//trim(jstr),'w') - print *, 'printing lanczos eigenvalues, alpha, beta to "lanczos_eigval_alpha_beta.out.'//trim(jstr)//'"' - do i=1,n_lanczos_iter - write(iunit,'(I6,3(E25.15))') i, lanczos_eigvals(i,j), alpha_lanczos(i,j), beta_lanczos(i,j) - enddo - close(iunit) - enddo -end -subroutine print_spec - implicit none - integer :: i, iunit, j - integer :: getunitandopen - character(5) :: jstr - do j=1,n_green_vec - write(jstr,'(I0.3)') j - iunit = getunitandopen('omega_A.out.'//trim(jstr),'w') - print *, 'printing frequency, spectral density to "omega_A.out.'//trim(jstr)//'"' - do i=1,n_omega - write(iunit,'(2(E25.15))') omega_list(i), spectral_lanczos(i,j) - enddo - close(iunit) - enddo -end diff --git a/src/green/utils_hp.irp.f b/src/green/utils_hp.irp.f deleted file mode 100644 index 264e3014..00000000 --- a/src/green/utils_hp.irp.f +++ /dev/null @@ -1,614 +0,0 @@ -subroutine print_mo_energies(key_ref,nint,nmo) - use bitmasks - BEGIN_DOC - ! get mo energies for one det - END_DOC - implicit none - integer, intent(in) :: nint, nmo - integer(bit_kind), intent(in) :: key_ref(nint,2) - double precision, allocatable :: e_mo(:,:) - integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) - integer :: n_occ(2), n_virt(2) - integer, parameter :: int_spin2(1:2) = (/2,1/) - integer :: i,j,ispin,jspin,i0,j0,k - integer(bit_kind), allocatable :: key_virt(:,:) - integer, allocatable :: is_occ(:,:) - - - allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2),key_virt(nint,2),e_mo(nmo,2),is_occ(nmo,2)) - is_occ=0 - - call bitstring_to_list_ab(key_ref,occ,n_occ,nint) - do i=1,nint - do ispin=1,2 - key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) - enddo - enddo - call bitstring_to_list_ab(key_virt,virt,n_virt,nint) - - e_mo(1:nmo,1)=mo_one_e_integrals_diag(1:nmo) - e_mo(1:nmo,2)=mo_one_e_integrals_diag(1:nmo) - - do ispin=1,2 - jspin=int_spin2(ispin) - do i0=1,n_occ(ispin) - i=occ(i0,ispin) - is_occ(i,ispin)=1 - do j0=i0+1,n_occ(ispin) - j=occ(j0,ispin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj_anti(i,j) - e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) - enddo - do k=2,ispin - do j0=1,n_occ(jspin) - j=occ(j0,jspin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj(i,j) - e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) !can delete this and remove k level of loop - enddo - enddo - do j0=1,n_virt(ispin) - j=virt(j0,ispin) - e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) - enddo - do j0=1,n_virt(jspin) - j=virt(j0,jspin) - e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) - enddo - enddo - enddo - - do i=1,nmo - write(6,'(2(I5),2(E25.15))')is_occ(i,1),is_occ(i,2),e_mo(i,1),e_mo(i,2) - enddo - deallocate(occ,virt,key_virt,e_mo,is_occ) -end - -subroutine get_mo_energies(key_ref,nint,nmo,e_mo) - use bitmasks - BEGIN_DOC - ! get mo energies for one det - END_DOC - implicit none - integer, intent(in) :: nint, nmo - integer(bit_kind), intent(in) :: key_ref(nint,2) - double precision, intent(out) :: e_mo(nmo,2) - integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) - integer :: n_occ(2), n_virt(2) - integer, parameter :: int_spin2(1:2) = (/2,1/) - integer :: i,j,ispin,jspin,i0,j0,k - integer(bit_kind), allocatable :: key_virt(:,:) - - - allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2),key_virt(nint,2)) - - call bitstring_to_list_ab(key_ref,occ,n_occ,nint) - do i=1,nint - do ispin=1,2 - key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) - enddo - enddo - call bitstring_to_list_ab(key_virt,virt,n_virt,nint) - - e_mo(1:nmo,1)=mo_one_e_integrals_diag(1:nmo) - e_mo(1:nmo,2)=mo_one_e_integrals_diag(1:nmo) - - do ispin=1,2 - jspin=int_spin2(ispin) - do i0=1,n_occ(ispin) - i=occ(i0,ispin) - do j0=i0+1,n_occ(ispin) - j=occ(j0,ispin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj_anti(i,j) - e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) - enddo - do k=2,ispin - do j0=1,n_occ(jspin) - j=occ(j0,jspin) - e_mo(i,ispin) = e_mo(i,ispin) + mo_two_e_integrals_jj(i,j) - e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) !can delete this and remove k level of loop - enddo - enddo - do j0=1,n_virt(ispin) - j=virt(j0,ispin) - e_mo(j,ispin) = e_mo(j,ispin) + mo_two_e_integrals_jj_anti(i,j) - enddo - do j0=1,n_virt(jspin) - j=virt(j0,jspin) - e_mo(j,jspin) = e_mo(j,jspin) + mo_two_e_integrals_jj(i,j) - enddo - enddo - enddo - - deallocate(occ,virt,key_virt) -end - -subroutine get_mask_phase_new(det1, pm, Nint) - use bitmasks - BEGIN_DOC - ! phasemask copied from qp2 - ! return phasemask of det1 in pm - END_DOC - implicit none - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: det1(Nint,2) - integer(bit_kind), intent(out) :: pm(Nint,2) - integer(bit_kind) :: tmp1, tmp2 - integer :: i - pm(1:Nint,1:2) = det1(1:Nint,1:2) - tmp1 = 0_8 - tmp2 = 0_8 - do i=1,Nint - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1)) - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2)) - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4)) - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8)) - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16)) - pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32)) - pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32)) - pm(i,1) = ieor(pm(i,1), tmp1) - pm(i,2) = ieor(pm(i,2), tmp2) - if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1) - if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2) - end do -end subroutine - -subroutine get_phase_hp(g_idx_int,g_idx_bit,g_spin,g_sign,det_in,g_det_phase,nint,n_g) - use bitmasks - implicit none - integer, intent(in) :: nint,n_g - integer, intent(in) :: g_idx_int(n_g), g_idx_bit(n_g),g_spin(n_g) - double precision, intent(in) :: g_sign(n_g) - integer(bit_kind), intent(in) :: det_in(nint,2) - double precision, intent(out) :: g_det_phase(n_g) - - integer(bit_kind) :: tmp_spindet(nint), pm(nint,2) - double precision, parameter :: phase_dble(0:1) = (/1.d0,-1.d0/) - - integer :: i - logical :: is_allowed(n_g), all_banned, is_filled - - all_banned=.True. - do i=1,n_g - tmp_spindet(1:nint) = det_in(1:nint,g_spin(i)) - call spinorb_is_filled_int_bit(tmp_spindet,g_idx_int(i),g_idx_bit(i),nint,is_filled) - is_allowed(i) = (.not.(((g_sign(i)<0).and.(.not.is_filled)).or.((g_sign(i)>0).and.(is_filled)))) - all_banned=(all_banned.and.(.not.is_allowed(i))) - enddo - - if (all_banned) then - g_det_phase(:)=0.d0 - else - call get_mask_phase_new(det_in,pm,nint) - do i=1,n_g - if (is_allowed(i)) then - g_det_phase(i) = phase_dble(popcnt(iand(ibset(0_bit_kind,g_idx_bit(i)),pm(g_idx_int(i),g_spin(i))))) - else - g_det_phase(i)=0.d0 - endif - enddo - endif -end - -subroutine get_homo_lumo(key_ref,nint,nmo,idx_homo_lumo,spin_homo_lumo) - use bitmasks - implicit none - integer, intent(in) :: nint,nmo - integer(bit_kind), intent(in) :: key_ref(nint,2) - integer, intent(out) :: idx_homo_lumo(2), spin_homo_lumo(2) - - double precision, allocatable :: e_mo(:,:) - integer, allocatable :: occ(:,:),virt(:,:) !(nint*bit_kind_size,2) - integer :: n_occ(2), n_virt(2) - integer :: i,i0,ispin - integer(bit_kind), allocatable :: key_virt(:,:) - double precision :: maxocc(2), minvirt(2) - integer :: imaxocc(2), iminvirt(2) - - allocate(e_mo(nmo,2),key_virt(nint,2),occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2)) - - call get_mo_energies(key_ref,nint,nmo,e_mo) - - !allocate(occ(nint*bit_kind_size,2),virt(nint*bit_kind_size,2)) - - call bitstring_to_list_ab(key_ref,occ,n_occ,nint) - do i=1,nint - do ispin=1,2 - key_virt(i,ispin)=xor(full_ijkl_bitmask(i),key_ref(i,ispin)) - enddo - enddo - call bitstring_to_list_ab(key_virt,virt,n_virt,nint) - - maxocc=-1.d20 !maybe use -1.d0*huge(0.d0)? - minvirt=1.d20 - imaxocc=-1 - iminvirt=-1 - - do ispin=1,2 - do i0=1,n_occ(ispin) - i=occ(i0,ispin) - if (e_mo(i,ispin).gt.maxocc(ispin)) then - maxocc(ispin)=e_mo(i,ispin) - imaxocc(ispin)=i - endif - enddo - do i0=1,n_virt(ispin) - i=virt(i0,ispin) - if (e_mo(i,ispin).lt.minvirt(ispin)) then - minvirt(ispin)=e_mo(i,ispin) - iminvirt(ispin)=i - endif - enddo - enddo - double precision :: e_mo_thresh - e_mo_thresh = 1.d-8 - !these should both just be 2x2 arrays, but performance here doesn't really matter and this is more readable - !if (maxocc(1).ge.maxocc(2)) then - if ((maxocc(2)-maxocc(1)).le.e_mo_thresh) then - spin_homo_lumo(1)=1 - else - spin_homo_lumo(1)=2 - endif - if ((minvirt(1)-minvirt(2)).le.e_mo_thresh) then - spin_homo_lumo(2)=1 - else - spin_homo_lumo(2)=2 - endif - - idx_homo_lumo(1)=imaxocc(spin_homo_lumo(1)) - idx_homo_lumo(2)=iminvirt(spin_homo_lumo(2)) - - deallocate(e_mo,occ,virt,key_virt) - -end - -subroutine get_list_hp_banned_ab(tmp_det,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,nint,all_banned) - use bitmasks - implicit none - BEGIN_DOC - ! input determinant tmp_det and list of single holes/particles - ! for each hole/particle, determine whether it is filled/empty in tmp_det - ! return which are disallowed in exc_is_banned - ! if all are banned, set all_banned to true - END_DOC - integer, intent(in) :: N_hp,nint - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - integer(bit_kind), intent(in) :: tmp_det(nint,2) - logical, intent(out) :: exc_is_banned(N_hp) - logical, intent(out) :: all_banned - - integer :: i - logical :: is_filled - - all_banned = .True. - do i=1,N_hp - call orb_is_filled(tmp_det,idx_hp(i),spin_hp(i),nint,is_filled) - if (sign_hp(i).gt.0) then ! particle creation, banned if already filled - exc_is_banned(i) = is_filled - else ! hole creation, banned if already empty - exc_is_banned(i) = (.not.is_filled) - endif - all_banned = (all_banned.and.exc_is_banned(i)) - enddo -end - -subroutine get_list_hp_banned_single_spin(tmp_spindet,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,ispin,nint,all_banned) - use bitmasks - implicit none - BEGIN_DOC - ! input spindeterminant tmp_spindet and list of single holes/particles - ! tmp_spindet is only one spin part of a full det, with spin==ispin - ! for each hole/particle, determine whether it is filled/empty in tmp_det - ! return which are disallowed in exc_is_banned - ! if all are banned, set all_banned to true - END_DOC - integer, intent(in) :: N_hp, ispin, nint - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - integer(bit_kind), intent(in) :: tmp_spindet(nint) - logical, intent(out) :: exc_is_banned(N_hp) - logical, intent(out) :: all_banned - - integer :: i - logical :: is_filled - - all_banned = .True. - do i=1,N_hp - if (spin_hp(i).eq.ispin) then - call orb_is_filled_single_spin(tmp_spindet,idx_hp(i),nint,is_filled) - if (sign_hp(i).gt.0) then ! particle creation, banned if already filled - exc_is_banned(i) = is_filled - else ! hole creation, banned if already empty - exc_is_banned(i) = (.not.is_filled) - endif - else - exc_is_banned(i) = .False. - endif - all_banned = (all_banned.and.exc_is_banned(i)) - enddo -end - -subroutine get_list_hp_banned_spin(tmp_det,N_hp,exc_is_banned,spin_hp,sign_hp,idx_hp,ispin,nint,all_banned) - use bitmasks - implicit none - BEGIN_DOC - ! input determinant tmp_det and list of single holes/particles - ! for each hole/particle, determine whether it is filled/empty in tmp_det - ! return which are disallowed in exc_is_banned - ! if all are banned, set all_banned to true - ! only consider tmp_det(1:N_int, ispin) - END_DOC - integer, intent(in) :: N_hp, ispin, nint - integer, intent(in) :: spin_hp(N_hp), idx_hp(N_hp) - double precision, intent(in) :: sign_hp(N_hp) - integer(bit_kind), intent(in) :: tmp_det(nint,2) - logical, intent(out) :: exc_is_banned(N_hp) - logical, intent(out) :: all_banned - - integer(bit_kind) :: spindet(nint) - - integer :: i - logical :: is_filled - spindet(1:nint) = tmp_det(1:nint,ispin) - - all_banned = .True. - do i=1,N_hp - if (spin_hp(i).eq.ispin) then - call orb_is_filled(tmp_det,idx_hp(i),ispin,nint,is_filled) - if (sign_hp(i).gt.0) then ! particle creation, banned if already filled - exc_is_banned(i) = is_filled - else ! hole creation, banned if already empty - exc_is_banned(i) = (.not.is_filled) - endif - else - exc_is_banned(i) = .False. - endif - all_banned = (all_banned.and.exc_is_banned(i)) - enddo -end - - -subroutine spinorb_is_filled_int_bit(key_ref,iorb_int,iorb_bit,Nint,is_filled) - use bitmasks - implicit none - BEGIN_DOC - ! determine whether iorb is filled in key_ref - ! iorb is specified by int and bit locations within the determinant - END_DOC - integer, intent(in) :: iorb_int, iorb_bit, Nint - integer(bit_kind), intent(in) :: key_ref(Nint) - logical, intent(out) :: is_filled - - ASSERT (iorb_int > 0) - ASSERT (iorb_bit >= 0) - ASSERT (Nint > 0) - is_filled = btest(key_ref(iorb_int),iorb_bit) -end - -subroutine orb_is_filled_int_bit(key_ref,iorb_int,iorb_bit,ispin,Nint,is_filled) - use bitmasks - implicit none - BEGIN_DOC - ! todo: not finished - ! determine whether iorb is filled in key_ref - ! iorb is specified by int and bit locations within the determinant - END_DOC - integer, intent(in) :: iorb_int, iorb_bit, ispin, Nint - integer(bit_kind), intent(in) :: key_ref(Nint,2) - logical, intent(out) :: is_filled - - ASSERT (iorb_int > 0) - ASSERT (iorb_bit >= 0) - ASSERT (ispin > 0) - ASSERT (ispin < 3) - ASSERT (Nint > 0) - is_filled = btest(key_ref(iorb_int,ispin),iorb_bit) -! call spinorb_is_filled_int_bit(key_ref(1,ispin),iorb_int,iorb_bit,Nint,is_filled) -end - -subroutine get_orb_int_bit(iorb,iorb_int,iorb_bit) - BEGIN_DOC - ! get int and bit corresponding to orbital index iorb - END_DOC - use bitmasks - implicit none - integer, intent(in) :: iorb - integer, intent(out) :: iorb_int, iorb_bit - ASSERT (iorb > 0) - iorb_int = ishft(iorb-1,-bit_kind_shift)+1 - ASSERT (iorb_int > 0) - iorb_bit = iorb - ishft(iorb_int-1,bit_kind_shift)-1 - ASSERT (iorb_bit >= 0) -end - -subroutine orb_is_filled_single_spin(key_ref,iorb,Nint,is_filled) - use bitmasks - implicit none - BEGIN_DOC - ! determine whether iorb is filled in key_ref - ! key_ref is single alpha or beta determinant - END_DOC - integer, intent(in) :: iorb, Nint - integer(bit_kind), intent(in) :: key_ref(Nint) - logical, intent(out) :: is_filled - - integer :: k,l - - ASSERT (iorb > 0) - ASSERT (Nint > 0) - - ! k is index of the int where iorb is found - ! l is index of the bit where iorb is found - k = ishft(iorb-1,-bit_kind_shift)+1 - ASSERT (k >0) - l = iorb - ishft(k-1,bit_kind_shift)-1 - ASSERT (l >= 0) - is_filled = btest(key_ref(k),l) -end - -subroutine orb_is_filled(key_ref,iorb,ispin,Nint,is_filled) - use bitmasks - implicit none - BEGIN_DOC - ! determine whether iorb, ispin is filled in key_ref - ! key_ref has alpha and beta parts - END_DOC - integer, intent(in) :: iorb, ispin, Nint - integer(bit_kind), intent(in) :: key_ref(Nint,2) - logical, intent(out) :: is_filled - - integer :: k,l - - ASSERT (iorb > 0) - ASSERT (ispin > 0) - ASSERT (ispin < 3) - ASSERT (Nint > 0) - - ! k is index of the int where iorb is found - ! l is index of the bit where iorb is found - k = ishft(iorb-1,-bit_kind_shift)+1 - ASSERT (k >0) - l = iorb - ishft(k-1,bit_kind_shift)-1 - ASSERT (l >= 0) - is_filled = btest(key_ref(k,ispin),l) -end - -subroutine ac_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) - use bitmasks - implicit none - BEGIN_DOC - ! apply creation operator to key_ref - ! add electron with spin ispin to orbital with index iorb - ! output resulting det and phase in key_new and phase - END_DOC - integer, intent(in) :: iorb, ispin, Nint - integer(bit_kind), intent(in) :: key_ref(Nint,2) - integer(bit_kind), intent(out) :: key_new(Nint,2) - double precision, intent(out) :: phase - - integer :: k,l,i - - double precision, parameter :: p(0:1) = (/ 1.d0, -1.d0 /) - - ASSERT (iorb > 0) - ASSERT (ispin > 0) - ASSERT (ispin < 3) - ASSERT (Nint > 0) - - key_new=key_ref - - ! alpha det is list of Nint 64-bit ints - ! k is index of the int where iorb is found - ! l is index of the bit where iorb is found - k = ishft(iorb-1,-bit_kind_shift)+1 - ASSERT (k >0) - l = iorb - ishft(k-1,bit_kind_shift)-1 - ASSERT (l >= 0) - key_new(k,ispin) = ibset(key_new(k,ispin),l) - - integer(bit_kind) :: parity_filled - - ! I assume here that the ordering is all alpha spinorbs and then all beta spinorbs - ! If we add an alpha electron, parity is not affected by beta part of determinant - ! (only need number of alpha occupied orbs below iorb) - - ! If we add a beta electron, the parity is affected by alpha part - ! (need total number of occupied alpha orbs (all of which come before beta) - ! and total number of beta occupied orbs below iorb) - - if (ispin==1) then - parity_filled=0_bit_kind - else - parity_filled=iand(int(elec_alpha_num,bit_kind),1_bit_kind) - endif - - ! get parity due to orbs in other ints (with lower indices) - do i=1,k-1 - parity_filled = iand(int(popcnt(key_ref(i,ispin)),bit_kind),parity_filled) - enddo - - ! get parity due to orbs in same int as iorb - ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 - parity_filled = iand(int(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),bit_kind),parity_filled) - phase = p(iand(1_bit_kind,parity_filled)) - -end - -subroutine a_operator_phase(key_new,key_ref,iorb,ispin,Nint,phase) - use bitmasks - implicit none - BEGIN_DOC - ! apply annihilation operator to key_ref - ! remove electron with spin ispin to orbital with index iorb - ! output resulting det and phase in key_new and phase - END_DOC - integer, intent(in) :: iorb, ispin, Nint - integer(bit_kind), intent(in) :: key_ref(Nint,2) - integer(bit_kind), intent(out) :: key_new(Nint,2) - double precision, intent(out) :: phase - - integer :: k,l,i - - double precision, parameter :: p(0:1) = (/ 1.d0, -1.d0 /) - - ASSERT (iorb > 0) - ASSERT (ispin > 0) - ASSERT (ispin < 3) - ASSERT (Nint > 0) - - key_new=key_ref - - ! alpha det is list of Nint 64-bit ints - ! k is index of the int where iorb is found - ! l is index of the bit where iorb is found - k = ishft(iorb-1,-bit_kind_shift)+1 - ASSERT (k >0) - l = iorb - ishft(k-1,bit_kind_shift)-1 - ASSERT (l >= 0) - key_new(k,ispin) = ibclr(key_new(k,ispin),l) - - integer(bit_kind) :: parity_filled - - ! I assume here that the ordering is all alpha spinorbs and then all beta spinorbs - ! If we add an alpha electron, parity is not affected by beta part of determinant - ! (only need number of alpha occupied orbs below iorb) - - ! If we add a beta electron, the parity is affected by alpha part - ! (need total number of occupied alpha orbs (all of which come before beta) - ! and total number of beta occupied orbs below iorb) - - if (ispin==1) then - parity_filled=0_bit_kind - else - parity_filled=iand(int(elec_alpha_num,bit_kind),1_bit_kind) - endif - - ! get parity due to orbs in other ints (with lower indices) - do i=1,k-1 - parity_filled = iand(int(popcnt(key_ref(i,ispin)),bit_kind),parity_filled) - enddo - - ! get parity due to orbs in same int as iorb - ! ishft(1_bit_kind,l)-1 has its l rightmost bits set to 1, other bits set to 0 - parity_filled = iand(int(popcnt(iand(ishft(1_bit_kind,l)-1,key_ref(k,ispin))),bit_kind),parity_filled) - phase = p(iand(1_bit_kind,parity_filled)) - -end -!BEGIN_PROVIDER [ double precision, mo_mono_elec_integral_diag,(mo_num)] -! implicit none -! integer :: i -! BEGIN_DOC -! ! diagonal elements of mo_mono_elec_integral array -! END_DOC -! print*,'Providing the mono electronic integrals (diagonal)' -! -! do i = 1, mo_num -! mo_mono_elec_integral_diag(i) = real(mo_mono_elec_integral(i,i)) -! enddo -! -!END_PROVIDER From c94ec826ccbef6ed3ae75b7ebc86684cb25b7077 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 11 Jun 2020 13:48:55 -0500 Subject: [PATCH 221/256] fixed transformation (#116) smaller three to four index transformation * minor fix * fixed integral transformation; added complex fcidump; fixed kpts bitmasks --- src/bitmask/core_inact_act_virt.irp.f | 10 +-- src/mo_two_e_ints/df_mo_ints.irp.f | 6 +- src/tools/fcidump.irp.f | 91 +++++++++++++++++++++++++++ src/utils/constants.include.F | 1 + 4 files changed, 101 insertions(+), 7 deletions(-) diff --git a/src/bitmask/core_inact_act_virt.irp.f b/src/bitmask/core_inact_act_virt.irp.f index d2efef89..ae00d774 100644 --- a/src/bitmask/core_inact_act_virt.irp.f +++ b/src/bitmask/core_inact_act_virt.irp.f @@ -448,7 +448,7 @@ BEGIN_PROVIDER [ integer, n_core_orb_kpts, (kpt_num)] do k=1,kpt_num n_core_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Core')then n_core_orb_kpts(k) += 1 @@ -469,7 +469,7 @@ BEGIN_PROVIDER [ integer, n_inact_orb_kpts, (kpt_num)] do k=1,kpt_num n_inact_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Inactive')then n_inact_orb_kpts(k) += 1 @@ -490,7 +490,7 @@ BEGIN_PROVIDER [ integer, n_act_orb_kpts, (kpt_num)] do k=1,kpt_num n_act_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Active')then n_act_orb_kpts(k) += 1 @@ -511,7 +511,7 @@ BEGIN_PROVIDER [ integer, n_virt_orb_kpts, (kpt_num)] do k=1,kpt_num n_virt_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Virtual')then n_virt_orb_kpts(k) += 1 @@ -532,7 +532,7 @@ BEGIN_PROVIDER [ integer, n_del_orb_kpts, (kpt_num)] do k=1,kpt_num n_del_orb_kpts(k) = 0 - kshift = (1-k)*mo_num_per_kpt + kshift = (k-1)*mo_num_per_kpt do i = 1, mo_num_per_kpt if(mo_class(i+kshift) == 'Deleted')then n_del_orb_kpts(k) += 1 diff --git a/src/mo_two_e_ints/df_mo_ints.irp.f b/src/mo_two_e_ints/df_mo_ints.irp.f index 3a61911e..eba3b3da 100644 --- a/src/mo_two_e_ints/df_mo_ints.irp.f +++ b/src/mo_two_e_ints/df_mo_ints.irp.f @@ -48,7 +48,8 @@ subroutine mo_map_fill_from_df_dot logical :: use_map1 integer(key_kind) :: idx_tmp double precision :: sign - complex*16, external :: zdotc + !complex*16, external :: zdotc + complex*16, external :: zdotu mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt @@ -145,7 +146,8 @@ subroutine mo_map_fill_from_df_dot if ((j==l) .and. (i>k)) exit call idx2_tri_int(i,k,ik2) if (ik2 > jl2) exit - integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) + !integral = zdotc(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) + integral = zdotu(df_num,ints_jl(1,ij,il),1,ints_ik(1,ii,ik),1) ! print*,i,k,j,l,real(integral),imag(integral) if (cdabs(integral) < mo_integrals_threshold) then cycle diff --git a/src/tools/fcidump.irp.f b/src/tools/fcidump.irp.f index bf4d07fb..de878dc6 100644 --- a/src/tools/fcidump.irp.f +++ b/src/tools/fcidump.irp.f @@ -18,6 +18,97 @@ program fcidump ! electrons ! END_DOC + if (is_complex) then + call fcidump_complex + else + call fcidump_real + endif +end + +subroutine fcidump_complex + implicit none + character*(128) :: output + integer :: i_unit_output,getUnitAndOpen + output=trim(ezfio_filename)//'.FCIDUMP' + i_unit_output = getUnitAndOpen(output,'w') + + integer :: i,j,k,l + integer :: i1,j1,k1,l1 + integer :: i2,j2,k2,l2,ik2,jl2 + integer :: ki,kj,kk,kl + integer :: ii,ij,ik,il + integer*8 :: m + character*(2), allocatable :: A(:) + + write(i_unit_output,*) '&FCI NORB=', n_act_orb, ', NELEC=', elec_num-n_core_orb*2, & + ', MS2=', (elec_alpha_num-elec_beta_num), ',' + allocate (A(n_act_orb)) + A = '1,' + write(i_unit_output,*) 'ORBSYM=', (A(i), i=1,n_act_orb) + write(i_unit_output,*) 'ISYM=0,' + write(i_unit_output,*) '/' + deallocate(A) + + integer(key_kind), allocatable :: keys(:) + double precision, allocatable :: values(:) + integer(cache_map_size_kind) :: n_elements, n_elements_max + PROVIDE mo_two_e_integrals_in_map + + complex*16 :: get_two_e_integral_complex, integral + + do kl=1,kpt_num + do kj=1,kl + do kk=1,kl + ki=kconserv(kl,kk,kj) + if (ki>kl) cycle + do l1=1,n_act_orb_kpts(kl) + il=list_act_kpts(l1,kl) + l = (kl-1)*mo_num_per_kpt + il + do j1=1,n_act_orb_kpts(kj) + ij=list_act_kpts(j1,kj) + j = (kj-1)*mo_num_per_kpt + ij + if (j>l) exit + call idx2_tri_int(j,l,jl2) + do k1=1,n_act_orb_kpts(kk) + ik=list_act_kpts(k1,kk) + k = (kk-1)*mo_num_per_kpt + ik + if (k>l) exit + do i1=1,n_act_orb_kpts(ki) + ii=list_act_kpts(i1,ki) + i = (ki-1)*mo_num_per_kpt + ii + if ((j==l) .and. (i>k)) exit + call idx2_tri_int(i,k,ik2) + if (ik2 > jl2) exit + integral = get_two_e_integral_complex(i,j,k,l,mo_integrals_map,mo_integrals_map_2) + if (cdabs(integral) > mo_integrals_threshold) then + write(i_unit_output,'(2(E25.15,X),4(I6,X))') dble(integral), dimag(integral),i,k,j,l + endif + enddo + enddo + enddo + enddo + enddo + enddo + enddo + + do kj=1,kpt_num + do j1=1,n_act_orb_kpts(kj) + ij = list_act_kpts(j1,kj) + j = (kj-1)*mo_num_per_kpt + ij + do i1=j1,n_act_orb_kpts(kj) + ii = list_act_kpts(i1,kj) + i = (kj-1)*mo_num_per_kpt + ii + integral = mo_one_e_integrals_kpts(ii,ij,kj) + core_fock_operator_complex(i,j) + if (cdabs(integral) > mo_integrals_threshold) then + write(i_unit_output,'(2(E25.15,X),4(I6,X))') dble(integral),dimag(integral), i,j,0,0 + endif + enddo + enddo + enddo + write(i_unit_output,*) core_energy, 0, 0, 0, 0 +end +subroutine fcidump_real + implicit none character*(128) :: output integer :: i_unit_output,getUnitAndOpen output=trim(ezfio_filename)//'.FCIDUMP' diff --git a/src/utils/constants.include.F b/src/utils/constants.include.F index 7399b4a6..bad68054 100644 --- a/src/utils/constants.include.F +++ b/src/utils/constants.include.F @@ -7,6 +7,7 @@ double precision, parameter :: sqpi = dsqrt(dacos(-1.d0)) double precision, parameter :: pi_5_2 = 34.9868366552d0 double precision, parameter :: dfour_pi = 4.d0*dacos(-1.d0) double precision, parameter :: dtwo_pi = 2.d0*dacos(-1.d0) +double precision, parameter :: inv_pi = 1.d0/dacos(-1.d0) double precision, parameter :: inv_sq_pi = 1.d0/dsqrt(dacos(-1.d0)) double precision, parameter :: inv_sq_pi_2 = 0.5d0/dsqrt(dacos(-1.d0)) double precision, parameter :: thresh = 1.d-15 From 7ae3ab4379bf6f1e77dcdd0a7d74e768f2177c46 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 17 Jun 2020 13:16:00 -0500 Subject: [PATCH 222/256] cleaning after dev merge --- src/ao_one_e_ints/screening.irp.f | 2 +- src/ao_two_e_ints/map_integrals.irp.f | 260 +++++++++--------- src/ao_two_e_ints/map_integrals_cplx.irp.f | 82 +++--- src/ao_two_e_ints/screening.irp.f | 2 +- src/mo_one_e_ints/pot_mo_ints_cplx.irp.f | 16 +- src/scf_utils/huckel_cplx.irp.f | 4 +- .../create_ezfio_complex_3idx.py | 8 +- 7 files changed, 186 insertions(+), 188 deletions(-) diff --git a/src/ao_one_e_ints/screening.irp.f b/src/ao_one_e_ints/screening.irp.f index 1bbe3c73..bc95ea86 100644 --- a/src/ao_one_e_ints/screening.irp.f +++ b/src/ao_one_e_ints/screening.irp.f @@ -3,7 +3,7 @@ logical function ao_one_e_integral_zero(i,k) integer, intent(in) :: i,k ao_one_e_integral_zero = .False. - if (.not.((io_ao_integrals_overlap/='None').or.is_periodic)) then + if (.not.((io_ao_integrals_overlap/='None').or.is_complex)) then if (ao_overlap_abs(i,k) < ao_integrals_threshold) then ao_one_e_integral_zero = .True. return diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 3cf3eadb..3a0a2659 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/src/ao_two_e_ints/map_integrals.irp.f @@ -217,111 +217,111 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result) result = tmp end -BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] - implicit none - BEGIN_DOC - ! Cache of AO integrals for fast access - END_DOC - PROVIDE ao_two_e_integrals_in_map - integer :: i,j,k,l,ii - integer(key_kind) :: idx1, idx2 - real(integral_kind) :: tmp_re, tmp_im - integer(key_kind) :: idx_re,idx_im - complex(integral_kind) :: integral +!BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] +! implicit none +! BEGIN_DOC +! ! Cache of AO integrals for fast access +! END_DOC +! PROVIDE ao_two_e_integrals_in_map +! integer :: i,j,k,l,ii +! integer(key_kind) :: idx1, idx2 +! real(integral_kind) :: tmp_re, tmp_im +! integer(key_kind) :: idx_re,idx_im +! complex(integral_kind) :: integral +! +! +! !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) +! do l=ao_integrals_cache_min,ao_integrals_cache_max +! do k=ao_integrals_cache_min,ao_integrals_cache_max +! do j=ao_integrals_cache_min,ao_integrals_cache_max +! do i=ao_integrals_cache_min,ao_integrals_cache_max +! !DIR$ FORCEINLINE +! call two_e_integrals_index_2fold(i,j,k,l,idx1) +! !DIR$ FORCEINLINE +! call two_e_integrals_index_2fold(k,l,i,j,idx2) +! idx_re = min(idx1,idx2) +! idx_im = max(idx1,idx2) +! !DIR$ FORCEINLINE +! call map_get(ao_integrals_map,idx_re,tmp_re) +! if (idx_re /= idx_im) then +! call map_get(ao_integrals_map,idx_im,tmp_im) +! if (idx1 < idx2) then +! integral = dcmplx(tmp_re,tmp_im) +! else +! integral = dcmplx(tmp_re,-tmp_im) +! endif +! else +! tmp_im = 0.d0 +! integral = dcmplx(tmp_re,tmp_im) +! endif +! +! ii = l-ao_integrals_cache_min +! ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) +! ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) +! ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) +! ao_integrals_cache_periodic(ii) = integral +! enddo +! enddo +! enddo +! enddo +! !$OMP END PARALLEL DO +! +!END_PROVIDER - !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral) - do l=ao_integrals_cache_min,ao_integrals_cache_max - do k=ao_integrals_cache_min,ao_integrals_cache_max - do j=ao_integrals_cache_min,ao_integrals_cache_max - do i=ao_integrals_cache_min,ao_integrals_cache_max - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(i,j,k,l,idx1) - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(k,l,i,j,idx2) - idx_re = min(idx1,idx2) - idx_im = max(idx1,idx2) - !DIR$ FORCEINLINE - call map_get(ao_integrals_map,idx_re,tmp_re) - if (idx_re /= idx_im) then - call map_get(ao_integrals_map,idx_im,tmp_im) - if (idx1 < idx2) then - integral = dcmplx(tmp_re,tmp_im) - else - integral = dcmplx(tmp_re,-tmp_im) - endif - else - tmp_im = 0.d0 - integral = dcmplx(tmp_re,tmp_im) - endif - - ii = l-ao_integrals_cache_min - ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - ao_integrals_cache_periodic(ii) = integral - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - -END_PROVIDER - - -complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) - use map_module - implicit none - BEGIN_DOC - ! Gets one AO bi-electronic integral from the AO map - END_DOC - integer, intent(in) :: i,j,k,l - integer(key_kind) :: idx1,idx2 - real(integral_kind) :: tmp_re, tmp_im - integer(key_kind) :: idx_re,idx_im - type(map_type), intent(inout) :: map - integer :: ii - complex(integral_kind) :: tmp - PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min - !DIR$ FORCEINLINE - logical, external :: ao_two_e_integral_zero - if (ao_two_e_integral_zero(i,j,k,l)) then - tmp = (0.d0,0.d0) - else - ii = l-ao_integrals_cache_min - ii = ior(ii, k-ao_integrals_cache_min) - ii = ior(ii, j-ao_integrals_cache_min) - ii = ior(ii, i-ao_integrals_cache_min) - if (iand(ii, -64) /= 0) then - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(i,j,k,l,idx1) - !DIR$ FORCEINLINE - call two_e_integrals_index_2fold(k,l,i,j,idx2) - idx_re = min(idx1,idx2) - idx_im = max(idx1,idx2) - !DIR$ FORCEINLINE - call map_get(ao_integrals_map,idx_re,tmp_re) - if (idx_re /= idx_im) then - call map_get(ao_integrals_map,idx_im,tmp_im) - if (idx1 < idx2) then - tmp = dcmplx(tmp_re,tmp_im) - else - tmp = dcmplx(tmp_re,-tmp_im) - endif - else - tmp_im = 0.d0 - tmp = dcmplx(tmp_re,tmp_im) - endif - else - ii = l-ao_integrals_cache_min - ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) - ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) - tmp = ao_integrals_cache_periodic(ii) - endif - result = tmp - endif -end +!complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result) +! use map_module +! implicit none +! BEGIN_DOC +! ! Gets one AO bi-electronic integral from the AO map +! END_DOC +! integer, intent(in) :: i,j,k,l +! integer(key_kind) :: idx1,idx2 +! real(integral_kind) :: tmp_re, tmp_im +! integer(key_kind) :: idx_re,idx_im +! type(map_type), intent(inout) :: map +! integer :: ii +! complex(integral_kind) :: tmp +! PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min +! !DIR$ FORCEINLINE +! logical, external :: ao_two_e_integral_zero +! if (ao_two_e_integral_zero(i,j,k,l)) then +! tmp = (0.d0,0.d0) +! else +! ii = l-ao_integrals_cache_min +! ii = ior(ii, k-ao_integrals_cache_min) +! ii = ior(ii, j-ao_integrals_cache_min) +! ii = ior(ii, i-ao_integrals_cache_min) +! if (iand(ii, -64) /= 0) then +! !DIR$ FORCEINLINE +! call two_e_integrals_index_2fold(i,j,k,l,idx1) +! !DIR$ FORCEINLINE +! call two_e_integrals_index_2fold(k,l,i,j,idx2) +! idx_re = min(idx1,idx2) +! idx_im = max(idx1,idx2) +! !DIR$ FORCEINLINE +! call map_get(ao_integrals_map,idx_re,tmp_re) +! if (idx_re /= idx_im) then +! call map_get(ao_integrals_map,idx_im,tmp_im) +! if (idx1 < idx2) then +! tmp = dcmplx(tmp_re,tmp_im) +! else +! tmp = dcmplx(tmp_re,-tmp_im) +! endif +! else +! tmp_im = 0.d0 +! tmp = dcmplx(tmp_re,tmp_im) +! endif +! else +! ii = l-ao_integrals_cache_min +! ii = ior( shiftl(ii,6), k-ao_integrals_cache_min) +! ii = ior( shiftl(ii,6), j-ao_integrals_cache_min) +! ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) +! tmp = ao_integrals_cache_periodic(ii) +! endif +! result = tmp +! endif +!end subroutine get_ao_two_e_integrals(j,k,l,sze,out_val) @@ -353,33 +353,33 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val) end -subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) - use map_module - BEGIN_DOC - ! Gets multiple AO bi-electronic integral from the AO map . - ! All i are retrieved for j,k,l fixed. - ! physicist convention : - END_DOC - implicit none - integer, intent(in) :: j,k,l, sze - complex(integral_kind), intent(out) :: out_val(sze) - - integer :: i - integer(key_kind) :: hash - logical, external :: ao_one_e_integral_zero - PROVIDE ao_two_e_integrals_in_map ao_integrals_map - - if (ao_one_e_integral_zero(j,l)) then - out_val = 0.d0 - return - endif - - double precision :: get_ao_two_e_integral - do i=1,sze - out_val(i) = get_ao_two_e_integral(i,j,k,l,ao_integrals_map) - enddo - -end +!subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) +! use map_module +! BEGIN_DOC +! ! Gets multiple AO bi-electronic integral from the AO map . +! ! All i are retrieved for j,k,l fixed. +! ! physicist convention : +! END_DOC +! implicit none +! integer, intent(in) :: j,k,l, sze +! complex(integral_kind), intent(out) :: out_val(sze) +! +! integer :: i +! integer(key_kind) :: hash +! logical, external :: ao_one_e_integral_zero +! PROVIDE ao_two_e_integrals_in_map ao_integrals_map +! +! if (ao_one_e_integral_zero(j,l)) then +! out_val = 0.d0 +! return +! endif +! +! double precision :: get_ao_two_e_integral +! do i=1,sze +! out_val(i) = get_ao_two_e_integral(i,j,k,l,ao_integrals_map) +! enddo +! +!end subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int) use map_module diff --git a/src/ao_two_e_ints/map_integrals_cplx.irp.f b/src/ao_two_e_ints/map_integrals_cplx.irp.f index 449bca02..a5926e59 100644 --- a/src/ao_two_e_ints/map_integrals_cplx.irp.f +++ b/src/ao_two_e_ints/map_integrals_cplx.irp.f @@ -343,11 +343,10 @@ complex*16 function get_ao_two_e_integral_complex(i,j,k,l,map,map2) result(resul ! a.le.c, b.le.d, tri(a,c).le.tri(b,d) PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_complex ao_integrals_cache_min !DIR$ FORCEINLINE -! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then -! tmp = (0.d0,0.d0) -! else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then -! tmp = (0.d0,0.d0) -! else + !logical, external :: ao_two_e_integral_zero + !if (ao_two_e_integral_zero(i,j,k,l)) then + ! tmp = (0.d0,0.d0) + !else if (.True.) then ii = l-ao_integrals_cache_min ii = ior(ii, k-ao_integrals_cache_min) @@ -362,8 +361,8 @@ complex*16 function get_ao_two_e_integral_complex(i,j,k,l,map,map2) result(resul ii = ior( shiftl(ii,6), i-ao_integrals_cache_min) tmp = ao_integrals_cache_complex(ii) endif - result = tmp endif + result = tmp end @@ -380,14 +379,13 @@ subroutine get_ao_two_e_integrals_complex(j,k,l,sze,out_val) integer :: i integer(key_kind) :: hash - double precision :: thresh + !logical, external :: ao_one_e_integral_zero PROVIDE ao_two_e_integrals_in_map ao_integrals_map - thresh = ao_integrals_threshold - if (ao_overlap_abs(j,l) < thresh) then - out_val = (0.d0,0.d0) - return - endif + !if (ao_one_e_integral_zero(j,l)) then + ! out_val = (0.d0,0.d0) + ! return + !endif complex*16 :: get_ao_two_e_integral_complex do i=1,sze @@ -397,17 +395,17 @@ subroutine get_ao_two_e_integrals_complex(j,k,l,sze,out_val) end subroutine get_ao_two_e_integrals_non_zero_complex(j,k,l,sze,out_val,out_val_index,non_zero_int) + use map_module + implicit none + BEGIN_DOC + ! Gets multiple AO bi-electronic integral from the AO map . + ! All non-zero i are retrieved for j,k,l fixed. + END_DOC + integer, intent(in) :: j,k,l, sze + complex(integral_kind), intent(out) :: out_val(sze) + integer, intent(out) :: out_val_index(sze),non_zero_int print*,'not implemented for periodic',irp_here stop -1 -! use map_module -! implicit none -! BEGIN_DOC -! ! Gets multiple AO bi-electronic integral from the AO map . -! ! All non-zero i are retrieved for j,k,l fixed. -! END_DOC -! integer, intent(in) :: j,k,l, sze -! real(integral_kind), intent(out) :: out_val(sze) -! integer, intent(out) :: out_val_index(sze),non_zero_int ! ! integer :: i ! integer(key_kind) :: hash @@ -445,18 +443,18 @@ end subroutine get_ao_two_e_integrals_non_zero_jl_complex(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int) + use map_module + implicit none + BEGIN_DOC + ! Gets multiple AO bi-electronic integral from the AO map . + ! All non-zero i are retrieved for j,k,l fixed. + END_DOC + double precision, intent(in) :: thresh + integer, intent(in) :: j,l, sze,sze_max + complex(integral_kind), intent(out) :: out_val(sze_max) + integer, intent(out) :: out_val_index(2,sze_max),non_zero_int print*,'not implemented for periodic',irp_here stop -1 -! use map_module -! implicit none -! BEGIN_DOC -! ! Gets multiple AO bi-electronic integral from the AO map . -! ! All non-zero i are retrieved for j,k,l fixed. -! END_DOC -! double precision, intent(in) :: thresh -! integer, intent(in) :: j,l, sze,sze_max -! real(integral_kind), intent(out) :: out_val(sze_max) -! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int ! ! integer :: i,k ! integer(key_kind) :: hash @@ -496,19 +494,19 @@ end subroutine get_ao_two_e_integrals_non_zero_jl_from_list_complex(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int) + use map_module + implicit none + BEGIN_DOC + ! Gets multiple AO two-electron integrals from the AO map . + ! All non-zero i are retrieved for j,k,l fixed. + END_DOC + double precision, intent(in) :: thresh + integer, intent(in) :: sze_max + integer, intent(in) :: j,l, n_list,list(2,sze_max) + complex(integral_kind), intent(out) :: out_val(sze_max) + integer, intent(out) :: out_val_index(2,sze_max),non_zero_int print*,'not implemented for periodic',irp_here stop -1 -! use map_module -! implicit none -! BEGIN_DOC -! ! Gets multiple AO two-electron integrals from the AO map . -! ! All non-zero i are retrieved for j,k,l fixed. -! END_DOC -! double precision, intent(in) :: thresh -! integer, intent(in) :: sze_max -! integer, intent(in) :: j,l, n_list,list(2,sze_max) -! real(integral_kind), intent(out) :: out_val(sze_max) -! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int ! ! integer :: i,k ! integer(key_kind) :: hash diff --git a/src/ao_two_e_ints/screening.irp.f b/src/ao_two_e_ints/screening.irp.f index d3230370..eebe0043 100644 --- a/src/ao_two_e_ints/screening.irp.f +++ b/src/ao_two_e_ints/screening.irp.f @@ -3,7 +3,7 @@ logical function ao_two_e_integral_zero(i,j,k,l) integer, intent(in) :: i,j,k,l ao_two_e_integral_zero = .False. - if (.not.(read_ao_two_e_integrals.or.is_periodic)) then + if (.not.(read_ao_two_e_integrals.or.is_complex)) then if (ao_overlap_abs(j,l)*ao_overlap_abs(i,k) < ao_integrals_threshold) then ao_two_e_integral_zero = .True. return diff --git a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f index a9f793d9..f472a8ff 100644 --- a/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints_cplx.irp.f @@ -6,8 +6,8 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] integer :: i,j print *, 'Providing MO N-e integrals' - if (read_mo_integrals_e_n) then - call ezfio_get_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex) + if (read_mo_integrals_n_e) then + call ezfio_get_mo_one_e_ints_mo_integrals_n_e_complex(mo_integrals_n_e_complex) print *, 'MO N-e integrals read from disk' else print *, 'Providing MO N-e integrals from AO N-e integrals' @@ -18,8 +18,8 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)] size(mo_integrals_n_e_complex,1) & ) endif - if (write_mo_integrals_e_n) then - call ezfio_set_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex) + if (write_mo_integrals_n_e) then + call ezfio_set_mo_one_e_ints_mo_integrals_n_e_complex(mo_integrals_n_e_complex) print *, 'MO N-e integrals written to disk' endif @@ -39,8 +39,8 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_kpts, (mo_num_per_kpt,mo_num_per_kp integer :: i,j print *, 'Providing MO N-e integrals' - if (read_mo_integrals_e_n) then - call ezfio_get_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts) + if (read_mo_integrals_n_e) then + call ezfio_get_mo_one_e_ints_mo_integrals_n_e_kpts(mo_integrals_n_e_kpts) print *, 'MO N-e integrals read from disk' else print *, 'Providing MO N-e integrals from AO N-e integrals' @@ -51,8 +51,8 @@ BEGIN_PROVIDER [complex*16, mo_integrals_n_e_kpts, (mo_num_per_kpt,mo_num_per_kp size(mo_integrals_n_e_kpts,1) & ) endif - if (write_mo_integrals_e_n) then - call ezfio_set_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts) + if (write_mo_integrals_n_e) then + call ezfio_set_mo_one_e_ints_mo_integrals_n_e_kpts(mo_integrals_n_e_kpts) print *, 'MO N-e integrals written to disk' endif diff --git a/src/scf_utils/huckel_cplx.irp.f b/src/scf_utils/huckel_cplx.irp.f index ec504d14..f5dee3a4 100644 --- a/src/scf_utils/huckel_cplx.irp.f +++ b/src/scf_utils/huckel_cplx.irp.f @@ -19,7 +19,7 @@ subroutine huckel_guess_complex enddo A(j,j) = ao_one_e_integrals_diag_complex(j) + dble(ao_two_e_integral_alpha_complex(j,j)) if (dabs(dimag(ao_two_e_integral_alpha_complex(j,j))) .gt. 1.0d-10) then - stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' + stop 'diagonal elements of ao_two_e_integral_alpha should be real' endif enddo @@ -67,7 +67,7 @@ subroutine huckel_guess_kpts enddo A(j,j) = ao_one_e_integrals_diag_kpts(j,k) + dble(ao_two_e_integral_alpha_kpts(j,j,k)) if (dabs(dimag(ao_two_e_integral_alpha_kpts(j,j,k))) .gt. 1.0d-10) then - stop 'diagonal elements of ao_bi_elec_integral_alpha should be real' + stop 'diagonal elements of ao_two_e_integral_alpha should be real' endif enddo diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 0360cfe8..3fef73d2 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -145,12 +145,12 @@ def convert_kpts(filename,qph5path): ezfio.set_mo_one_e_ints_mo_integrals_kinetic_kpts(kin_mo_reim) ezfio.set_mo_one_e_ints_mo_integrals_overlap_kpts(ovlp_mo_reim) #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) - ezfio.set_mo_one_e_ints_mo_integrals_e_n_kpts(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_n_e_kpts(ne_mo_reim) ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') - ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') ########################################## # # @@ -331,12 +331,12 @@ def convert_cplx(filename,qph5path): ezfio.set_mo_one_e_ints_mo_integrals_kinetic_complex(kin_mo_reim) #ezfio.set_mo_one_e_ints_mo_integrals_overlap_complex(ovlp_mo_reim) #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) - ezfio.set_mo_one_e_ints_mo_integrals_e_n_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') #ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') - ezfio.set_mo_one_e_ints_io_mo_integrals_e_n('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') ########################################## # # From 83ecf1ee2eb2f469563c6248fd7150aa57743320 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 22 Jun 2020 10:51:33 -0500 Subject: [PATCH 223/256] modifications for kpts {ao,mo}_num_per_kpt were being set as floats in python now imported explicitly as ints no default (could maybe fix with // ?) --- src/ao_basis/EZFIO.cfg | 5 +-- src/ao_basis/aos_cplx.irp.f | 14 +++---- src/determinants/density_matrix_cplx.irp.f | 4 +- src/mo_basis/EZFIO.cfg | 1 - src/mo_basis/mos.irp.f | 41 +++++++++++++++++++ src/mo_basis/mos_cplx.irp.f | 14 +++---- .../create_ezfio_complex_3idx.py | 2 + 7 files changed, 61 insertions(+), 20 deletions(-) diff --git a/src/ao_basis/EZFIO.cfg b/src/ao_basis/EZFIO.cfg index 5f7e3bf7..2d9dd2fb 100644 --- a/src/ao_basis/EZFIO.cfg +++ b/src/ao_basis/EZFIO.cfg @@ -69,7 +69,6 @@ default: true [ao_num_per_kpt] type: integer -doc: Number of |AOs| per kpt -default: =(ao_basis.ao_num/nuclei.kpt_num) -interface: ezfio +doc: Max number of |AOs| per kpt +interface: ezfio, provider diff --git a/src/ao_basis/aos_cplx.irp.f b/src/ao_basis/aos_cplx.irp.f index afec0548..f571b28d 100644 --- a/src/ao_basis/aos_cplx.irp.f +++ b/src/ao_basis/aos_cplx.irp.f @@ -1,7 +1,7 @@ -BEGIN_PROVIDER [ integer, ao_num_per_kpt ] - implicit none - BEGIN_DOC - ! number of aos per kpt. - END_DOC - ao_num_per_kpt = ao_num/kpt_num -END_PROVIDER +!BEGIN_PROVIDER [ integer, ao_num_per_kpt ] +! implicit none +! BEGIN_DOC +! ! number of aos per kpt. +! END_DOC +! ao_num_per_kpt = ao_num/kpt_num +!END_PROVIDER diff --git a/src/determinants/density_matrix_cplx.irp.f b/src/determinants/density_matrix_cplx.irp.f index d7281e76..882b73ee 100644 --- a/src/determinants/density_matrix_cplx.irp.f +++ b/src/determinants/density_matrix_cplx.irp.f @@ -441,8 +441,8 @@ END_PROVIDER !$OMP PRIVATE(j,k,k_a,k_b,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,& !$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2,ih1,ip1,kh1,kp1,kk,& !$OMP tmp_det_kpts,k_shft,ii)& - !$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states,elec_alpha_num_kpts, & - !$OMP elec_beta_num_kpts,one_e_dm_mo_alpha_kpts,one_e_dm_mo_beta_kpts,N_det,& + !$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states, & + !$OMP one_e_dm_mo_alpha_kpts,one_e_dm_mo_beta_kpts,N_det,& !$OMP mo_num_per_kpt,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns,& !$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns,& !$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique,& diff --git a/src/mo_basis/EZFIO.cfg b/src/mo_basis/EZFIO.cfg index 76ee15e9..762eb268 100644 --- a/src/mo_basis/EZFIO.cfg +++ b/src/mo_basis/EZFIO.cfg @@ -52,6 +52,5 @@ interface: ezfio [mo_num_per_kpt] type: integer doc: Number of |MOs| per kpt -default: =(mo_basis.mo_num/nuclei.kpt_num) interface: ezfio diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index d8ff9cde..440d1703 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -39,6 +39,47 @@ BEGIN_PROVIDER [ integer, mo_num ] END_PROVIDER +BEGIN_PROVIDER [ integer, mo_num_per_kpt ] + implicit none + BEGIN_DOC + ! Number of MOs per kpt + END_DOC + + logical :: has + PROVIDE ezfio_filename + if (mpi_master) then + call ezfio_has_mo_basis_mo_num_per_kpt(has) + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( has, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_num_per_kpt with MPI' + endif + IRP_ENDIF + if (.not.has) then + mo_num_per_kpt = ao_ortho_canonical_num_per_kpt_max + else + if (mpi_master) then + call ezfio_get_mo_basis_mo_num_per_kpt(mo_num_per_kpt) + endif + IRP_IF MPI + call MPI_BCAST( mo_num_per_kpt, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_num_per_kpt with MPI' + endif + IRP_ENDIF + endif + call write_int(6,mo_num_per_kpt,'mo_num_per_kpt') + ASSERT (mo_num_per_kpt > 0) + +END_PROVIDER + BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_num) ] implicit none diff --git a/src/mo_basis/mos_cplx.irp.f b/src/mo_basis/mos_cplx.irp.f index fb90d807..19abe30e 100644 --- a/src/mo_basis/mos_cplx.irp.f +++ b/src/mo_basis/mos_cplx.irp.f @@ -1,10 +1,10 @@ -BEGIN_PROVIDER [ integer, mo_num_per_kpt ] - implicit none - BEGIN_DOC - ! number of mos per kpt. - END_DOC - mo_num_per_kpt = mo_num/kpt_num -END_PROVIDER +!BEGIN_PROVIDER [ integer, mo_num_per_kpt ] +! implicit none +! BEGIN_DOC +! ! number of mos per kpt. +! END_DOC +! mo_num_per_kpt = mo_num/kpt_num +!END_PROVIDER BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ] implicit none diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 3fef73d2..05399a7b 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -34,6 +34,8 @@ def convert_kpts(filename,qph5path): # need to change if we want to truncate orbital space within pyscf ezfio.set_ao_basis_ao_num(ao_num) ezfio.set_mo_basis_mo_num(mo_num) + ezfio.set_ao_basis_ao_num_per_kpt(ao_num//kpt_num) + ezfio.set_mo_basis_mo_num_per_kpt(mo_num//kpt_num) ezfio.electrons_elec_alpha_num = elec_alpha_num ezfio.electrons_elec_beta_num = elec_beta_num From 1b298d083de83b136973d32a24b278b8b26a07c6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 23 Jun 2020 11:11:36 -0500 Subject: [PATCH 224/256] added lin_dep_cutoff in complex calls --- src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f | 4 ++-- src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f | 4 ++-- src/ao_one_e_ints/ao_overlap.irp.f | 2 +- src/mo_guess/mo_ortho_lowdin_cplx.irp.f | 4 ++-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f index 87a30d2d..1245ae6e 100644 --- a/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f @@ -68,7 +68,7 @@ END_PROVIDER ao_ortho_canonical_num_complex = ao_num call ortho_canonical_complex(ao_overlap,size(ao_overlap,1), & ao_num,ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1), & - ao_ortho_canonical_num_complex) + ao_ortho_canonical_num_complex,lin_dep_cutoff) else @@ -83,7 +83,7 @@ END_PROVIDER ao_ortho_canonical_num_complex = ao_cart_to_sphe_num call ortho_canonical_complex(ao_cart_to_sphe_overlap_complex, size(ao_cart_to_sphe_overlap_complex,1), & - ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num_complex) + ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num_complex,lin_dep_cutoff) call zgemm('N','N', ao_num, ao_ortho_canonical_num_complex, ao_cart_to_sphe_num, (1.d0,0.d0), & ao_cart_to_sphe_coef_complex, size(ao_cart_to_sphe_coef_complex,1), & diff --git a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f index 01a02f02..acfae4f8 100644 --- a/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f +++ b/src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f @@ -135,7 +135,7 @@ END_PROVIDER do k=1,kpt_num call ortho_canonical_complex(ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), & ao_num_per_kpt,ao_ortho_canonical_coef_kpts(:,:,k),size(ao_ortho_canonical_coef_kpts,1), & - ao_ortho_canonical_num_per_kpt(k)) + ao_ortho_canonical_num_per_kpt(k),lin_dep_cutoff) enddo @@ -152,7 +152,7 @@ END_PROVIDER ao_ortho_canonical_num_per_kpt(k) = ao_cart_to_sphe_num_per_kpt call ortho_canonical_complex(ao_cart_to_sphe_overlap_kpts, size(ao_cart_to_sphe_overlap_kpts,1), & - ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k)) + ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k),lin_dep_cutoff) call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), & ao_cart_to_sphe_coef_kpts, size(ao_cart_to_sphe_coef_kpts,1), & diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index d7ddf440..b6191b86 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -218,7 +218,7 @@ BEGIN_PROVIDER [ complex*16, S_inv_kpts,(ao_num_per_kpt,ao_num_per_kpt,kpt_num) integer :: k do k=1,kpt_num call get_pseudo_inverse_complex(ao_overlap_kpts(1,1,k), & - size(ao_overlap_kpts,1),ao_num_per_kpt,ao_num_per_kpt,S_inv_kpts(1,1,k),size(S_inv_kpts,1)) + size(ao_overlap_kpts,1),ao_num_per_kpt,ao_num_per_kpt,S_inv_kpts(1,1,k),size(S_inv_kpts,1),lin_dep_cutoff) enddo END_PROVIDER diff --git a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f index 3a2750cd..b3b64ce4 100644 --- a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f +++ b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_complex, (ao_num,ao_num)] do j=1, ao_num tmp_matrix(j,j) = (1.d0,0.d0) enddo - call ortho_lowdin_complex(ao_overlap_complex,ao_num,ao_num,tmp_matrix,ao_num,ao_num) + call ortho_lowdin_complex(ao_overlap_complex,ao_num,ao_num,tmp_matrix,ao_num,ao_num,lin_dep_cutoff) do i=1, ao_num do j=1, ao_num ao_ortho_lowdin_coef_complex(j,i) = tmp_matrix(i,j) @@ -68,7 +68,7 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_kpts, (ao_num_per_kpt,ao_num_pe do j=1, ao_num tmp_matrix(j,j) = (1.d0,0.d0) enddo - call ortho_lowdin_complex(ao_overlap_kpts(:,:,k),ao_num_per_kpt,ao_num_per_kpt,tmp_matrix,ao_num_per_kpt,ao_num_per_kpt) + call ortho_lowdin_complex(ao_overlap_kpts(:,:,k),ao_num_per_kpt,ao_num_per_kpt,tmp_matrix,ao_num_per_kpt,ao_num_per_kpt,lin_dep_cutoff) do i=1, ao_num_per_kpt do j=1, ao_num_per_kpt ao_ortho_lowdin_coef_kpts(j,i,k) = tmp_matrix(i,j) From 008fc4be2b4930d9be2e2eadb87bab74d17ac50c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 23 Jun 2020 13:09:26 -0500 Subject: [PATCH 225/256] fixed byte vs str handling in converter --- src/utils_complex/create_ezfio_complex_3idx.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/utils_complex/create_ezfio_complex_3idx.py b/src/utils_complex/create_ezfio_complex_3idx.py index 05399a7b..afbe33e2 100755 --- a/src/utils_complex/create_ezfio_complex_3idx.py +++ b/src/utils_complex/create_ezfio_complex_3idx.py @@ -72,6 +72,8 @@ def convert_kpts(filename,qph5path): ezfio.set_nuclei_nucl_charge(nucl_charge) ezfio.set_nuclei_nucl_coord(nucl_coord) + if isinstance(nucl_label[0],bytes): + nucl_label = list(map(lambda x:x.decode(),nucl_label)) ezfio.set_nuclei_nucl_label(nucl_label) ezfio.set_nuclei_io_nuclear_repulsion('Read') @@ -260,6 +262,8 @@ def convert_cplx(filename,qph5path): ezfio.set_nuclei_nucl_charge(nucl_charge) ezfio.set_nuclei_nucl_coord(nucl_coord) + if isinstance(nucl_label[0],bytes): + nucl_label = list(map(lambda x:x.decode(),nucl_label)) ezfio.set_nuclei_nucl_label(nucl_label) ezfio.set_nuclei_io_nuclear_repulsion('Read') From 9242555008b73bedf06516c716ec6d230a105dc1 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 23 Jun 2020 16:44:20 -0500 Subject: [PATCH 226/256] conditional in selection for mo_num_per_kpt --- src/cipsi/selection.irp.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 35ffa402..a3703a62 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -520,7 +520,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d h1 = hole_list(i1,s1) !todo: kpts - kh1 = (h1-1)/mo_num_per_kpt + 1 + if (is_complex) then + kh1 = (h1-1)/mo_num_per_kpt + 1 + endif ! pmask is i_generator det with bit at h1 set to zero call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) From cffb5cd7f62b7a320028a7218bafc93672c0edec Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 24 Jun 2020 16:00:37 -0500 Subject: [PATCH 227/256] set default nuclei/is_complex in converter --- bin/qp_convert_output_to_ezfio | 1 + 1 file changed, 1 insertion(+) diff --git a/bin/qp_convert_output_to_ezfio b/bin/qp_convert_output_to_ezfio index cbc81032..e050e9b9 100755 --- a/bin/qp_convert_output_to_ezfio +++ b/bin/qp_convert_output_to_ezfio @@ -89,6 +89,7 @@ def write_ezfio(res, filename): # W r i t e # # ~#~#~#~#~ # + ezfio.set_nuclei_is_complex(False) ezfio.set_nuclei_nucl_num(len(res.geometry)) ezfio.set_nuclei_nucl_charge(charge) From 6a4659bc1001791bcb9e96bc5ac3a3bd3da4d54e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 1 Jul 2020 13:06:24 -0500 Subject: [PATCH 228/256] placeholder to prevent warning about out values not assigned --- src/ao_two_e_ints/map_integrals_cplx.irp.f | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/ao_two_e_ints/map_integrals_cplx.irp.f b/src/ao_two_e_ints/map_integrals_cplx.irp.f index a5926e59..12d17504 100644 --- a/src/ao_two_e_ints/map_integrals_cplx.irp.f +++ b/src/ao_two_e_ints/map_integrals_cplx.irp.f @@ -406,6 +406,10 @@ subroutine get_ao_two_e_integrals_non_zero_complex(j,k,l,sze,out_val,out_val_ind integer, intent(out) :: out_val_index(sze),non_zero_int print*,'not implemented for periodic',irp_here stop -1 + !placeholder to keep compiler from complaining about out values not assigned + out_val=0.d0 + out_val_index=0 + non_zero_int=0 ! ! integer :: i ! integer(key_kind) :: hash @@ -455,6 +459,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl_complex(j,l,thresh,sze_max,sze,out integer, intent(out) :: out_val_index(2,sze_max),non_zero_int print*,'not implemented for periodic',irp_here stop -1 + !placeholder to keep compiler from complaining about out values not assigned + out_val=0.d0 + out_val_index=0 + non_zero_int=0 ! ! integer :: i,k ! integer(key_kind) :: hash @@ -507,6 +515,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list_complex(j,l,thresh,list, integer, intent(out) :: out_val_index(2,sze_max),non_zero_int print*,'not implemented for periodic',irp_here stop -1 + !placeholder to keep compiler from complaining about out values not assigned + out_val=0.d0 + out_val_index=0 + non_zero_int=0 ! ! integer :: i,k ! integer(key_kind) :: hash From 10bcd38c45c64da1be7146ecec62684b9b0303ec Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 1 Jul 2020 13:07:09 -0500 Subject: [PATCH 229/256] complex print_energy --- src/tools/print_energy.irp.f | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/src/tools/print_energy.irp.f b/src/tools/print_energy.irp.f index 4703e7d4..056531a0 100644 --- a/src/tools/print_energy.irp.f +++ b/src/tools/print_energy.irp.f @@ -8,7 +8,11 @@ program print_energy ! psi_coef_sorted are the wave function stored in the |EZFIO| directory. read_wf = .True. touch read_wf - call run + if (is_complex) then + call run_complex + else + call run + endif end subroutine run @@ -32,3 +36,25 @@ subroutine run print *, E(i)/norm(i) enddo end + +subroutine run_complex + implicit none + integer :: i + complex*16 :: i_h_psi_array(n_states) + double precision :: e(n_states) + double precision :: norm(n_states) + + e(:) = nuclear_repulsion + norm(:) = 0.d0 + do i=1,n_det + call i_H_psi_complex(psi_det(1,1,i), psi_det, psi_coef_complex, N_int, N_det, & + size(psi_coef_complex,1), N_states, i_H_psi_array) + norm(:) += cdabs(psi_coef_complex(i,:))**2 + E(:) += dble(i_h_psi_array(:) * dconjg(psi_coef_complex(i,:))) + enddo + + print *, 'Energy:' + do i=1,N_states + print *, E(i)/norm(i) + enddo +end From d2dc64c4227ca115e8db7a0e15854025b05a87cb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 1 Jul 2020 13:20:35 -0500 Subject: [PATCH 230/256] complex cis and cisd --- scripts/generate_h_apply.py | 18 ++++++++++++++---- src/cis/cis.irp.f | 9 +++++++-- src/cisd/cisd.irp.f | 27 ++++++++++++++++++++------- src/cisd/cisd_routine.irp.f | 9 +++++++-- src/determinants/h_apply.irp.f | 2 +- 5 files changed, 49 insertions(+), 16 deletions(-) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index dc7d340e..abfea976 100644 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -130,9 +130,15 @@ class H_apply(object): !$OMP END PARALLEL call dsort(H_jj,iorder,N_det) - do k=1,N_states - psi_coef(iorder(k),k) = 1.d0 - enddo + if (is_complex) then + do k=1,N_states + psi_coef_complex(iorder(k),k) = (1.d0,0.d0) + enddo + else + do k=1,N_states + psi_coef(iorder(k),k) = 1.d0 + enddo + endif deallocate(H_jj,iorder) """ @@ -141,7 +147,11 @@ class H_apply(object): if (s2_eig) then call make_s2_eigenfunction endif - SOFT_TOUCH psi_det psi_coef N_det + if (is_complex) then + SOFT_TOUCH psi_det psi_coef_complex N_det + else + SOFT_TOUCH psi_det psi_coef N_det + endif """ s["printout_now"] = """write(6,*) & 100.*float(i_generator)/float(N_det_generators), '% in ', wall_1-wall_0, 's'""" diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index 816253c5..5fd76493 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -77,8 +77,13 @@ subroutine run endif call ezfio_set_cis_energy(CI_energy) - psi_coef = ci_eigenvectors - SOFT_TOUCH psi_coef + if (is_complex) then + psi_coef_complex = ci_eigenvectors_complex + SOFT_TOUCH psi_coef_complex + else + psi_coef = ci_eigenvectors + SOFT_TOUCH psi_coef + endif call save_wavefunction end diff --git a/src/cisd/cisd.irp.f b/src/cisd/cisd.irp.f index 6c55e2ff..c3c9f821 100644 --- a/src/cisd/cisd.irp.f +++ b/src/cisd/cisd.irp.f @@ -61,16 +61,29 @@ subroutine run else call H_apply_cisd endif - psi_coef = ci_eigenvectors - SOFT_TOUCH psi_coef + if (is_complex) then + psi_coef_complex = ci_eigenvectors_complex + SOFT_TOUCH psi_coef_complex + else + psi_coef = ci_eigenvectors + SOFT_TOUCH psi_coef + endif call save_wavefunction call ezfio_set_cisd_energy(CI_energy) - do i = 1,N_states - k = maxloc(dabs(psi_coef_sorted(1:N_det,i)),dim=1) - delta_E = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int) - cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2) - enddo + if (is_complex) then + do i = 1,N_states + k = maxloc(cdabs(psi_coef_sorted_complex(1:N_det,i)),dim=1) + delta_E = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int) + cisdq(i) = CI_energy(i) + delta_E * (1.d0 - cdabs(psi_coef_sorted_complex(k,i))**2) + enddo + else + do i = 1,N_states + k = maxloc(dabs(psi_coef_sorted(1:N_det,i)),dim=1) + delta_E = CI_electronic_energy(i) - diag_h_mat_elem(psi_det_sorted(1,1,k),N_int) + cisdq(i) = CI_energy(i) + delta_E * (1.d0 - psi_coef_sorted(k,i)**2) + enddo + endif print *, 'N_det = ', N_det print*,'' print*,'******************************' diff --git a/src/cisd/cisd_routine.irp.f b/src/cisd/cisd_routine.irp.f index 93b31e7d..e243e113 100644 --- a/src/cisd/cisd_routine.irp.f +++ b/src/cisd/cisd_routine.irp.f @@ -20,8 +20,13 @@ subroutine run_cisd print*, i ,CI_energy(i) - CI_energy(1) enddo endif - psi_coef = ci_eigenvectors - SOFT_TOUCH psi_coef + if (is_complex) then + psi_coef_complex = ci_eigenvectors_complex + SOFT_TOUCH psi_coef_complex + else + psi_coef = ci_eigenvectors + SOFT_TOUCH psi_coef + endif call save_wavefunction call ezfio_set_cisd_energy(CI_energy) diff --git a/src/determinants/h_apply.irp.f b/src/determinants/h_apply.irp.f index f73d328a..fcce1645 100644 --- a/src/determinants/h_apply.irp.f +++ b/src/determinants/h_apply.irp.f @@ -256,7 +256,7 @@ subroutine copy_H_apply_buffer_to_wf call remove_duplicates_in_psi_det(found_duplicates) do k=1,N_states - call normalize(psi_coef_complex(1,k),N_det) + call normalize_complex(psi_coef_complex(1,k),N_det) enddo SOFT_TOUCH N_det psi_det psi_coef_complex else From 5d0a54d30be2451632f26d9a2c0b5012976cba0c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 2 Jul 2020 10:46:52 -0500 Subject: [PATCH 231/256] separate CIS for kpts --- src/cis/kpts_cis.irp.f | 580 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 580 insertions(+) create mode 100644 src/cis/kpts_cis.irp.f diff --git a/src/cis/kpts_cis.irp.f b/src/cis/kpts_cis.irp.f new file mode 100644 index 00000000..9bdd0175 --- /dev/null +++ b/src/cis/kpts_cis.irp.f @@ -0,0 +1,580 @@ + +subroutine H_apply_cis_kpts_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generator,iproc_in ) + 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 = 8192 + + 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 + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + 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 :: iproc + + integer(bit_kind) :: key_mask(N_int, 2) + + logical :: check_double_excitation + logical :: is_a_2h1p + logical :: is_a_2h + logical :: is_a_1h1p + logical :: is_a_1h2p + logical :: is_a_1h + logical :: is_a_1p + logical :: is_a_2p + logical :: yes_no + + do k=1,N_int + key_mask(k,1) = 0_bit_kind + key_mask(k,2) = 0_bit_kind + enddo + + iproc = iproc_in + + check_double_excitation = .True. + + + + + + +!$ 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_ab(particle,occ_particle,N_elec_in_key_part_1,N_int) + call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int) + allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_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 + do ispin=1,2 + other_spin = iand(ispin,1)+1 + + 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 = shiftr(i_a-1,bit_kind_shift)+1 + j = i_a-shiftl(k-1,bit_kind_shift)-1 + + hole(k,ispin) = ibclr(hole(k,ispin),j) + k_a = shiftr(j_a-1,bit_kind_shift)+1 + l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1 + + hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + + + + + + + + + + + + + + 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 fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + key_idx = 0 + endif + enddo ! ii + + enddo ! ispin + call fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + + 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) + + + +end + +subroutine H_apply_cis_kpts() + 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 :: i_generator + double precision :: wall_0, wall_1 + integer(bit_kind), allocatable :: mask(:,:,:) + integer(bit_kind), allocatable :: mask_kpts(:,:,:) + integer :: kk + integer :: ispin, k + integer :: iproc + double precision, allocatable :: fock_diag_tmp(:,:) + + + if (is_complex) then + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex + else + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators + endif + + call wall_time(wall_0) + + iproc = 0 + !allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_num+1) ) + allocate( mask_kpts(N_int,2,6,kpt_num), fock_diag_tmp(2,mo_num+1) ) + do i_generator=1,N_det_generators + + ! Compute diagonal of the Fock matrix + !call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) + fock_diag_tmp=0.d0 + + ! Create bit masks for holes and particles + do kk=1,kpt_num + do ispin=1,2 + do k=1,N_int + mask_kpts(k,ispin,s_hole,kk) = & + iand(generators_bitmask_kpts(k,ispin,s_hole,kk), & + psi_det_generators(k,ispin,i_generator) ) + mask_kpts(k,ispin,s_part,kk) = & + iand(generators_bitmask_kpts(k,ispin,s_part,kk), & + not(psi_det_generators(k,ispin,i_generator)) ) + ! mask_kpts(k,ispin,d_hole1,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_hole1,kk), & + ! psi_det_generators(k,ispin,i_generator) ) + ! mask_kpts(k,ispin,d_part1,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_part1,kk), & + ! not(psi_det_generators(k,ispin,i_generator)) ) + ! mask_kpts(k,ispin,d_hole2,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_hole2,kk), & + ! psi_det_generators(k,ispin,i_generator) ) + ! mask_kpts(k,ispin,d_part2,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_part2,kk), & + ! not(psi_det_generators(k,ispin,i_generator)) ) + enddo + enddo + enddo + !if(.False.)then + ! call H_apply_cis_kpts_diexc(psi_det_generators(1,1,i_generator), & + ! psi_det_generators(1,1,1), & + ! mask(1,1,d_hole1), mask(1,1,d_part1), & + ! mask(1,1,d_hole2), mask(1,1,d_part2), & + ! fock_diag_tmp, i_generator, iproc ) + !endif + if(.True.)then + do kk=1,kpt_num + call H_apply_cis_kpts_monoexc(psi_det_generators(1,1,i_generator), & + mask_kpts(1,1,s_hole,kk), mask_kpts(1,1,s_part,kk ), & + fock_diag_tmp, i_generator, iproc ) + enddo + endif + call wall_time(wall_1) + + if (wall_1 - wall_0 > 2.d0) then + write(6,*) & + 100.*float(i_generator)/float(N_det_generators), '% in ', wall_1-wall_0, 's' + wall_0 = wall_1 + endif + enddo + + !deallocate( mask, fock_diag_tmp ) + deallocate( mask_kpts, fock_diag_tmp ) + + call copy_H_apply_buffer_to_wf + if (s2_eig) then + call make_s2_eigenfunction + endif + if (is_complex) then + SOFT_TOUCH psi_det psi_coef_complex N_det + else + SOFT_TOUCH psi_det psi_coef N_det + endif + + + ! Sort H_jj to find the N_states lowest states + integer :: i + integer, allocatable :: iorder(:) + double precision, allocatable :: H_jj(:) + double precision, external :: diag_h_mat_elem + allocate(H_jj(N_det),iorder(N_det)) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(psi_det,N_int,H_jj,iorder,N_det) & + !$OMP PRIVATE(i) + !$OMP DO + do i = 1, N_det + H_jj(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + iorder(i) = i + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dsort(H_jj,iorder,N_det) + if (is_complex) then + do k=1,N_states + psi_coef_complex(iorder(k),k) = (1.d0,0.d0) + enddo + else + do k=1,N_states + psi_coef(iorder(k),k) = 1.d0 + enddo + endif + deallocate(H_jj,iorder) + + +end + + + + +subroutine H_apply_cis_sym_kpts_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generator,iproc_in ) + 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 = 8192 + + 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 + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + 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 :: iproc + + integer(bit_kind) :: key_mask(N_int, 2) + + logical :: check_double_excitation + logical :: is_a_2h1p + logical :: is_a_2h + logical :: is_a_1h1p + logical :: is_a_1h2p + logical :: is_a_1h + logical :: is_a_1p + logical :: is_a_2p + logical :: yes_no + + do k=1,N_int + key_mask(k,1) = 0_bit_kind + key_mask(k,2) = 0_bit_kind + enddo + + iproc = iproc_in + + check_double_excitation = .True. + + + + + + +!$ 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_ab(particle,occ_particle,N_elec_in_key_part_1,N_int) + call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int) + allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_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 + do ispin=1,2 + other_spin = iand(ispin,1)+1 + + 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 = shiftr(i_a-1,bit_kind_shift)+1 + j = i_a-shiftl(k-1,bit_kind_shift)-1 + + hole(k,ispin) = ibclr(hole(k,ispin),j) + k_a = shiftr(j_a-1,bit_kind_shift)+1 + l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1 + + hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + + + + + + + + + + + + + + call connected_to_hf(hole,yes_no) + if (.not.yes_no) cycle + + 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 fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + key_idx = 0 + endif + enddo ! ii + + enddo ! ispin + call fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + + 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) + + + +end + +subroutine H_apply_cis_sym_kpts() + 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 :: i_generator + double precision :: wall_0, wall_1 + integer(bit_kind), allocatable :: mask(:,:,:) + integer(bit_kind), allocatable :: mask_kpts(:,:,:) + integer :: kk + integer :: ispin, k + integer :: iproc + double precision, allocatable :: fock_diag_tmp(:,:) + + + if (is_complex) then + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex + else + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators + endif + + call wall_time(wall_0) + + iproc = 0 + !allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_num+1) ) + allocate( mask_kpts(N_int,2,6,kpt_num), fock_diag_tmp(2,mo_num+1) ) + do i_generator=1,N_det_generators + + ! Compute diagonal of the Fock matrix + !call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) + fock_diag_tmp=0.d0 + + ! Create bit masks for holes and particles + do kk=1,kpt_num + do ispin=1,2 + do k=1,N_int + mask(k,ispin,d_hole2) = & + iand(generators_bitmask(k,ispin,d_hole2), & + psi_det_generators(k,ispin,i_generator) ) + mask(k,ispin,d_part2) = & + iand(generators_bitmask(k,ispin,d_part2), & + not(psi_det_generators(k,ispin,i_generator)) ) + ! mask_kpts(k,ispin,d_hole1,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_hole1,kk), & + ! psi_det_generators(k,ispin,i_generator) ) + ! mask_kpts(k,ispin,d_part1,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_part1,kk), & + ! not(psi_det_generators(k,ispin,i_generator)) ) + ! mask_kpts(k,ispin,d_hole2,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_hole2,kk), & + ! psi_det_generators(k,ispin,i_generator) ) + ! mask_kpts(k,ispin,d_part2,kk) = & + ! iand(generators_bitmask_kpts(k,ispin,d_part2,kk), & + ! not(psi_det_generators(k,ispin,i_generator)) ) + enddo + enddo + enddo + !if(.False.)then + ! call H_apply_cis_sym_kpts_diexc(psi_det_generators(1,1,i_generator), & + ! psi_det_generators(1,1,1), & + ! mask(1,1,d_hole1), mask(1,1,d_part1), & + ! mask(1,1,d_hole2), mask(1,1,d_part2), & + ! fock_diag_tmp, i_generator, iproc ) + !endif + if(.True.)then + do kk=1,kpt_num + call H_apply_cis_sym_kpts_monoexc(psi_det_generators(1,1,i_generator), & + mask_kpts(1,1,s_hole,kk), mask_kpts(1,1,s_part,kk ), & + fock_diag_tmp, i_generator, iproc ) + enddo + endif + call wall_time(wall_1) + + if (wall_1 - wall_0 > 2.d0) then + write(6,*) & + 100.*float(i_generator)/float(N_det_generators), '% in ', wall_1-wall_0, 's' + wall_0 = wall_1 + endif + enddo + + !deallocate( mask, fock_diag_tmp ) + deallocate( mask_kpts, fock_diag_tmp ) + + call copy_H_apply_buffer_to_wf + if (s2_eig) then + call make_s2_eigenfunction + endif + if (is_complex) then + SOFT_TOUCH psi_det psi_coef_complex N_det + else + SOFT_TOUCH psi_det psi_coef N_det + endif + + + ! Sort H_jj to find the N_states lowest states + integer :: i + integer, allocatable :: iorder(:) + double precision, allocatable :: H_jj(:) + double precision, external :: diag_h_mat_elem + allocate(H_jj(N_det),iorder(N_det)) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(psi_det,N_int,H_jj,iorder,N_det) & + !$OMP PRIVATE(i) + !$OMP DO + do i = 1, N_det + H_jj(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + iorder(i) = i + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dsort(H_jj,iorder,N_det) + if (is_complex) then + do k=1,N_states + psi_coef_complex(iorder(k),k) = (1.d0,0.d0) + enddo + else + do k=1,N_states + psi_coef(iorder(k),k) = 1.d0 + enddo + endif + deallocate(H_jj,iorder) + + +end + + From f71086571b25659c0b29e5f17c397c9ce8ed8afe Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 2 Jul 2020 10:48:20 -0500 Subject: [PATCH 232/256] CIS kpts --- src/bitmask/bitmasks.irp.f | 76 +++++++++++++++++++------------------- src/cis/cis.irp.f | 14 +++++-- 2 files changed, 50 insertions(+), 40 deletions(-) diff --git a/src/bitmask/bitmasks.irp.f b/src/bitmask/bitmasks.irp.f index d8580e63..a13644cd 100644 --- a/src/bitmask/bitmasks.irp.f +++ b/src/bitmask/bitmasks.irp.f @@ -343,43 +343,45 @@ END_PROVIDER -!BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6) ] -! implicit none -! BEGIN_DOC -! ! Bitmasks for generator determinants. -! ! (N_int, alpha/beta, hole/particle, generator). -! ! -! ! 3rd index is : -! ! -! ! * 1 : hole for single exc -! ! -! ! * 2 : particle for single exc -! ! -! ! * 3 : hole for 1st exc of double -! ! -! ! * 4 : particle for 1st exc of double -! ! -! ! * 5 : hole for 2nd exc of double -! ! -! ! * 6 : particle for 2nd exc of double -! ! -! END_DOC -! logical :: exists -! PROVIDE ezfio_filename full_ijkl_bitmask -! -! integer :: ispin, i -! do ispin=1,2 -! do i=1,N_int -! generators_bitmask(i,ispin,s_hole ) = reunion_of_inact_act_bitmask(i,ispin) -! generators_bitmask(i,ispin,s_part ) = reunion_of_act_virt_bitmask(i,ispin) -! generators_bitmask(i,ispin,d_hole1) = reunion_of_inact_act_bitmask(i,ispin) -! generators_bitmask(i,ispin,d_part1) = reunion_of_act_virt_bitmask(i,ispin) -! generators_bitmask(i,ispin,d_hole2) = reunion_of_inact_act_bitmask(i,ispin) -! generators_bitmask(i,ispin,d_part2) = reunion_of_act_virt_bitmask(i,ispin) -! enddo -! enddo -! -!END_PROVIDER +BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_kpts, (N_int,2,6,kpt_num) ] + implicit none + BEGIN_DOC + ! Bitmasks for generator determinants. + ! (N_int, alpha/beta, hole/particle, generator). + ! + ! 3rd index is : + ! + ! * 1 : hole for single exc + ! + ! * 2 : particle for single exc + ! + ! * 3 : hole for 1st exc of double + ! + ! * 4 : particle for 1st exc of double + ! + ! * 5 : hole for 2nd exc of double + ! + ! * 6 : particle for 2nd exc of double + ! + END_DOC + logical :: exists + PROVIDE ezfio_filename full_ijkl_bitmask + + integer :: ispin, i, k + do k=1,kpt_num + do ispin=1,2 + do i=1,N_int + generators_bitmask_kpts(i,ispin,s_hole ,k) = reunion_of_inact_act_bitmask_kpts(i,ispin,k) + generators_bitmask_kpts(i,ispin,s_part ,k) = reunion_of_act_virt_bitmask_kpts(i,ispin,k) + generators_bitmask_kpts(i,ispin,d_hole1,k) = reunion_of_inact_act_bitmask_kpts(i,ispin,k) + generators_bitmask_kpts(i,ispin,d_part1,k) = reunion_of_act_virt_bitmask_kpts(i,ispin,k) + generators_bitmask_kpts(i,ispin,d_hole2,k) = reunion_of_inact_act_bitmask_kpts(i,ispin,k) + generators_bitmask_kpts(i,ispin,d_part2,k) = reunion_of_act_virt_bitmask_kpts(i,ispin,k) + enddo + enddo + enddo + +END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask_kpts, (N_int,2,kpt_num)] implicit none diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index 5fd76493..63b83552 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -57,10 +57,18 @@ subroutine run implicit none integer :: i - if(pseudo_sym)then - call H_apply_cis_sym + if (is_complex) then + if(pseudo_sym)then + call H_apply_cis_sym_kpts + else + call H_apply_cis_kpts + endif else - call H_apply_cis + if(pseudo_sym)then + call H_apply_cis_sym + else + call H_apply_cis + endif endif print *, 'N_det = ', N_det print*,'******************************' From 9e0e696e696f8714f1924c5d4b1cf82303b76719 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 2 Jul 2020 12:12:29 -0500 Subject: [PATCH 233/256] cis kpts fix --- src/cis/kpts_cis.irp.f | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/cis/kpts_cis.irp.f b/src/cis/kpts_cis.irp.f index 9bdd0175..cf88fa5f 100644 --- a/src/cis/kpts_cis.irp.f +++ b/src/cis/kpts_cis.irp.f @@ -167,7 +167,7 @@ subroutine H_apply_cis_kpts() integer :: i_generator double precision :: wall_0, wall_1 integer(bit_kind), allocatable :: mask(:,:,:) - integer(bit_kind), allocatable :: mask_kpts(:,:,:) + integer(bit_kind), allocatable :: mask_kpts(:,:,:,:) integer :: kk integer :: ispin, k integer :: iproc @@ -459,7 +459,7 @@ subroutine H_apply_cis_sym_kpts() integer :: i_generator double precision :: wall_0, wall_1 integer(bit_kind), allocatable :: mask(:,:,:) - integer(bit_kind), allocatable :: mask_kpts(:,:,:) + integer(bit_kind), allocatable :: mask_kpts(:,:,:,:) integer :: kk integer :: ispin, k integer :: iproc @@ -487,11 +487,11 @@ subroutine H_apply_cis_sym_kpts() do kk=1,kpt_num do ispin=1,2 do k=1,N_int - mask(k,ispin,d_hole2) = & - iand(generators_bitmask(k,ispin,d_hole2), & + mask_kpts(k,ispin,d_hole2,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_hole2,kk), & psi_det_generators(k,ispin,i_generator) ) - mask(k,ispin,d_part2) = & - iand(generators_bitmask(k,ispin,d_part2), & + mask_kpts(k,ispin,d_part2,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_part2,kk), & not(psi_det_generators(k,ispin,i_generator)) ) ! mask_kpts(k,ispin,d_hole1,kk) = & ! iand(generators_bitmask_kpts(k,ispin,d_hole1,kk), & From 2e2c403b16d27dbe48b63593785020dc11c330ec Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 2 Jul 2020 15:02:22 -0500 Subject: [PATCH 234/256] starting cisd complex --- src/cisd/cisd.irp.f | 10 +- src/cisd/kpts_cisd.irp.f | 666 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 673 insertions(+), 3 deletions(-) create mode 100644 src/cisd/kpts_cisd.irp.f diff --git a/src/cisd/cisd.irp.f b/src/cisd/cisd.irp.f index c3c9f821..cf19e629 100644 --- a/src/cisd/cisd.irp.f +++ b/src/cisd/cisd.irp.f @@ -56,10 +56,14 @@ subroutine run double precision :: cisdq(N_states), delta_e double precision,external :: diag_h_mat_elem - if(pseudo_sym)then - call H_apply_cisd_sym + if (is_complex) then + call H_apply_cisd_kpts else - call H_apply_cisd + if(pseudo_sym)then + call H_apply_cisd_sym + else + call H_apply_cisd + endif endif if (is_complex) then psi_coef_complex = ci_eigenvectors_complex diff --git a/src/cisd/kpts_cisd.irp.f b/src/cisd/kpts_cisd.irp.f new file mode 100644 index 00000000..b862e67c --- /dev/null +++ b/src/cisd/kpts_cisd.irp.f @@ -0,0 +1,666 @@ + +subroutine H_apply_cisd_kpts_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl_2, fock_diag_tmp, i_generator, iproc_in ) + implicit none + integer(bit_kind), intent(in) :: key_in(N_int, 2), hole_1(N_int, 2), hole_2(N_int, 2) + integer(bit_kind), intent(in) :: particl_1(N_int, 2), particl_2(N_int, 2) + integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), tmp + integer,intent(in) :: i_generator,iproc_in + integer :: status(N_int*bit_kind_size, 2) + integer :: highest, p1,p2,sp,ni,i,mi,nt,ns,k + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + integer(bit_kind), intent(in) :: key_prev(N_int, 2, *) + PROVIDE N_int + PROVIDE N_det + + + + highest = 0 + do k=1,N_int*bit_kind_size + status(k,1) = 0 + status(k,2) = 0 + enddo + do sp=1,2 + do ni=1,N_int + do i=1,bit_kind_size + if(iand(1_bit_kind,shiftr(key_in(ni, sp), (i-1))) == 0) then + cycle + end if + mi = (ni-1)*bit_kind_size+i + status(mi, sp) = int(iand(1_bit_kind,shiftr(hole_1(ni,sp),(i-1))),4) + status(mi, sp) = status(mi, sp) + 2*int(iand(1_bit_kind,shiftr(hole_2(ni,sp),(i-1))),4) + if(status(mi, sp) /= 0 .and. mi > highest) then + highest = mi + end if + end do + end do + end do + + do sp=1,2 + do p1=1,highest + if(status(p1, sp) == 0) then + cycle + end if + do p2=1,highest + if(status(p2, sp) == 0) then + cycle + end if + if((status(p1, sp) == 1 .and. status(p2, sp) > 1) .or. & + (status(p1, sp) == 2 .and. status(p2, sp) == 3) .or. & + (status(p1, sp) == 3 .and. status(p2, sp) == 3 .and. p2 > p1)) then + call H_apply_cisd_kpts_diexcP(key_in, sp, p1, particl_1, sp, p2, particl_2, fock_diag_tmp, i_generator, iproc_in ) + end if + end do + end do + end do + do p1=1,highest + if(status(p1, 1) == 0) then + cycle + end if + do p2=1,highest + if(status(p2, 2) == 0) then + cycle + end if + if((status(p1, 1) == 3) .or. & + (status(p1, 1) == 1 .and. status(p2, 2) >= 2) .or. & + (status(p1, 1) == 2 .and. status(p2, 2) /= 2)) then + + call H_apply_cisd_kpts_diexcP(key_in, 1, p1, particl_1, 2, p2, particl_2, fock_diag_tmp, i_generator, iproc_in ) + end if + end do + end do +end subroutine + + +subroutine H_apply_cisd_kpts_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, fock_diag_tmp, i_generator, iproc_in ) + implicit none + integer(bit_kind), intent(in) :: key_in(N_int, 2), particl_1(N_int, 2), particl_2(N_int, 2) + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2) + integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2 + integer(bit_kind) :: miniList(N_int, 2, N_det) + integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni, k + + integer(bit_kind), parameter :: one = 1_bit_kind + + do k=1,N_int + p1_mask(k,1) = 0_bit_kind + p1_mask(k,2) = 0_bit_kind + p2_mask(k,1) = 0_bit_kind + p2_mask(k,2) = 0_bit_kind + enddo + p1_mask(shiftr(fh1-1,bit_kind_shift) + 1, fs1) = shiftl(one,iand(fh1-1,bit_kind_size-1)) + p2_mask(shiftr(fh2-1,bit_kind_shift) + 1, fs2) = shiftl(one,iand(fh2-1,bit_kind_size-1)) + + do k=1,N_int + key_mask(k,1) = key_in(k,1) + key_mask(k,2) = key_in(k,2) + enddo + + key_mask(shiftr(fh1-1,bit_kind_shift) + 1, fs1) -= shiftl(one,iand(fh1-1,bit_kind_size-1)) + key_mask(shiftr(fh2-1,bit_kind_shift) + 1, fs2) -= shiftl(one,iand(fh2-1,bit_kind_size-1)) + + + call H_apply_cisd_kpts_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in ) +end subroutine + + +subroutine H_apply_cisd_kpts_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl_2, fock_diag_tmp, i_generator, iproc_in ) + use omp_lib + use bitmasks + implicit none + BEGIN_DOC + ! Generate all double excitations of key_in using the bit masks of holes and + ! particles. + ! Assume N_int is already provided. + END_DOC + integer,parameter :: size_max = 8192 + + integer ,intent(in) :: i_generator + integer(bit_kind),intent(in) :: key_in(N_int,2), key_mask(N_int, 2) + integer(bit_kind),allocatable :: keys_out(:,:,:) + integer(bit_kind), intent(in) :: hole_1(N_int,2), particl_1(N_int,2) + integer(bit_kind), intent(in) :: hole_2(N_int,2), particl_2(N_int,2) + integer, intent(in) :: iproc_in + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + 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 :: key_union_hole_part(:) + integer :: ii,i,jj,j,k,ispin,l + integer, allocatable :: occ_particle(:,:), occ_hole(:,:) + integer, allocatable :: occ_particle_tmp(:,:), occ_hole_tmp(:,:) + 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) + + double precision :: mo_two_e_integral + logical :: is_a_two_holes_two_particles + integer, allocatable :: ia_ja_pairs(:,:,:) + integer, allocatable :: ib_jb_pairs(:,:) + double precision :: diag_H_mat_elem + integer :: iproc + integer :: jtest_vvvv + + logical :: check_double_excitation + logical :: is_a_1h1p + logical :: is_a_1h2p + logical :: is_a_1h + logical :: is_a_1p + logical :: is_a_2p + logical :: is_a_2h1p + logical :: is_a_2h + logical :: b_cycle + logical :: yes_no + check_double_excitation = .True. + iproc = iproc_in + + + + + +!$ 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_ab(particle,occ_particle,N_elec_in_key_part_1,N_int) + call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int) + allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_num,2), & + ib_jb_pairs(2,0:(elec_alpha_num)*mo_num)) + + do ispin=1,2 + i=0 + do ii=N_elec_in_key_hole_1(ispin),1,-1 ! hole + i_a = occ_hole(ii,ispin) + ASSERT (i_a > 0) + ASSERT (i_a <= mo_num) + + do jj=1,N_elec_in_key_part_1(ispin) !particle + j_a = occ_particle(jj,ispin) + ASSERT (j_a > 0) + ASSERT (j_a <= mo_num) + 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 + logical, allocatable :: array_pairs(:,:) + allocate(array_pairs(mo_num,mo_num)) + accu = 0.d0 + do ispin=1,2 + other_spin = iand(ispin,1)+1 + + do ii=1,ia_ja_pairs(1,0,ispin) + i_a = ia_ja_pairs(1,ii,ispin) + ASSERT (i_a > 0) + ASSERT (i_a <= mo_num) + j_a = ia_ja_pairs(2,ii,ispin) + ASSERT (j_a > 0) + ASSERT (j_a <= mo_num) + hole = key_in + k = shiftr(i_a-1,bit_kind_shift)+1 + j = i_a-shiftl(k-1,bit_kind_shift)-1 + hole(k,ispin) = ibclr(hole(k,ispin),j) + k_a = shiftr(j_a-1,bit_kind_shift)+1 + l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1 + hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + + !!!! Second couple hole particle + do j = 1, N_int + hole_tmp(j,1) = iand(hole_2(j,1),hole(j,1)) + hole_tmp(j,2) = iand(hole_2(j,2),hole(j,2)) + particle_tmp(j,1) = iand(xor(particl_2(j,1),hole(j,1)),particl_2(j,1)) + particle_tmp(j,2) = iand(xor(particl_2(j,2),hole(j,2)),particl_2(j,2)) + enddo + + call bitstring_to_list_ab(particle_tmp,occ_particle_tmp,N_elec_in_key_part_2,N_int) + call bitstring_to_list_ab(hole_tmp,occ_hole_tmp,N_elec_in_key_hole_2,N_int) + + ! hole = a^(+)_j_a(ispin) a_i_a(ispin)|key_in> : single exc :: orb(i_a,ispin) --> orb(j_a,ispin) + hole_save = hole + + ! Build array of the non-zero integrals of second excitation + array_pairs = .True. + + if (ispin == 1) then + integer :: jjj + + i=0 + do kk = 1,N_elec_in_key_hole_2(other_spin) + i_b = occ_hole_tmp(kk,other_spin) + ASSERT (i_b > 0) + ASSERT (i_b <= mo_num) + do jjj=1,N_elec_in_key_part_2(other_spin) ! particle + j_b = occ_particle_tmp(jjj,other_spin) + ASSERT (j_b > 0) + ASSERT (j_b <= mo_num) + if (array_pairs(i_b,j_b)) then + + i+= 1 + ib_jb_pairs(1,i) = i_b + ib_jb_pairs(2,i) = j_b + endif + enddo + enddo + ib_jb_pairs(1,0) = i + + do kk = 1,ib_jb_pairs(1,0) + hole = hole_save + i_b = ib_jb_pairs(1,kk) + j_b = ib_jb_pairs(2,kk) + k = shiftr(i_b-1,bit_kind_shift)+1 + j = i_b-shiftl(k-1,bit_kind_shift)-1 + hole(k,other_spin) = ibclr(hole(k,other_spin),j) + key = hole + k = shiftr(j_b-1,bit_kind_shift)+1 + l = j_b-shiftl(k-1,bit_kind_shift)-1 + key(k,other_spin) = ibset(key(k,other_spin),l) + + + + + + + + + + + key_idx += 1 + do k=1,N_int + keys_out(k,1,key_idx) = key(k,1) + keys_out(k,2,key_idx) = key(k,2) + enddo + ASSERT (key_idx <= size_max) + if (key_idx == size_max) then + call fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + key_idx = 0 + endif + enddo + endif + + ! does all the single excitations of the same spin + i=0 + do kk = 1,N_elec_in_key_hole_2(ispin) + i_b = occ_hole_tmp(kk,ispin) + if (i_b <= i_a.or.i_b == j_a) cycle + ASSERT (i_b > 0) + ASSERT (i_b <= mo_num) + do jjj=1,N_elec_in_key_part_2(ispin) ! particule + j_b = occ_particle_tmp(jjj,ispin) + ASSERT (j_b > 0) + ASSERT (j_b <= mo_num) + if (j_b <= j_a) cycle + if (array_pairs(i_b,j_b)) then + + i+= 1 + ib_jb_pairs(1,i) = i_b + ib_jb_pairs(2,i) = j_b + endif + enddo + enddo + ib_jb_pairs(1,0) = i + + do kk = 1,ib_jb_pairs(1,0) + hole = hole_save + i_b = ib_jb_pairs(1,kk) + j_b = ib_jb_pairs(2,kk) + k = shiftr(i_b-1,bit_kind_shift)+1 + j = i_b-shiftl(k-1,bit_kind_shift)-1 + hole(k,ispin) = ibclr(hole(k,ispin),j) + key = hole + k = shiftr(j_b-1,bit_kind_shift)+1 + l = j_b-shiftl(k-1,bit_kind_shift)-1 + key(k,ispin) = ibset(key(k,ispin),l) + + + + + + + + + + + key_idx += 1 + do k=1,N_int + keys_out(k,1,key_idx) = key(k,1) + keys_out(k,2,key_idx) = key(k,2) + enddo + ASSERT (key_idx <= size_max) + if (key_idx == size_max) then + call fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + key_idx = 0 + endif + enddo ! kk + + enddo ! ii + + enddo ! ispin + call fill_h_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + + deallocate (ia_ja_pairs, ib_jb_pairs, & + keys_out, hole_save, & + key,hole, particle, hole_tmp, & + particle_tmp, occ_particle, & + occ_hole, occ_particle_tmp, & + occ_hole_tmp,array_pairs,key_union_hole_part) + + +end + +subroutine H_apply_cisd_kpts_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generator,iproc_in ) + 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 = 8192 + + 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 + double precision, intent(in) :: fock_diag_tmp(2,mo_num+1) + 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 :: iproc + + integer(bit_kind) :: key_mask(N_int, 2) + + logical :: check_double_excitation + logical :: is_a_2h1p + logical :: is_a_2h + logical :: is_a_1h1p + logical :: is_a_1h2p + logical :: is_a_1h + logical :: is_a_1p + logical :: is_a_2p + logical :: yes_no + + do k=1,N_int + key_mask(k,1) = 0_bit_kind + key_mask(k,2) = 0_bit_kind + enddo + + iproc = iproc_in + + check_double_excitation = .True. + + + + + + +!$ 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_ab(particle,occ_particle,N_elec_in_key_part_1,N_int) + call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int) + allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_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 + do ispin=1,2 + other_spin = iand(ispin,1)+1 + + 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 = shiftr(i_a-1,bit_kind_shift)+1 + j = i_a-shiftl(k-1,bit_kind_shift)-1 + + hole(k,ispin) = ibclr(hole(k,ispin),j) + k_a = shiftr(j_a-1,bit_kind_shift)+1 + l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1 + + hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + + + + + + + + + + + + + + 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 fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + key_idx = 0 + endif + enddo ! ii + + enddo ! ispin + call fill_H_apply_buffer_no_selection(key_idx,keys_out,N_int,iproc) + + 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) + + + +end + +subroutine H_apply_cisd_kpts() + 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 :: i_generator + double precision :: wall_0, wall_1 + integer(bit_kind), allocatable :: mask(:,:,:) + integer :: ispin, k + integer :: iproc + double precision, allocatable :: fock_diag_tmp(:,:) + + integer :: kk,kh1,kh2,kp1,kp2 + integer(bit_kind), allocatable :: mask_kpts(:,:,:,:) + + if (is_complex) then + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex + else + PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators + endif + + call wall_time(wall_0) + + iproc = 0 + !allocate( mask(N_int,2,6), fock_diag_tmp(2,mo_num+1) ) + allocate( mask_kpts(N_int,2,6,kpt_num), fock_diag_tmp(2,mo_num+1) ) + do i_generator=1,N_det_generators + + ! Compute diagonal of the Fock matrix + call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) + + ! Create bit masks for holes and particles + do kk=1,kpt_num + do ispin=1,2 + do k=1,N_int + mask_kpts(k,ispin,s_hole,kk) = & + iand(generators_bitmask_kpts(k,ispin,s_hole,kk), & + psi_det_generators(k,ispin,i_generator) ) + mask_kpts(k,ispin,s_part,kk) = & + iand(generators_bitmask_kpts(k,ispin,s_part,kk), & + not(psi_det_generators(k,ispin,i_generator)) ) + mask_kpts(k,ispin,d_hole1,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_hole1,kk), & + psi_det_generators(k,ispin,i_generator) ) + mask_kpts(k,ispin,d_part1,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_part1,kk), & + not(psi_det_generators(k,ispin,i_generator)) ) + mask_kpts(k,ispin,d_hole2,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_hole2,kk), & + psi_det_generators(k,ispin,i_generator) ) + mask_kpts(k,ispin,d_part2,kk) = & + iand(generators_bitmask_kpts(k,ispin,d_part2,kk), & + not(psi_det_generators(k,ispin,i_generator)) ) + enddo + enddo + enddo + if(.True.)then + do kh1=1,kpt_num + do kh2=1,kh1 + do kp1=1,kpt_num + kp2=kconserv(kh1,kh2,kp1) + print*,'kh1h2p1p1',kh1,kh2,kp1,kp2 + print*,'size_before: ',h_apply_buffer(iproc)%n_det + call H_apply_cisd_kpts_diexc(psi_det_generators(1,1,i_generator), & + psi_det_generators(1,1,1), & + mask_kpts(1,1,d_hole1,kh1), mask_kpts(1,1,d_part1,kp1), & + mask_kpts(1,1,d_hole2,kh2), mask_kpts(1,1,d_part2,kp2), & + fock_diag_tmp, i_generator, iproc ) + print*,'size_after: ',h_apply_buffer(iproc)%n_det + enddo + enddo + enddo + endif + if(.True.)then + do kk=1,kpt_num + call H_apply_cisd_kpts_monoexc(psi_det_generators(1,1,i_generator), & + mask_kpts(1,1,s_hole,kk), mask_kpts(1,1,s_part,kk), & + fock_diag_tmp, i_generator, iproc ) + enddo + endif + call wall_time(wall_1) + + if (wall_1 - wall_0 > 2.d0) then + write(6,*) & + 100.*float(i_generator)/float(N_det_generators), '% in ', wall_1-wall_0, 's' + wall_0 = wall_1 + endif + enddo + + !deallocate( mask, fock_diag_tmp ) + deallocate( mask_kpts, fock_diag_tmp ) + + call copy_H_apply_buffer_to_wf + if (s2_eig) then + call make_s2_eigenfunction + endif + if (is_complex) then + SOFT_TOUCH psi_det psi_coef_complex N_det + else + SOFT_TOUCH psi_det psi_coef N_det + endif + + + ! Sort H_jj to find the N_states lowest states + integer :: i + integer, allocatable :: iorder(:) + double precision, allocatable :: H_jj(:) + double precision, external :: diag_h_mat_elem + allocate(H_jj(N_det),iorder(N_det)) + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(psi_det,N_int,H_jj,iorder,N_det) & + !$OMP PRIVATE(i) + !$OMP DO + do i = 1, N_det + H_jj(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + iorder(i) = i + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dsort(H_jj,iorder,N_det) + if (is_complex) then + do k=1,N_states + psi_coef_complex(iorder(k),k) = (1.d0,0.d0) + enddo + else + do k=1,N_states + psi_coef(iorder(k),k) = 1.d0 + enddo + endif + deallocate(H_jj,iorder) + + +end + From 14c6eaeb7467938123ecd302ad65657205e417db Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 6 Jul 2020 16:10:44 -0500 Subject: [PATCH 235/256] fix kpt range and remove printing in cisd --- src/cisd/kpts_cisd.irp.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cisd/kpts_cisd.irp.f b/src/cisd/kpts_cisd.irp.f index b862e67c..8e37956f 100644 --- a/src/cisd/kpts_cisd.irp.f +++ b/src/cisd/kpts_cisd.irp.f @@ -587,17 +587,17 @@ subroutine H_apply_cisd_kpts() enddo if(.True.)then do kh1=1,kpt_num - do kh2=1,kh1 + do kh2=1,kpt_num do kp1=1,kpt_num kp2=kconserv(kh1,kh2,kp1) - print*,'kh1h2p1p1',kh1,kh2,kp1,kp2 - print*,'size_before: ',h_apply_buffer(iproc)%n_det + !print*,'kh1h2p1p1',kh1,kh2,kp1,kp2 + !print*,'size_before: ',h_apply_buffer(iproc)%n_det call H_apply_cisd_kpts_diexc(psi_det_generators(1,1,i_generator), & psi_det_generators(1,1,1), & mask_kpts(1,1,d_hole1,kh1), mask_kpts(1,1,d_part1,kp1), & mask_kpts(1,1,d_hole2,kh2), mask_kpts(1,1,d_part2,kp2), & fock_diag_tmp, i_generator, iproc ) - print*,'size_after: ',h_apply_buffer(iproc)%n_det + !print*,'size_after: ',h_apply_buffer(iproc)%n_det enddo enddo enddo From 4349e13c93fcd1fcc67e3211d7ec699b5d9d3425 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Jul 2020 14:06:39 -0500 Subject: [PATCH 236/256] minor change in handling of calls to diagonalize_ci --- src/davidson/diagonalize_ci.irp.f | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 63b084fc..d49b0690 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -411,6 +411,15 @@ END_PROVIDER END_PROVIDER +subroutine diagonalize_ci + implicit none + if (is_complex) then + call diagonalize_ci_complex + else + call diagonalize_ci_real + endif +end + subroutine diagonalize_CI_complex implicit none BEGIN_DOC @@ -429,7 +438,7 @@ subroutine diagonalize_CI_complex SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2 end -subroutine diagonalize_CI +subroutine diagonalize_CI_real implicit none BEGIN_DOC ! Replace the coefficients of the |CI| states by the coefficients of the From 46fcc0116f9b52485230539b9d3cfdd447849010 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Jul 2020 14:07:30 -0500 Subject: [PATCH 237/256] complex diagonalize_h --- src/tools/diagonalize_h.irp.f | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/tools/diagonalize_h.irp.f b/src/tools/diagonalize_h.irp.f index c9ae2033..ee9531e9 100644 --- a/src/tools/diagonalize_h.irp.f +++ b/src/tools/diagonalize_h.irp.f @@ -17,7 +17,11 @@ end subroutine routine implicit none - call diagonalize_CI + call diagonalize_ci print*,'N_det = ',N_det - call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + if (is_complex) then + call save_wavefunction_general_complex(N_det,N_states,psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + else + call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + endif end From c8f7f7b037d32079fcd92d9138e9b1e42c7f44b8 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Jul 2020 14:07:53 -0500 Subject: [PATCH 238/256] complex print_hamiltonian --- src/tools/print_hamiltonian.irp.f | 45 ++++++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/src/tools/print_hamiltonian.irp.f b/src/tools/print_hamiltonian.irp.f index 207161dd..183fd502 100644 --- a/src/tools/print_hamiltonian.irp.f +++ b/src/tools/print_hamiltonian.irp.f @@ -9,7 +9,11 @@ program print_hamiltonian ! psi_coef_sorted are the wave function stored in the |EZFIO| directory. read_wf = .True. touch read_wf - call run + if (is_complex) then + call run_complex + else + call run + endif end subroutine run @@ -27,3 +31,42 @@ subroutine run enddo end + +subroutine run_complex + implicit none + integer :: i, j + complex*16 :: hij + double precision :: s2 + + print*,'i,j,Hij' + do j=1,N_det + do i=1,N_det + call i_h_j_complex(psi_det(1,1,i), psi_det(1,1,j), N_int, hij) + if (cdabs(hij) > 1.d-20) then + print *, i, j, dble(hij), dimag(hij) + endif + enddo + enddo + print*,'i,j,S2ij' + do j=1,N_det + do i=1,N_det + call get_s2(psi_det(1,1,i), psi_det(1,1,j), N_int, s2) + if (dabs(s2) > 1.d-20) then + print *, i, j, s2 + endif + enddo + enddo +! use bitmasks + integer :: degree + + print*,'i,j,degij' + do j=1,N_det + do i=1,N_det + call get_excitation_degree(psi_det(1,1,i), psi_det(1,1,j), degree, N_int) + if (degree.le.2) then + print *, i, j, degree + endif + enddo + enddo + +end From 660db8abfd2de74a287fcdd3fb5e4988135fd101 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 10 Jul 2020 14:08:30 -0500 Subject: [PATCH 239/256] real davidson guess for complex --- src/davidson/diagonalization_hs2_dressed.irp.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index a94bec2e..9926dd37 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1070,9 +1070,10 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i r1 = dsqrt(-2.d0*dlog(r1)) r2 = dtwo_pi*r2 !todo: real or complex? rescale for complex? sqrt(2)? - !u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) - u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) + u_in(i,k) = dcmplx(r1*dcos(r2),0.d0) + !u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2)) enddo + u_in(k,k) = (10.d0,0.d0) enddo do k=1,N_st_diag call normalize_complex(u_in(1,k),sze) From 75dbda613aac542465550a4da4678e3c8d4cdae0 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 13 Jul 2020 10:52:09 -0500 Subject: [PATCH 240/256] cleaner k-point orbital indexing --- src/ao_basis/aos_cplx.irp.f | 16 ++++++++ src/cipsi/selection.irp.f | 39 ++++++------------ src/determinants/density_matrix_cplx.irp.f | 12 ++---- src/determinants/single_excitations.irp.f | 9 ++-- src/determinants/slater_rules.irp.f | 23 +++++------ src/mo_basis/mos.irp.f | 16 ++++++++ src/scf_utils/fock_matrix_cplx.irp.f | 48 ++++++++-------------- 7 files changed, 81 insertions(+), 82 deletions(-) diff --git a/src/ao_basis/aos_cplx.irp.f b/src/ao_basis/aos_cplx.irp.f index f571b28d..da1adb94 100644 --- a/src/ao_basis/aos_cplx.irp.f +++ b/src/ao_basis/aos_cplx.irp.f @@ -5,3 +5,19 @@ ! END_DOC ! ao_num_per_kpt = ao_num/kpt_num !END_PROVIDER + +subroutine get_kpt_idx_ao(idx_full,k,i) + implicit none + BEGIN_DOC + ! idx_full is ao index in full range (up to ao_num) + ! k is index of the k-point for this ao + ! i is index of this ao within k-point k + ! this assumes that all kpts have the same number of aos + END_DOC + + integer, intent(in) :: idx_full + integer, intent(out) :: i,k + i = mod(idx_full-1,ao_num_per_kpt)+1 + k = (idx_full-1)/ao_num_per_kpt+1 + ASSERT (k <= kpt_num) +end diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index a3703a62..8bbf41c7 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2918,14 +2918,10 @@ subroutine get_d1_kpts(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, c hfix = h(1,ma) p1 = p(1,ma) p2 = p(2,ma) - kputi = (puti-1)/mo_num_per_kpt + 1 - khfix = (hfix-1)/mo_num_per_kpt + 1 - kp1 = (p1-1)/mo_num_per_kpt + 1 - kp2 = (p2-1)/mo_num_per_kpt + 1 - iputi = mod(puti-1,mo_num_per_kpt) + 1 - ihfix = mod(hfix-1,mo_num_per_kpt) + 1 - ip1 = mod(p1-1, mo_num_per_kpt) + 1 - ip2 = mod(p2-1, mo_num_per_kpt) + 1 + call get_kpt_idx_mo(puti,kputi,iputi) + call get_kpt_idx_mo(hfix,khfix,ihfix) + call get_kpt_idx_mo(p1,kp1,ip1) + call get_kpt_idx_mo(p2,kp2,ip2) if(.not. bannedOrb(puti, mi)) then !================== @@ -3059,8 +3055,7 @@ subroutine get_d1_kpts(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, c !MOVE MI pfix = p(1,mi) - kpfix = (pfix-1)/mo_num_per_kpt + 1 - ipfix = mod(pfix-1,mo_num_per_kpt) + 1 + call get_kpt_idx_mo(pfix,kpfix,ipfix) tmp_row = (0.d0,0.d0) tmp_row2 = (0.d0,0.d0) !tmp_row_kpts = (0.d0,0.d0) @@ -3270,14 +3265,10 @@ subroutine get_d1_kpts(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, c puti = p(i, ma) p1 = p(turn3(1,i), ma) p2 = p(turn3(2,i), ma) - kputi = (puti-1)/mo_num_per_kpt + 1 - khfix = (hfix-1)/mo_num_per_kpt + 1 - kp1 = (p1-1)/mo_num_per_kpt + 1 - kp2 = (p2-1)/mo_num_per_kpt + 1 - iputi = mod(puti-1,mo_num_per_kpt) + 1 - ihfix = mod(hfix-1,mo_num_per_kpt) + 1 - ip1 = mod(p1-1, mo_num_per_kpt) + 1 - ip2 = mod(p2-1, mo_num_per_kpt) + 1 + call get_kpt_idx_mo(puti,kputi,iputi) + call get_kpt_idx_mo(hfix,khfix,ihfix) + call get_kpt_idx_mo(p1,kp1,ip1) + call get_kpt_idx_mo(p2,kp2,ip2) call get_mo_two_e_integrals_complex(hfix,p1,p2,mo_num,hij_cache(1,1),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_complex(hfix,p2,p1,mo_num,hij_cache(1,2),mo_integrals_map,mo_integrals_map_2) call get_mo_two_e_integrals_kpts(hfix,ihfix,khfix,p1,ip1,kp1,p2,ip2,kp2,mo_num_per_kpt,hij_cache2(1,1),mo_integrals_map,mo_integrals_map_2) @@ -3425,14 +3416,10 @@ subroutine get_d1_kpts(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, c pfix = p(1,mi) p1 = p(1,ma) p2 = p(2,ma) - kpfix = (pfix-1)/mo_num_per_kpt + 1 - khfix = (hfix-1)/mo_num_per_kpt + 1 - kp1 = (p1-1)/mo_num_per_kpt + 1 - kp2 = (p2-1)/mo_num_per_kpt + 1 - ipfix = mod(pfix-1,mo_num_per_kpt) + 1 - ihfix = mod(hfix-1,mo_num_per_kpt) + 1 - ip1 = mod(p1-1, mo_num_per_kpt) + 1 - ip2 = mod(p2-1, mo_num_per_kpt) + 1 + call get_kpt_idx_mo(pfix,kpfix,ipfix) + call get_kpt_idx_mo(hfix,khfix,ihfix) + call get_kpt_idx_mo(p1,kp1,ip1) + call get_kpt_idx_mo(p2,kp2,ip2) tmp_row = (0.d0,0.d0) tmp_row2 = (0.d0,0.d0) !tmp_row_kpts = (0.d0,0.d0) diff --git a/src/determinants/density_matrix_cplx.irp.f b/src/determinants/density_matrix_cplx.irp.f index 882b73ee..e5d74347 100644 --- a/src/determinants/density_matrix_cplx.irp.f +++ b/src/determinants/density_matrix_cplx.irp.f @@ -495,10 +495,8 @@ END_PROVIDER call decode_exc_spin(exc,h1,p1,h2,p2) ! h1 occ in k ! p1 occ in l - ih1 = mod(h1-1,mo_num_per_kpt)+1 - ip1 = mod(p1-1,mo_num_per_kpt)+1 - kh1 = (h1-1)/mo_num_per_kpt + 1 - kp1 = (p1-1)/mo_num_per_kpt + 1 + call get_kpt_idx_mo(h1,kh1,ih1) + call get_kpt_idx_mo(p1,kp1,ip1) if (kh1.ne.kp1) then print *,'problem in: ',irp_here,'a' print *,' h1 = ',h1 @@ -577,10 +575,8 @@ END_PROVIDER exc = 0 call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int) call decode_exc_spin(exc,h1,p1,h2,p2) - ih1 = mod(h1-1,mo_num_per_kpt)+1 - ip1 = mod(p1-1,mo_num_per_kpt)+1 - kh1 = (h1-1)/mo_num_per_kpt + 1 - kp1 = (p1-1)/mo_num_per_kpt + 1 + call get_kpt_idx_mo(h1,kh1,ih1) + call get_kpt_idx_mo(p1,kp1,ip1) if (kh1.ne.kp1) then print *,'problem in: ',irp_here,'b' print *,' h1 = ',h1 diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index 044c7d06..192681b3 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -449,11 +449,12 @@ subroutine get_single_excitation_from_fock_kpts(det_1,det_2,ih,ip,spin,phase,hij integer :: occ_partcl(N_int*bit_kind_size,2) integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2) integer :: i0,i,h,p - integer :: ki,khp + integer :: ki,khp,kh complex*16 :: buffer_c(mo_num_per_kpt),buffer_x(mo_num_per_kpt) - khp = (ip-1)/mo_num_per_kpt+1 - p = mod(ip-1,mo_num_per_kpt)+1 - h = mod(ih-1,mo_num_per_kpt)+1 + + call get_kpt_idx_mo(ip,khp,p) + call get_kpt_idx_mo(ih,kh,h) + ASSERT (kh==khp) !todo: omp kpts do ki=1,kpt_num do i=1, mo_num_per_kpt diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index e9b9aca9..fb77fb45 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -2443,18 +2443,19 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) if (exc(0,1,1) == 1) then call double_allowed_mo_kpts(exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2),is_allowed) if (.not.is_allowed) then + ! excitation doesn't conserve momentum hij = (0.d0,0.d0) return endif ! Single alpha, single beta if(exc(1,1,1) == exc(1,2,2) )then - ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1 - ih2 = mod(exc(1,1,2)-1,mo_num_per_kpt)+1 - kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1 - kh2 = (exc(1,1,2)-1)/mo_num_per_kpt+1 - ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1 - kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1 + !h1(a) = p2(b) + call get_kpt_idx_mo(exc(1,1,1),kh1,ih1) + call get_kpt_idx_mo(exc(1,1,2),kh2,ih2) + call get_kpt_idx_mo(exc(1,2,1),kp1,ip1) + if(kp1.ne.kh2) then + !if h1==p2 then kp1==kh2 print*,'problem with hij kpts: ',irp_here print*,is_allowed print*,exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2) @@ -2464,12 +2465,10 @@ subroutine i_H_j_complex(key_i,key_j,Nint,hij) hij = phase * big_array_exchange_integrals_kpts(ih1,kh1,ih2,ip1,kp1) !hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1)) else if (exc(1,2,1) ==exc(1,1,2))then - ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1 - kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1 - ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1 - kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1 - ip2 = mod(exc(1,2,2)-1,mo_num_per_kpt)+1 - kp2 = (exc(1,2,2)-1)/mo_num_per_kpt+1 + !p1(a)==h2(b) + call get_kpt_idx_mo(exc(1,1,1),kh1,ih1) + call get_kpt_idx_mo(exc(1,2,1),kp1,ip1) + call get_kpt_idx_mo(exc(1,2,2),kp2,ip2) if(kp2.ne.kh1) then print*,'problem with hij kpts: ',irp_here print*,is_allowed diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 440d1703..f5310696 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -80,6 +80,22 @@ BEGIN_PROVIDER [ integer, mo_num_per_kpt ] END_PROVIDER +subroutine get_kpt_idx_mo(idx_full,k,i) + implicit none + BEGIN_DOC + ! idx_full is mo index in full range (up to mo_num) + ! k is index of the k-point for this mo + ! i is index of this mo within k-point k + ! this assumes that all kpts have the same number of mos + END_DOC + + integer, intent(in) :: idx_full + integer, intent(out) :: i,k + i = mod(idx_full-1,mo_num_per_kpt)+1 + k = (idx_full-1)/mo_num_per_kpt+1 + ASSERT (k <= kpt_num) +end + BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_num) ] implicit none diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index cc0dc4af..b59465f9 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -593,14 +593,10 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/ao_num_per_kpt +1 - kpt_j = (j-1)/ao_num_per_kpt +1 - kpt_k = (k-1)/ao_num_per_kpt +1 - kpt_l = (l-1)/ao_num_per_kpt +1 - idx_i = mod(i-1,ao_num_per_kpt)+1 - idx_j = mod(j-1,ao_num_per_kpt)+1 - idx_k = mod(k-1,ao_num_per_kpt)+1 - idx_l = mod(l-1,ao_num_per_kpt)+1 + call get_kpt_idx_ao(i,kpt_i,idx_i) + call get_kpt_idx_ao(j,kpt_j,idx_j) + call get_kpt_idx_ao(k,kpt_k,idx_k) + call get_kpt_idx_ao(l,kpt_l,idx_l) integral = i_sign(k2)*values(k1) !for klij and lkji, take complex conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -636,14 +632,10 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/ao_num_per_kpt +1 - kpt_j = (j-1)/ao_num_per_kpt +1 - kpt_k = (k-1)/ao_num_per_kpt +1 - kpt_l = (l-1)/ao_num_per_kpt +1 - idx_i = mod(i-1,ao_num_per_kpt)+1 - idx_j = mod(j-1,ao_num_per_kpt)+1 - idx_k = mod(k-1,ao_num_per_kpt)+1 - idx_l = mod(l-1,ao_num_per_kpt)+1 + call get_kpt_idx_ao(i,kpt_i,idx_i) + call get_kpt_idx_ao(j,kpt_j,idx_j) + call get_kpt_idx_ao(k,kpt_k,idx_k) + call get_kpt_idx_ao(l,kpt_l,idx_l) integral = values(k1) if (kpt_l.eq.kpt_j) then @@ -714,14 +706,10 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/ao_num_per_kpt +1 - kpt_j = (j-1)/ao_num_per_kpt +1 - kpt_k = (k-1)/ao_num_per_kpt +1 - kpt_l = (l-1)/ao_num_per_kpt +1 - idx_i = mod(i-1,ao_num_per_kpt)+1 - idx_j = mod(j-1,ao_num_per_kpt)+1 - idx_k = mod(k-1,ao_num_per_kpt)+1 - idx_l = mod(l-1,ao_num_per_kpt)+1 + call get_kpt_idx_ao(i,kpt_i,idx_i) + call get_kpt_idx_ao(j,kpt_j,idx_j) + call get_kpt_idx_ao(k,kpt_k,idx_k) + call get_kpt_idx_ao(l,kpt_l,idx_l) integral = i_sign(k2)*values(k1) ! for klij and lkji, take conjugate !G_a(i,k) += D_{ab}(l,j)*() @@ -757,14 +745,10 @@ END_PROVIDER j = jj(k2) k = kk(k2) l = ll(k2) - kpt_i = (i-1)/ao_num_per_kpt +1 - kpt_j = (j-1)/ao_num_per_kpt +1 - kpt_k = (k-1)/ao_num_per_kpt +1 - kpt_l = (l-1)/ao_num_per_kpt +1 - idx_i = mod(i-1,ao_num_per_kpt)+1 - idx_j = mod(j-1,ao_num_per_kpt)+1 - idx_k = mod(k-1,ao_num_per_kpt)+1 - idx_l = mod(l-1,ao_num_per_kpt)+1 + call get_kpt_idx_ao(i,kpt_i,idx_i) + call get_kpt_idx_ao(j,kpt_j,idx_j) + call get_kpt_idx_ao(k,kpt_k,idx_k) + call get_kpt_idx_ao(l,kpt_l,idx_l) integral = values(k1) if (kpt_l.eq.kpt_j) then From 4d9299ad7c63cd04a21cddbfa2f9d45159832aa6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 13 Jul 2020 18:24:37 -0500 Subject: [PATCH 241/256] testing for real kpts; not clean --- src/ao_one_e_ints/ao_overlap.irp.f | 16 ++ src/hartree_fock/scf_k_real.irp.f | 92 ++++++++++ src/mo_basis/utils_cplx.irp.f | 79 +++++++++ src/mo_guess/mo_ortho_lowdin_cplx.irp.f | 32 ++++ src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f | 17 ++ src/mo_one_e_ints/mo_overlap.irp.f | 15 ++ src/mo_one_e_ints/orthonormalize.irp.f | 20 +++ src/scf_utils/diagonalize_fock_cplx.irp.f | 67 ++++++++ src/scf_utils/diis_cplx.irp.f | 2 +- src/scf_utils/fock_matrix_cplx.irp.f | 18 ++ src/scf_utils/huckel_cplx.irp.f | 49 ++++++ src/scf_utils/roothaan_hall_scf_cplx.irp.f | 189 +++++++++++++++++++++ src/utils/linear_algebra.irp.f | 74 ++++++++ 13 files changed, 669 insertions(+), 1 deletion(-) create mode 100644 src/hartree_fock/scf_k_real.irp.f diff --git a/src/ao_one_e_ints/ao_overlap.irp.f b/src/ao_one_e_ints/ao_overlap.irp.f index b6191b86..7b51fb54 100644 --- a/src/ao_one_e_ints/ao_overlap.irp.f +++ b/src/ao_one_e_ints/ao_overlap.irp.f @@ -122,6 +122,22 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_kpts, (ao_num_per_kpt, ao_num_per_kpt, k END_PROVIDER +BEGIN_PROVIDER [ double precision, ao_overlap_kpts_real, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Overlap for complex AOs + END_DOC + integer :: i,j,k + do k=1,kpt_num + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + ao_overlap_kpts_real(i,j,k) = dble(ao_overlap_kpts(i,j,k)) + enddo + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ] diff --git a/src/hartree_fock/scf_k_real.irp.f b/src/hartree_fock/scf_k_real.irp.f new file mode 100644 index 00000000..c666b989 --- /dev/null +++ b/src/hartree_fock/scf_k_real.irp.f @@ -0,0 +1,92 @@ +program scf_k_real + BEGIN_DOC +! +! The :ref:`scf` program performs *Restricted* Hartree-Fock +! calculations (the spatial part of the |MOs| is common for alpha and beta +! spinorbitals). +! +! It performs the following actions: +! +! #. Compute/Read all the one- and two-electron integrals, and store them +! in memory +! #. Check in the |EZFIO| database if there is a set of |MOs|. +! If there is, it will read them as initial guess. Otherwise, it will +! create a guess. +! #. Perform the |SCF| iterations +! +! For the keywords related to the |SCF| procedure, see the ``scf_utils`` +! directory where you will find all options. +! +! At each iteration, the |MOs| are saved in the |EZFIO| database. Hence, +! if the calculation crashes for any unexpected reason, the calculation +! can be restarted by running again the |SCF| with the same |EZFIO| +! database. +! +! To start again a fresh |SCF| calculation, the |MOs| can be reset by +! running the :ref:`qp_reset` command. +! +! The `DIIS`_ algorithm is implemented, as well as the `level-shifting`_ +! method. If the |SCF| does not converge, try again with a higher value of +! :option:`level_shift`. +! +! .. _DIIS: https://en.wikipedia.org/w/index.php?title=DIIS +! .. _level-shifting: https://doi.org/10.1002/qua.560070407 +! + END_DOC + call create_guess_k_real + call orthonormalize_mos_k_real + call run_k_real +end + +subroutine create_guess_k_real + implicit none + BEGIN_DOC +! Create a MO guess if no MOs are present in the EZFIO directory + END_DOC + logical :: exists + PROVIDE ezfio_filename + call ezfio_has_mo_basis_mo_coef_kpts(exists) + if (.not.exists) then + if (mo_guess_type == "HCore") then + !mo_coef_complex = ao_ortho_lowdin_coef_complex + mo_coef_kpts = ao_ortho_lowdin_coef_kpts_real + TOUCH mo_coef_kpts + mo_label = 'Guess' + !call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_kpts, & + call mo_as_eigvectors_of_mo_matrix_kpts_real(mo_one_e_integrals_kpts_real, & + size(mo_one_e_integrals_kpts_real,1), & + size(mo_one_e_integrals_kpts_real,2), & + size(mo_one_e_integrals_kpts_real,3), & + mo_label,1,.false.) + SOFT_TOUCH mo_coef_kpts mo_label + else if (mo_guess_type == "Huckel") then + call huckel_guess_kpts_real + else + print *, 'Unrecognized MO guess type : '//mo_guess_type + stop 1 + endif + endif +end + +subroutine run_k_real + + BEGIN_DOC +! Run SCF calculation + END_DOC + + use bitmasks + implicit none + + integer :: i_it, i, j, k + + mo_label = "Orthonormalized" + call roothaan_hall_scf_kpts_real + call ezfio_set_hartree_fock_energy(SCF_energy) + print*,'hf 1e,2e,total energy' + print*,hf_one_electron_energy + print*,hf_two_electron_energy + print*,hf_energy + +end + + diff --git a/src/mo_basis/utils_cplx.irp.f b/src/mo_basis/utils_cplx.irp.f index 936d09cc..4d28911d 100644 --- a/src/mo_basis/utils_cplx.irp.f +++ b/src/mo_basis/utils_cplx.irp.f @@ -327,6 +327,85 @@ subroutine mo_as_eigvectors_of_mo_matrix_kpts(matrix,n,m,nk,label,sign,output) endif end +subroutine mo_as_eigvectors_of_mo_matrix_kpts_real(matrix,n,m,nk,label,sign,output) + !TODO: test this + implicit none + integer,intent(in) :: n,m,nk, sign + character*(64), intent(in) :: label + double precision, intent(in) :: matrix(n,m,nk) + logical, intent(in) :: output + + integer :: i,j,k + double precision, allocatable :: eigvalues(:) + !complex*16, allocatable :: mo_coef_new(:,:) + double precision, allocatable :: mo_coef_new(:,:),mo_coef_tmp(:,:),R(:,:), A(:,:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R + + call write_time(6) + if (m /= mo_num_per_kpt) then + print *, irp_here, ': Error : m/= mo_num_per_kpt' + stop 1 + endif + if (nk /= kpt_num) then + print *, irp_here, ': Error : nk/= kpt_num' + stop 1 + endif + allocate(A(n,m),R(n,m),mo_coef_tmp(ao_num_per_kpt,m),mo_coef_new(ao_num_per_kpt,m),eigvalues(m)) + do k=1,nk + if (sign == -1) then + do j=1,m + do i=1,n + A(i,j) = -matrix(i,j,k) + enddo + enddo + else + do j=1,m + do i=1,n + A(i,j) = matrix(i,j,k) + enddo + enddo + endif + mo_coef_new = dble(mo_coef_kpts(:,:,k)) + + call lapack_diag(eigvalues,R,A,n,m) + if (sign == -1) then + do i=1,m + eigvalues(i) = -eigvalues(i) + enddo + endif + if (output) then + do i=1,m + write (6,'(2(I8),1X,F16.10)') k,i,eigvalues(i) + enddo + write (6,'(A)') '======== ================' + write (6,'(A)') '' + !write (6,'(A)') 'Fock Matrix' + !write (6,'(A)') '-----------' + !do i=1,n + ! write(*,'(200(E24.15))') A(i,:) + !enddo + endif + + call dgemm('N','N',ao_num_per_kpt,m,m,1.d0, & + mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0, & + mo_coef_tmp,size(mo_coef_tmp,1)) + call zlacp2('N',ao_num_per_kpt,m,mo_coef_tmp,size(mo_coef_tmp,1), & + mo_coef_kpts(:,:,k),size(mo_coef_kpts,1)) + enddo + deallocate(A,mo_coef_new,mo_coef_tmp,R,eigvalues) + call write_time(6) + + mo_label = label + if (output) then + write (6,'(A)') 'MOs are now **'//trim(label)//'**' + write (6,'(A)') '' + write (6,'(A)') 'Eigenvalues' + write (6,'(A)') '-----------' + write (6,'(A)') '' + write (6,'(A)') '======== ================' + endif +end + subroutine mo_as_svd_vectors_of_mo_matrix_kpts(matrix,lda,m,n,label) !TODO: implement print *, irp_here, ' not implemented for kpts' diff --git a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f index b3b64ce4..ced9a63a 100644 --- a/src/mo_guess/mo_ortho_lowdin_cplx.irp.f +++ b/src/mo_guess/mo_ortho_lowdin_cplx.irp.f @@ -107,3 +107,35 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_kpts, (ao_num_per_kpt,ao_num enddo enddo END_PROVIDER + +!============================================! +! ! +! kpts_real ! +! ! +!============================================! + +BEGIN_PROVIDER [ double precision, ao_ortho_lowdin_coef_kpts_real, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital + END_DOC + integer :: i,j,k,l + double precision, allocatable :: tmp_matrix(:,:) + allocate (tmp_matrix(ao_num,ao_num)) + do k=1,kpt_num + tmp_matrix(:,:) = 0.d0 + do j=1, ao_num + tmp_matrix(j,j) = 1.d0 + enddo + call ortho_lowdin(ao_overlap_kpts_real(:,:,k),ao_num_per_kpt,ao_num_per_kpt,tmp_matrix,ao_num_per_kpt,ao_num_per_kpt,lin_dep_cutoff) + do i=1, ao_num_per_kpt + do j=1, ao_num_per_kpt + ao_ortho_lowdin_coef_kpts_real(j,i,k) = tmp_matrix(i,j) + enddo + enddo + enddo + deallocate(tmp_matrix) +END_PROVIDER + diff --git a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f index 7a9568c9..59088f6e 100644 --- a/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f @@ -59,3 +59,20 @@ BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_kpts,(mo_num_per_kpt,mo_num_per_ print*,'Provided the one-electron integrals' END_PROVIDER + +BEGIN_PROVIDER [ double precision, mo_one_e_integrals_kpts_real,(mo_num_per_kpt,mo_num_per_kpt,kpt_num)] + implicit none + BEGIN_DOC + ! array of the one-electron Hamiltonian on the |MO| basis : + ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed) + END_DOC + + integer :: i,j,k + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_one_e_integrals_kpts_real(i,j,k) = dble(mo_one_e_integrals_kpts(i,j,k)) + enddo + enddo + enddo +END_PROVIDER diff --git a/src/mo_one_e_ints/mo_overlap.irp.f b/src/mo_one_e_ints/mo_overlap.irp.f index f004e1f4..9d31bddb 100644 --- a/src/mo_one_e_ints/mo_overlap.irp.f +++ b/src/mo_one_e_ints/mo_overlap.irp.f @@ -128,3 +128,18 @@ BEGIN_PROVIDER [ complex*16, mo_overlap_kpts,(mo_num_per_kpt,mo_num_per_kpt,kpt_ endif END_PROVIDER +BEGIN_PROVIDER [ double precision, mo_overlap_kpts_real, (mo_num_per_kpt, mo_num_per_kpt, kpt_num) ] + implicit none + BEGIN_DOC + ! Overlap for complex MOs + END_DOC + integer :: i,j,k + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + mo_overlap_kpts_real(i,j,k) = dble(mo_overlap_kpts(i,j,k)) + enddo + enddo + enddo +END_PROVIDER + diff --git a/src/mo_one_e_ints/orthonormalize.irp.f b/src/mo_one_e_ints/orthonormalize.irp.f index 4818a7aa..dd6ee8ee 100644 --- a/src/mo_one_e_ints/orthonormalize.irp.f +++ b/src/mo_one_e_ints/orthonormalize.irp.f @@ -19,3 +19,23 @@ subroutine orthonormalize_mos end +subroutine orthonormalize_mos_k_real + implicit none + integer :: m,p,s,k + double precision, allocatable :: mo_coef_tmp(:,:) + + allocate(mo_coef_tmp(ao_num_per_kpt,mo_num_per_kpt)) + do k=1,kpt_num + m = size(mo_coef_kpts,1) + p = size(mo_overlap_kpts,1) + mo_coef_tmp = dble(mo_coef_kpts(:,:,k)) + call ortho_lowdin(mo_overlap_kpts_real(1,1,k),p,mo_num_per_kpt,mo_coef_tmp,m,ao_num_per_kpt,lin_dep_cutoff) + call zlacp2('X',ao_num_per_kpt,mo_num_per_kpt,mo_coef_tmp,size(mo_coef_tmp,1), & + mo_coef_kpts(1,1,k),size(mo_coef_kpts,1)) + enddo + deallocate(mo_coef_tmp) + mo_label = 'Orthonormalized' + SOFT_TOUCH mo_coef_kpts mo_label +end + + diff --git a/src/scf_utils/diagonalize_fock_cplx.irp.f b/src/scf_utils/diagonalize_fock_cplx.irp.f index 82353ed0..d8bb1b6e 100644 --- a/src/scf_utils/diagonalize_fock_cplx.irp.f +++ b/src/scf_utils/diagonalize_fock_cplx.irp.f @@ -112,4 +112,71 @@ BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_kpts, (ao_num_per_kpt,m deallocate(F, diag) +END_PROVIDER +BEGIN_PROVIDER [ complex*16, eigenvectors_Fock_matrix_mo_kpts_real, (ao_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + BEGIN_DOC + ! Eigenvectors of the Fock matrix in the |MO| basis obtained with level shift. + END_DOC + + integer :: i,j,k + integer :: n + !complex*16, allocatable :: F(:,:) + double precision, allocatable :: F(:,:) + double precision, allocatable :: diag(:), mo_coef_tmp(:,:), eigvecs_tmp(:,:) + + allocate( F(mo_num_per_kpt,mo_num_per_kpt) ) + allocate (diag(mo_num_per_kpt) ) + allocate (mo_coef_tmp(ao_num_per_kpt,mo_num_per_kpt) ) + allocate (eigvecs_tmp(ao_num_per_kpt,mo_num_per_kpt) ) + + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + !F(i,j) = fock_matrix_mo_complex(i,j) + F(i,j) = dble(fock_matrix_mo_kpts(i,j,k)) + enddo + enddo + + if(frozen_orb_scf)then + integer :: iorb,jorb + !todo: core/act per kpt + do i = 1, n_core_orb + iorb = list_core(i) + do j = 1, n_act_orb + jorb = list_act(j) + F(iorb,jorb) = 0.d0 + F(jorb,iorb) = 0.d0 + enddo + enddo + endif + + ! Insert level shift here + !todo: elec per kpt + do i = elec_beta_num_kpts(k)+1, elec_alpha_num_kpts(k) + F(i,i) += 0.5d0*level_shift + enddo + + do i = elec_alpha_num_kpts(k)+1, mo_num_per_kpt + F(i,i) += level_shift + enddo + + n = mo_num_per_kpt + call lapack_diagd_diag_in_place(diag,F,n,n) + + mo_coef_tmp = dble(mo_coef_kpts(:,:,k)) + call dgemm('N','N',ao_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt, 1.d0, & + mo_coef_tmp, size(mo_coef_tmp,1), F, size(F,1), & + 0.d0, eigvecs_tmp, size(eigvecs_tmp,1)) + + call zlacp2('X',ao_num_per_kpt,mo_num_per_kpt,eigvecs_tmp,size(eigvecs_tmp,1), & + eigenvectors_fock_matrix_mo_kpts_real(:,:,k), size(eigenvectors_Fock_matrix_mo_kpts_real,1)) + +! call zgemm('N','N',ao_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt, (1.d0,0.d0), & +! mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), F, size(F,1), & +! (0.d0,0.d0), eigenvectors_Fock_matrix_mo_kpts(:,:,k), size(eigenvectors_Fock_matrix_mo_kpts,1)) + enddo + deallocate(F, diag,mo_coef_tmp,eigvecs_tmp) + + END_PROVIDER diff --git a/src/scf_utils/diis_cplx.irp.f b/src/scf_utils/diis_cplx.irp.f index 4a0cdabf..601b9b97 100644 --- a/src/scf_utils/diis_cplx.irp.f +++ b/src/scf_utils/diis_cplx.irp.f @@ -164,7 +164,7 @@ BEGIN_PROVIDER [complex*16, FPS_SPF_Matrix_AO_kpts, (AO_num_per_kpt, AO_num_per_ call zgemm('N','N',AO_num_per_kpt,AO_num_per_kpt,AO_num_per_kpt, & (1.d0,0.d0), & Fock_Matrix_AO_kpts(1,1,k),Size(Fock_Matrix_AO_kpts,1), & - SCF_Density_Matrix_AO_kpts(1,1,k),Size(SCF_Density_Matrix_AO_kpts,1), & + scf_density_matrix_ao_kpts(1,1,k),Size(SCF_Density_Matrix_AO_kpts,1), & (0.d0,0.d0), & scratch,Size(scratch,1)) diff --git a/src/scf_utils/fock_matrix_cplx.irp.f b/src/scf_utils/fock_matrix_cplx.irp.f index b59465f9..e2ada6fc 100644 --- a/src/scf_utils/fock_matrix_cplx.irp.f +++ b/src/scf_utils/fock_matrix_cplx.irp.f @@ -360,6 +360,24 @@ END_PROVIDER END_PROVIDER +!============================================! +! ! +! kpts_real ! +! ! +!============================================! + +BEGIN_PROVIDER [ double precision, Fock_matrix_mo_kpts_real, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ] + implicit none + integer :: i,j,k + do k=1,kpt_num + do j=1,mo_num_per_kpt + do i=1,mo_num_per_kpt + fock_matrix_mo_kpts_real(i,j,k) = dble(fock_matrix_mo_kpts(i,j,k)) + enddo + enddo + enddo +END_PROVIDER + !============================================! ! ! ! kpts ! diff --git a/src/scf_utils/huckel_cplx.irp.f b/src/scf_utils/huckel_cplx.irp.f index f5dee3a4..346999df 100644 --- a/src/scf_utils/huckel_cplx.irp.f +++ b/src/scf_utils/huckel_cplx.irp.f @@ -89,3 +89,52 @@ subroutine huckel_guess_kpts deallocate(A) end +subroutine huckel_guess_kpts_real + implicit none + BEGIN_DOC +! Build the MOs using the extended Huckel model + END_DOC + integer :: i,j,k + double precision :: accu + double precision :: c + character*(64) :: label + !complex*16, allocatable :: A(:,:) + double precision, allocatable :: A(:,:) + label = "Guess" + c = 0.5d0 * 1.75d0 + + allocate (A(ao_num_per_kpt, ao_num_per_kpt)) + do k=1,kpt_num + A = 0.d0 + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + A(i,j) = c * ao_overlap_kpts_real(i,j,k) * (ao_one_e_integrals_diag_kpts(i,k) + ao_one_e_integrals_diag_kpts(j,k)) + enddo + A(j,j) = ao_one_e_integrals_diag_kpts(j,k) + dble(ao_two_e_integral_alpha_kpts(j,j,k)) + if (dabs(dimag(ao_two_e_integral_alpha_kpts(j,j,k))) .gt. 1.0d-10) then + stop 'diagonal elements of ao_two_e_integral_alpha should be real' + endif + enddo + +! Fock_matrix_ao_alpha(1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) +! Fock_matrix_ao_beta (1:ao_num,1:ao_num) = A(1:ao_num,1:ao_num) + call zlacp2('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + Fock_matrix_ao_alpha_kpts(:,:,k), size(Fock_matrix_ao_alpha_kpts,1)) + call zlacp2('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + Fock_matrix_ao_beta_kpts(:,:,k), size(Fock_matrix_ao_beta_kpts, 1)) + !call zlacpy('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + ! Fock_matrix_ao_alpha_kpts(:,:,k), size(Fock_matrix_ao_alpha_kpts,1)) + !call zlacpy('X', ao_num_per_kpt, ao_num_per_kpt, A, size(A,1), & + ! Fock_matrix_ao_beta_kpts(:,:,k), size(Fock_matrix_ao_beta_kpts, 1)) + enddo + +! TOUCH mo_coef + + !TOUCH fock_matrix_ao_alpha_complex fock_matrix_ao_beta_kpts + TOUCH fock_matrix_ao_alpha_kpts fock_matrix_ao_beta_kpts + mo_coef_kpts = eigenvectors_fock_matrix_mo_kpts_real + SOFT_TOUCH mo_coef_kpts + call save_mos + deallocate(A) + +end diff --git a/src/scf_utils/roothaan_hall_scf_cplx.irp.f b/src/scf_utils/roothaan_hall_scf_cplx.irp.f index 87c33cb5..64c3b16f 100644 --- a/src/scf_utils/roothaan_hall_scf_cplx.irp.f +++ b/src/scf_utils/roothaan_hall_scf_cplx.irp.f @@ -653,3 +653,192 @@ END_DOC endif end + +!============================================! +! ! +! kpts_real ! +! ! +!============================================! + +subroutine Roothaan_Hall_SCF_kpts_real + +BEGIN_DOC +! Roothaan-Hall algorithm for SCF Hartree-Fock calculation +END_DOC + + implicit none + + double precision :: energy_SCF,energy_SCF_previous,Delta_energy_SCF + double precision :: max_error_DIIS,max_error_DIIS_alpha,max_error_DIIS_beta + complex*16, allocatable :: Fock_matrix_DIIS(:,:,:,:),error_matrix_DIIS(:,:,:,:) + + integer :: iteration_SCF,dim_DIIS,index_dim_DIIS + + integer :: i,j,k,kk + logical, external :: qp_stop + complex*16, allocatable :: mo_coef_save(:,:,:) + + PROVIDE ao_md5 mo_occ_kpts level_shift + + allocate(mo_coef_save(ao_num_per_kpt,mo_num_per_kpt,kpt_num), & + Fock_matrix_DIIS (ao_num_per_kpt,ao_num_per_kpt,max_dim_DIIS,kpt_num), & + error_matrix_DIIS(ao_num_per_kpt,ao_num_per_kpt,max_dim_DIIS,kpt_num) & + ) + !todo: add kpt_num dim to diis mats? (3 or 4) + call write_time(6) + + print*,'Energy of the guess = ',scf_energy + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + ' N ', 'Energy ', 'Energy diff ', 'DIIS error ', 'Level shift ' + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + +! Initialize energies and density matrices + energy_SCF_previous = SCF_energy + Delta_energy_SCF = 1.d0 + iteration_SCF = 0 + dim_DIIS = 0 + max_error_DIIS = 1.d0 + + +! +! Start of main SCF loop +! + !PROVIDE fps_spf_matrix_ao_complex fock_matrix_ao_complex + PROVIDE fps_spf_matrix_ao_kpts fock_matrix_ao_kpts + + do while ( & + ( (max_error_DIIS > threshold_DIIS_nonzero) .or. & + (dabs(Delta_energy_SCF) > thresh_SCF) & + ) .and. (iteration_SCF < n_it_SCF_max) ) + +! Increment cycle number + + iteration_SCF += 1 + if(frozen_orb_scf)then + call initialize_mo_coef_begin_iteration + endif + +! Current size of the DIIS space + + dim_DIIS = min(dim_DIIS+1,max_dim_DIIS) + + if (scf_algorithm == 'DIIS') then + + do kk=1,kpt_num + ! Store Fock and error matrices at each iteration + do j=1,ao_num_per_kpt + do i=1,ao_num_per_kpt + index_dim_DIIS = mod(dim_DIIS-1,max_dim_DIIS)+1 + Fock_matrix_DIIS (i,j,index_dim_DIIS,kk) = fock_matrix_ao_kpts(i,j,kk) + error_matrix_DIIS(i,j,index_dim_DIIS,kk) = fps_spf_matrix_ao_kpts(i,j,kk) + enddo + enddo + + ! Compute the extrapolated Fock matrix + + call extrapolate_fock_matrix_kpts( & + error_matrix_DIIS(1,1,1,kk),Fock_matrix_DIIS(1,1,1,kk), & + Fock_matrix_AO_kpts(1,1,kk),size(Fock_matrix_AO_kpts,1), & + iteration_SCF,dim_DIIS & + ) + enddo + Fock_matrix_AO_alpha_kpts = Fock_matrix_AO_kpts*0.5d0 + Fock_matrix_AO_beta_kpts = Fock_matrix_AO_kpts*0.5d0 + TOUCH Fock_matrix_AO_alpha_kpts Fock_matrix_AO_beta_kpts + + endif + + mo_coef_kpts = eigenvectors_fock_matrix_mo_kpts + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + + TOUCH mo_coef_kpts + +! Calculate error vectors + + max_error_DIIS = maxval(cdabs(FPS_SPF_Matrix_MO_kpts)) + +! SCF energy +! call print_debug_scf_complex + energy_SCF = scf_energy + Delta_Energy_SCF = energy_SCF - energy_SCF_previous + if ( (SCF_algorithm == 'DIIS').and.(Delta_Energy_SCF > 0.d0) ) then + do kk=1,kpt_num + Fock_matrix_AO_kpts(1:ao_num_per_kpt,1:ao_num_per_kpt,kk) = & + Fock_matrix_DIIS (1:ao_num_per_kpt,1:ao_num_per_kpt,index_dim_DIIS,kk) + enddo + Fock_matrix_AO_alpha_kpts = Fock_matrix_AO_kpts*0.5d0 + Fock_matrix_AO_beta_kpts = Fock_matrix_AO_kpts*0.5d0 + TOUCH fock_matrix_ao_alpha_kpts Fock_matrix_AO_beta_kpts + endif + + double precision :: level_shift_save + level_shift_save = level_shift + mo_coef_save(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) + do while (Delta_energy_SCF > 0.d0) + mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = mo_coef_save + if (level_shift <= .1d0) then + level_shift = 1.d0 + else + level_shift = level_shift * 3.0d0 + endif + TOUCH mo_coef_kpts level_shift + mo_coef_kpts(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) = & + eigenvectors_fock_matrix_mo_kpts_real(1:ao_num_per_kpt,1:mo_num_per_kpt,1:kpt_num) + if(frozen_orb_scf)then + call reorder_core_orb + call initialize_mo_coef_begin_iteration + endif + TOUCH mo_coef_kpts + Delta_Energy_SCF = SCF_energy - energy_SCF_previous + energy_SCF = SCF_energy + if (level_shift-level_shift_save > 40.d0) then + level_shift = level_shift_save * 4.d0 + SOFT_TOUCH level_shift + exit + endif + dim_DIIS=0 + enddo + level_shift = level_shift * 0.5d0 + SOFT_TOUCH level_shift + energy_SCF_previous = energy_SCF + +! Print results at the end of each iteration + + write(6,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') & + iteration_SCF, energy_scf, Delta_energy_SCF, max_error_DIIS, level_shift, dim_DIIS + + if (Delta_energy_SCF < 0.d0) then + call save_mos + endif + if (qp_stop()) exit + + enddo + + if (iteration_SCF < n_it_SCF_max) then + mo_label = "Canonical" + endif +! +! End of Main SCF loop +! + + write(6,'(A4, 1X, A16, 1X, A16, 1X, A16, 1X, A16)') & + '====','================','================','================','================' + write(6,*) + + if(.not.frozen_orb_scf)then + call mo_as_eigvectors_of_mo_matrix_kpts_real(fock_matrix_mo_kpts_real,size(Fock_matrix_mo_kpts_real,1),size(Fock_matrix_mo_kpts_real,2),size(Fock_matrix_mo_kpts_real,3),mo_label,1,.true.) + call save_mos + endif + + call write_double(6, Energy_SCF, 'SCF energy') + + call write_time(6) + +end + diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index f8d9e7c0..42ccfe0b 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -1277,3 +1277,77 @@ subroutine lapack_diag(eigvalues,eigvectors,H,nmax,n) deallocate(A,eigenvalues) end +subroutine lapack_diagd_diag_in_place(eigvalues,eigvectors,nmax,n) + implicit none + BEGIN_DOC + ! Diagonalize matrix H(complex) + ! + ! H is untouched between input and ouptut + ! + ! eigevalues(i) = ith lowest eigenvalue of the H matrix + ! + ! eigvectors(i,j) = where i is the basis function and psi_j is the j th eigenvector + ! + END_DOC + integer, intent(in) :: n,nmax + double precision, intent(out) :: eigvectors(nmax,n) +! complex*16, intent(inout) :: eigvectors(nmax,n) + double precision, intent(out) :: eigvalues(n) +! double precision, intent(in) :: H(nmax,n) + double precision,allocatable :: work(:) + integer ,allocatable :: iwork(:) +! complex*16,allocatable :: A(:,:) + integer :: lwork, info, i,j,l,k, liwork + +! print*,'Diagonalization by jacobi' +! print*,'n = ',n + + lwork = 2*n*n + 6*n + 1 + liwork = 5*n + 3 + allocate (work(lwork),iwork(liwork)) + + lwork = -1 + liwork = -1 + ! get optimal work size + call DSYEVD( 'V', 'U', n, eigvectors, nmax, eigvalues, work, lwork, & + iwork, liwork, info ) + if (info < 0) then + print *, irp_here, ': DSYEVD: the ',-info,'-th argument had an illegal value' + stop 2 + endif + lwork = int( real(work(1))) + liwork = iwork(1) + deallocate (work,iwork) + + allocate (work(lwork),iwork(liwork)) + call DSYEVD( 'V', 'U', n, eigvectors, nmax, eigvalues, work, lwork, & + iwork, liwork, info ) + deallocate(work,iwork) + + + if (info < 0) then + print *, irp_here, ': DSYEVD: the ',-info,'-th argument had an illegal value' + stop 2 + else if( info > 0 ) then + write(*,*)'DSYEVD Failed; calling DSYEV' + lwork = 3*n - 1 + allocate(work(lwork)) + lwork = -1 + call DSYEV('V','L',n,eigvectors,nmax,eigvalues,work,lwork,info) + if (info < 0) then + print *, irp_here, ': DSYEV: the ',-info,'-th argument had an illegal value' + stop 2 + endif + lwork = int(work(1)) + deallocate(work) + allocate(work(lwork)) + call DSYEV('V','L',n,eigvectors,nmax,eigvalues,work,lwork,info) + if (info /= 0 ) then + write(*,*)'DSYEV Failed' + stop 1 + endif + deallocate(work) + end if + +end + From 50bc4b94fca5ac8960d050414179755e26928f6d Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Tue, 14 Jul 2020 18:00:14 -0500 Subject: [PATCH 242/256] fixed bug in hij from fock for singles --- src/determinants/single_excitations.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/determinants/single_excitations.irp.f b/src/determinants/single_excitations.irp.f index 192681b3..7199ef35 100644 --- a/src/determinants/single_excitations.irp.f +++ b/src/determinants/single_excitations.irp.f @@ -456,6 +456,7 @@ subroutine get_single_excitation_from_fock_kpts(det_1,det_2,ih,ip,spin,phase,hij call get_kpt_idx_mo(ih,kh,h) ASSERT (kh==khp) !todo: omp kpts + hij = fock_op_cshell_ref_bitmask_kpts(h,p,khp) do ki=1,kpt_num do i=1, mo_num_per_kpt ! @@ -477,7 +478,6 @@ subroutine get_single_excitation_from_fock_kpts(det_1,det_2,ih,ip,spin,phase,hij enddo call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int) call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int) - hij = fock_op_cshell_ref_bitmask_kpts(h,p,khp) ! holes :: direct terms do i0 = 1, n_occ_ab_hole(1) i = occ_hole(i0,1) - (ki-1)*mo_num_per_kpt From 3806554438f42982291819bf42a0deb224601994 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 27 Jul 2020 15:21:30 -0500 Subject: [PATCH 243/256] d/f/g/h mo coef correct in pyscf converter for molecules --- src/utils_complex/MolPyscfToQPkpts.py | 81 +++++++++++++++++++++++++-- 1 file changed, 77 insertions(+), 4 deletions(-) diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 81464d2b..428c1162 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -807,7 +807,6 @@ def xyzcount(s): def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, qph5path = 'qpdat.h5', - norm='sp', print_debug=False): ''' cas_idx = List of active MOs. If not specified all MOs are actives @@ -817,6 +816,7 @@ def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, import h5py + norm='sp' mol = mf.mol nao_c = mol.nao_cart() @@ -837,13 +837,86 @@ def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, qph5.create_group('mo_basis') if mf.mol.cart: - mo_coeff = mf.mo_coeff + mo_coeff = mf.mo_coeff.copy() else: - c2s = mol.cart2sph_coeff(normalized=norm) - #c2s = mol.cart2sph_coeff(normalized='sp') + #c2s = mol.cart2sph_coeff(normalized=norm) + c2s = mol.cart2sph_coeff(normalized='sp') #c2s = mol.cart2sph_coeff(normalized='all') #c2s = mol.cart2sph_coeff(normalized=None) mo_coeff = np.dot(c2s,mf.mo_coeff) + #TODO: clean this up; use mol.cart_labels(fmt=False) + dnormlbl1=["dxx","dyy","dzz"] + dnormfac1 = 2.0*np.sqrt(np.pi/5) + + dnormlbl2=["dxy","dxz","dyz"] + dnormfac2 = 2.0*np.sqrt(np.pi/15) + + fnormlbl1=["fxxx","fyyy","fzzz"] + fnormfac1 = 2.0*np.sqrt(np.pi/7) + + fnormlbl2=["fxxy","fxxz","fxyy","fxzz","fyyz","fyzz"] + fnormfac2 = 2.0*np.sqrt(np.pi/35) + + fnormlbl3=["fxyz"] + fnormfac3 = 2.0*np.sqrt(np.pi/105) + + gnormlbl1=["gxxxx","gyyyy","gzzzz"] + gnormfac1 = 2.0*np.sqrt(np.pi/9) + + gnormlbl2=["gxxxy","gxxxz","gxyyy","gxzzz","gyyyz","gyzzz"] + gnormfac2 = 2.0*np.sqrt(np.pi/63) + + gnormlbl3=["gxxyy","gxxzz","gyyzz"] + gnormfac3 = 2.0*np.sqrt(np.pi/105) + + gnormlbl4=["gxxyz","gxyyz","gxyzz"] + gnormfac4 = 2.0*np.sqrt(np.pi/315) + + hnormlbl1=["hxxxxx","hyyyyy","hzzzzz"] + hnormfac1 = 2.0*np.sqrt(np.pi/11) + + hnormlbl2=["hxxxxy","hxxxxz","hxyyyy","hxzzzz","hyyyyz","hyzzzz"] + hnormfac2 = 2.0*np.sqrt(np.pi/99) + + hnormlbl3=["hxxxyy","hxxxzz","hxxyyy","hxxzzz","hyyyzz","hyyzzz"] + hnormfac3 = 2.0*np.sqrt(np.pi/231) + + hnormlbl4=["hxxxyz","hxyyyz","hxyzzz"] + hnormfac4 = 2.0*np.sqrt(np.pi/693) + + hnormlbl5=["hxxyyz","hxxyzz","hxyyzz"] + hnormfac5 = 2.0*np.sqrt(np.pi/1155) + + for i_lbl,mo_lbl in enumerate(mol.cart_labels()): + if any(i in mo_lbl for i in dnormlbl1): + mo_coeff[i_lbl,:] *= dnormfac1 + elif any(i in mo_lbl for i in dnormlbl2): + mo_coeff[i_lbl,:] *= dnormfac2 + elif any(i in mo_lbl for i in fnormlbl1): + mo_coeff[i_lbl,:] *= fnormfac1 + elif any(i in mo_lbl for i in fnormlbl2): + mo_coeff[i_lbl,:] *= fnormfac2 + elif any(i in mo_lbl for i in fnormlbl3): + mo_coeff[i_lbl,:] *= fnormfac3 + elif any(i in mo_lbl for i in gnormlbl1): + mo_coeff[i_lbl,:] *= gnormfac1 + elif any(i in mo_lbl for i in gnormlbl2): + mo_coeff[i_lbl,:] *= gnormfac2 + elif any(i in mo_lbl for i in gnormlbl3): + mo_coeff[i_lbl,:] *= gnormfac3 + elif any(i in mo_lbl for i in gnormlbl4): + mo_coeff[i_lbl,:] *= gnormfac4 + elif any(i in mo_lbl for i in hnormlbl1): + mo_coeff[i_lbl,:] *= hnormfac1 + elif any(i in mo_lbl for i in hnormlbl2): + mo_coeff[i_lbl,:] *= hnormfac2 + elif any(i in mo_lbl for i in hnormlbl3): + mo_coeff[i_lbl,:] *= hnormfac3 + elif any(i in mo_lbl for i in hnormlbl4): + mo_coeff[i_lbl,:] *= hnormfac4 + elif any(i in mo_lbl for i in hnormlbl5): + mo_coeff[i_lbl,:] *= hnormfac5 + # Mo_coeff actif mo_c = np.array([c[:,cas_idx] for c in mo_coeff] if cas_idx is not None else mo_coeff) e_c = np.array([e[cas_idx] for e in mf.mo_energy] if cas_idx is not None else mf.mo_energy) From 239c5810739888c22a0c206e7bdea3be3d1d8631 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 11:38:55 -0500 Subject: [PATCH 244/256] pyscf converter for molecules --- src/utils_complex/Gen_Ezfio_from_pyscf_mol.sh | 66 ++++++++++ src/utils_complex/MolPyscfToQPkpts.py | 79 +++++++++++ src/utils_complex/create_ezfio_pyscf_mol.py | 124 ++++++++++++++++++ 3 files changed, 269 insertions(+) create mode 100755 src/utils_complex/Gen_Ezfio_from_pyscf_mol.sh create mode 100755 src/utils_complex/create_ezfio_pyscf_mol.py diff --git a/src/utils_complex/Gen_Ezfio_from_pyscf_mol.sh b/src/utils_complex/Gen_Ezfio_from_pyscf_mol.sh new file mode 100755 index 00000000..7caa20fa --- /dev/null +++ b/src/utils_complex/Gen_Ezfio_from_pyscf_mol.sh @@ -0,0 +1,66 @@ +#!/bin/bash + +ezfio=$1 +h5file=$2 +# Create the integral +echo 'Create Integral' + +echo 'Create EZFIO' +#read nel nmo natom <<< $(cat param) +#read e_nucl <<< $(cat e_nuc) +#read nao <<< $(cat num_ao) +#read nkpts <<< $(cat kpt_num) +#read ndf <<< $(cat num_df) +##./create_ezfio_complex_4idx.py $ezfio $nel $natom $nmo $e_nucl $nao $nkpts +./create_ezfio_pyscf_mol.py $ezfio $h5file #$nel $natom $nmo $e_nucl $nao $nkpts $ndf +#Handle the orbital consitensy check +#qp_edit -c $ezfio &> /dev/null +#cp $ezfio/{ao,mo}_basis/ao_md5 + +#qp_run import_ao_2e_complex $ezfio +#qp_run dump_ao_2e_from_df $ezfio +#Read the integral +#echo 'Read Integral' + + +################################################ +## using AO mono, 4-idx from pyscf ## +################################################ +#qp_run import_integrals_ao_periodic $ezfio + + +################################################ +## using AO mono, 3-idx, mo coef from pyscf ## +################################################ + +#qp_run read_ao_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_ao_df_complex $ezfio +#qp_run read_mo_coef_complex $ezfio #start from converged pyscf MOs +# +#qp_run save_mo_df_to_disk $ezfio +#qp_run save_mo_bielec_to_disk $ezfio + +#qp_run mo_from_ao_orth $ezfio #use canonical orthonormalized AOs as initial MO guess +#qp_run print_H_matrix_restart $ezfio > hmat.out + + +############################################################### +## using AO mono, full 4-idx AO bielec, mo coef from pyscf ## +############################################################### + +#qp_run read_ao_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_ao_eri_chunk_complex $ezfio +#qp_run read_mo_coef_complex $ezfio #start from converged pyscf MOs +##qp_run mo_from_ao_orth $ezfio #use canonical orthonormalized AOs as initial MO guess + + +###################################################### +## using MO mono, full 4-idx MO bielec from pyscf ## +###################################################### + +#qp_run read_mo_mono_complex $ezfio +#qp_run read_kconserv $ezfio +#qp_run read_mo_eri_chunk_complex $ezfio + diff --git a/src/utils_complex/MolPyscfToQPkpts.py b/src/utils_complex/MolPyscfToQPkpts.py index 428c1162..b13a2dba 100644 --- a/src/utils_complex/MolPyscfToQPkpts.py +++ b/src/utils_complex/MolPyscfToQPkpts.py @@ -835,6 +835,8 @@ def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, qph5.create_group('electrons') qph5.create_group('ao_basis') qph5.create_group('mo_basis') + qph5.create_group('pseudo') + qph5['pseudo'].attrs['do_pseudo']=False if mf.mol.cart: mo_coeff = mf.mo_coeff.copy() @@ -951,6 +953,83 @@ def pyscf2QP2_mol(mf, cas_idx=None, int_threshold = 1E-8, for i in range(natom): atom_dset[i] = mol.atom_pure_symbol(i) + ########################################## + # # + # ECP # + # # + ########################################## + + if (mol.has_ecp()): + #atsymb = [mol.atom_pure_symbol(i) for i in range(natom)] + #pyecp = mol._ecp + ## nelec to remove for each atom + #nuc_z_remov = [pyecp[i][0] for i in atsymb] + #nl_per_atom = [len(pyecp[i][1]) for i in atsymb] + ## list of l-values for channels of each atom + #ecp_l = [[pyecp[i][1][j][0] for j in range(len(pyecp[i][1]))] for i in atsymb] + ## list of [exp,coef] for each channel (r**0,1,2,3,4,5,) + #ecp_ac = [[pyecp[i][1][j][1] for j in range(len(pyecp[i][1]))] for i in atsymb] + pyecp = [mol._ecp[mol.atom_pure_symbol(i)] for i in range(natom)] + nzrmv=[0]*natom + lmax=0 + klocmax=0 + knlmax=0 + for i,(nz,dat) in enumerate(pyecp): + nzrmv[i]=nz + for lval,ac in dat: + if (lval==-1): + klocmax=max(sum(len(j) for j in ac),klocmax) + else: + lmax=max(lval,lmax) + knlmax=max(sum(len(j) for j in ac),knlmax) + #psd_nk = np.zeros((natom,klocmax),dtype=int) + #psd_vk = np.zeros((natom,klocmax),dtype=float) + #psd_dzk = np.zeros((natom,klocmax),dtype=float) + #psd_nkl = np.zeros((natom,knlmax,lmax+1),dtype=int) + #psd_vkl = np.zeros((natom,knlmax,lmax+1),dtype=float) + #psd_dzkl = np.zeros((natom,knlmax,lmax+1),dtype=float) + klnlmax=max(klocmax,knlmax) + psd_n = np.zeros((lmax+2,klnlmax,natom),dtype=int) + psd_v = np.zeros((lmax+2,klnlmax,natom),dtype=float) + psd_dz = np.zeros((lmax+2,klnlmax,natom),dtype=float) + for i,(_,dat) in enumerate(pyecp): + for lval,ac in dat: + count=0 + for ri,aici in enumerate(ac): + for ai,ci in aici: + psd_n[lval+1,count,i] = ri-2 + psd_v[lval+1,count,i] = ci + psd_dz[lval+1,count,i] = ai + count += 1 + psd_nk = psd_n[0,:klocmax] + psd_vk = psd_v[0,:klocmax] + psd_dzk = psd_dz[0,:klocmax] + psd_nkl = psd_n[1:,:knlmax] + psd_vkl = psd_v[1:,:knlmax] + psd_dzkl = psd_dz[1:,:knlmax] + with h5py.File(qph5path,'a') as qph5: + qph5['pseudo'].attrs['do_pseudo']=True + qph5['pseudo'].attrs['pseudo_lmax']=lmax + qph5['pseudo'].attrs['pseudo_klocmax']=klocmax + qph5['pseudo'].attrs['pseudo_kmax']=knlmax + qph5.create_dataset('pseudo/nucl_charge_remove',data=nzrmv) + qph5.create_dataset('pseudo/pseudo_n_k',data=psd_nk) + qph5.create_dataset('pseudo/pseudo_n_kl',data=psd_nkl) + qph5.create_dataset('pseudo/pseudo_v_k',data=psd_vk) + qph5.create_dataset('pseudo/pseudo_v_kl',data=psd_vkl) + qph5.create_dataset('pseudo/pseudo_dz_k',data=psd_dzk) + qph5.create_dataset('pseudo/pseudo_dz_kl',data=psd_dzkl) + + ## nelec to remove for each atom + #nuc_z_remov = [i[0] for i in pyecp] + #nl_per_atom = [len(i[1]) for i in pyecp] + ## list of l-values for channels of each atom + #ecp_l = [[ j[0] for j in i[1] ] for i in pyecp] + #lmax = max(map(max,ecp_l)) + ## list of [exp,coef] for each channel (r**0,1,2,3,4,5,) + #ecp_ac = [[ j[1] for j in i[1] ] for i in pyecp] + + ########################################## # # # Basis # diff --git a/src/utils_complex/create_ezfio_pyscf_mol.py b/src/utils_complex/create_ezfio_pyscf_mol.py new file mode 100755 index 00000000..cf9c4655 --- /dev/null +++ b/src/utils_complex/create_ezfio_pyscf_mol.py @@ -0,0 +1,124 @@ +#!/usr/bin/env python +from ezfio import ezfio +import h5py + +import sys +import numpy as np +fname = sys.argv[1] +qph5name = sys.argv[2] + +#qph5=h5py.File(qph5path,'r') + +def convert_mol(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(False) + + with h5py.File(qph5path,'r') as qph5: + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + + ezfio.set_nuclei_nucl_num(nucl_num) + + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + do_pseudo = qph5['pseudo'].attrs['do_pseudo'] + ezfio.set_pseudo_do_pseudo(do_pseudo) + if (do_pseudo): + ezfio.set_pseudo_pseudo_lmax(qph5['pseudo'].attrs['pseudo_lmax']) + ezfio.set_pseudo_pseudo_klocmax(qph5['pseudo'].attrs['pseudo_klocmax']) + ezfio.set_pseudo_pseudo_kmax(qph5['pseudo'].attrs['pseudo_kmax']) + ezfio.set_pseudo_nucl_charge_remove(qph5['pseudo/nucl_charge_remove'][()].tolist()) + ezfio.set_pseudo_pseudo_n_k(qph5['pseudo/pseudo_n_k'][()].tolist()) + ezfio.set_pseudo_pseudo_n_kl(qph5['pseudo/pseudo_n_kl'][()].tolist()) + ezfio.set_pseudo_pseudo_v_k(qph5['pseudo/pseudo_v_k'][()].tolist()) + ezfio.set_pseudo_pseudo_v_kl(qph5['pseudo/pseudo_v_kl'][()].tolist()) + ezfio.set_pseudo_pseudo_dz_k(qph5['pseudo/pseudo_dz_k'][()].tolist()) + ezfio.set_pseudo_pseudo_dz_kl(qph5['pseudo/pseudo_dz_kl'][()].tolist()) + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + coeftmp = qph5['ao_basis/ao_coef'][()] + expotmp = qph5['ao_basis/ao_expo'][()] + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + ezfio.set_ao_basis_ao_prim_num(qph5['ao_basis/ao_prim_num'][()].tolist()) + ezfio.set_ao_basis_ao_power(qph5['ao_basis/ao_power'][()].tolist()) + ezfio.set_ao_basis_ao_coef(qph5['ao_basis/ao_coef'][()].tolist()) + ezfio.set_ao_basis_ao_expo(qph5['ao_basis/ao_expo'][()].tolist()) + + print(coeftmp) + print(expotmp) + + ########################################## + # # + # MO Coef # + # # + ########################################## + + + with h5py.File(qph5path,'r') as qph5: + mo_coef = qph5['mo_basis/mo_coef'][()].tolist() + ezfio.set_mo_basis_mo_coef(mo_coef) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + return + +convert_mol(fname,qph5name) From afdc1a92052ed9eb700a154bc1545379c945c2b8 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 12:14:14 -0500 Subject: [PATCH 245/256] added cleaner pyscf h5 converter --- bin/qp_convert_h5_to_ezfio | 159 +++++++++++++++++++++++++++++++++++++ 1 file changed, 159 insertions(+) create mode 100755 bin/qp_convert_h5_to_ezfio diff --git a/bin/qp_convert_h5_to_ezfio b/bin/qp_convert_h5_to_ezfio new file mode 100755 index 00000000..73ae7466 --- /dev/null +++ b/bin/qp_convert_h5_to_ezfio @@ -0,0 +1,159 @@ +#!/usr/bin/env python3 +""" +convert hdf5 output (e.g. from PySCF) to ezfio + +Usage: + qp_convert_h5_to_ezfio [-o EZFIO_DIR] FILE + +Options: + -o --output=EZFIO_DIR Produced directory + by default is FILE.ezfio + +""" +from ezfio import ezfio +import h5py +import sys +import numpy as np +import os +from docopt import docopt +#fname = sys.argv[1] +#qph5name = sys.argv[2] + +def get_full_path(file_path): + file_path = os.path.expanduser(file_path) + file_path = os.path.expandvars(file_path) +# file_path = os.path.abspath(file_path) + return file_path + +def convert_mol(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(False) + + with h5py.File(qph5path,'r') as qph5: + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + + ezfio.set_nuclei_nucl_num(nucl_num) + + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + do_pseudo = qph5['pseudo'].attrs['do_pseudo'] + ezfio.set_pseudo_do_pseudo(do_pseudo) + if (do_pseudo): + ezfio.set_pseudo_pseudo_lmax(qph5['pseudo'].attrs['pseudo_lmax']) + ezfio.set_pseudo_pseudo_klocmax(qph5['pseudo'].attrs['pseudo_klocmax']) + ezfio.set_pseudo_pseudo_kmax(qph5['pseudo'].attrs['pseudo_kmax']) + ezfio.set_pseudo_nucl_charge_remove(qph5['pseudo/nucl_charge_remove'][()].tolist()) + ezfio.set_pseudo_pseudo_n_k(qph5['pseudo/pseudo_n_k'][()].tolist()) + ezfio.set_pseudo_pseudo_n_kl(qph5['pseudo/pseudo_n_kl'][()].tolist()) + ezfio.set_pseudo_pseudo_v_k(qph5['pseudo/pseudo_v_k'][()].tolist()) + ezfio.set_pseudo_pseudo_v_kl(qph5['pseudo/pseudo_v_kl'][()].tolist()) + ezfio.set_pseudo_pseudo_dz_k(qph5['pseudo/pseudo_dz_k'][()].tolist()) + ezfio.set_pseudo_pseudo_dz_kl(qph5['pseudo/pseudo_dz_kl'][()].tolist()) + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + #coeftmp = qph5['ao_basis/ao_coef'][()] + #expotmp = qph5['ao_basis/ao_expo'][()] + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + ezfio.set_ao_basis_ao_prim_num(qph5['ao_basis/ao_prim_num'][()].tolist()) + ezfio.set_ao_basis_ao_power(qph5['ao_basis/ao_power'][()].tolist()) + ezfio.set_ao_basis_ao_coef(qph5['ao_basis/ao_coef'][()].tolist()) + ezfio.set_ao_basis_ao_expo(qph5['ao_basis/ao_expo'][()].tolist()) + + + ########################################## + # # + # MO Coef # + # # + ########################################## + + + with h5py.File(qph5path,'r') as qph5: + mo_coef = qph5['mo_basis/mo_coef'][()].tolist() + ezfio.set_mo_basis_mo_coef(mo_coef) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + return + +if __name__ == '__main__': + ARGUMENTS = docopt(__doc__) + + FILE = get_full_path(ARGUMENTS['FILE']) + + if ARGUMENTS["--output"]: + EZFIO_FILE = get_full_path(ARGUMENTS["--output"]) + else: + EZFIO_FILE = "{0}.ezfio".format(FILE) + + + convert_mol(EZFIO_FILE,FILE) + + sys.stdout.flush() + if os.system("qp_run save_ortho_mos "+EZFIO_FILE) != 0: + print("""Warning: You need to run + + qp run save_ortho_mos + +to be sure your MOs will be orthogonal, which is not the case when +the MOs are read from output files (not enough precision in output).""") + From 6512d3827f48504aaf1f260b50e46a56f4ba0691 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 14:04:16 -0500 Subject: [PATCH 246/256] e_scf printing now works for kpts --- src/hartree_fock/print_e_scf.irp.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/hartree_fock/print_e_scf.irp.f b/src/hartree_fock/print_e_scf.irp.f index 65e97a56..989c0b9c 100644 --- a/src/hartree_fock/print_e_scf.irp.f +++ b/src/hartree_fock/print_e_scf.irp.f @@ -7,7 +7,9 @@ subroutine run use bitmasks implicit none - call print_debug_scf_complex + !if (is_complex) then + ! call print_debug_scf_complex + !endif print*,'hf 1e,2e,total energy' print*,hf_one_electron_energy From bd076b62a46359894e636d1ccd11b7655200d1d4 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 14:07:03 -0500 Subject: [PATCH 247/256] updated pyscf converter --- bin/qp_convert_h5_to_ezfio | 407 ++++++++++++++++++++++++++++++++++++- 1 file changed, 397 insertions(+), 10 deletions(-) diff --git a/bin/qp_convert_h5_to_ezfio b/bin/qp_convert_h5_to_ezfio index 73ae7466..61a691c4 100755 --- a/bin/qp_convert_h5_to_ezfio +++ b/bin/qp_convert_h5_to_ezfio @@ -135,6 +135,387 @@ def convert_mol(filename,qph5path): return +def convert_kpts(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(True) + + with h5py.File(qph5path,'r') as qph5: + kpt_num = qph5['nuclei'].attrs['kpt_num'] + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + + ezfio.set_nuclei_kpt_num(kpt_num) + kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 + ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) + + # don't multiply nuclei by kpt_num + # work in k-space, not in equivalent supercell + nucl_num_per_kpt = nucl_num + ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) + + # these are totals (kpt_num * num_per_kpt) + # need to change if we want to truncate orbital space within pyscf + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.set_ao_basis_ao_num_per_kpt(ao_num//kpt_num) + ezfio.set_mo_basis_mo_num_per_kpt(mo_num//kpt_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + if isinstance(nucl_label[0],bytes): + nucl_label = list(map(lambda x:x.decode(),nucl_label)) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + + + #Just need one (can clean this up later) + ao_prim_num_max = 5 + + d = [ [0] *ao_prim_num_max]*ao_num + ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) + ezfio.set_ao_basis_ao_power(d) + ezfio.set_ao_basis_ao_coef(d) + ezfio.set_ao_basis_ao_expo(d) + + + + + ########################################## + # # + # MO Coef # + # # + ########################################## + + + with h5py.File(qph5path,'r') as qph5: + mo_coef_kpts = qph5['mo_basis/mo_coef_kpts'][()].tolist() + mo_coef_cplx = qph5['mo_basis/mo_coef_complex'][()].tolist() + ezfio.set_mo_basis_mo_coef_kpts(mo_coef_kpts) + ezfio.set_mo_basis_mo_coef_complex(mo_coef_cplx) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + + ########################################## + # # + # Integrals Mono # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + if 'ao_one_e_ints' in qph5.keys(): + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic_kpts'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap_kpts'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e_kpts'][()].tolist() + + ezfio.set_ao_one_e_ints_ao_integrals_kinetic_kpts(kin_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_overlap_kpts(ovlp_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_n_e_kpts(ne_ao_reim) + + ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + + + with h5py.File(qph5path,'r') as qph5: + if 'mo_one_e_ints' in qph5.keys(): + kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic_kpts'][()].tolist() + ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap_kpts'][()].tolist() + ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e_kpts'][()].tolist() + + ezfio.set_mo_one_e_ints_mo_integrals_kinetic_kpts(kin_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_overlap_kpts(ovlp_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_n_e_kpts(ne_mo_reim) + + ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + + ########################################## + # # + # k-points # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + kconserv = qph5['nuclei/kconserv'][()].tolist() + + ezfio.set_nuclei_kconserv(kconserv) + ezfio.set_nuclei_io_kconserv('Read') + + ########################################## + # # + # Integrals Bi # + # # + ########################################## + + # should this be in ao_basis? ao_two_e_ints? + with h5py.File(qph5path,'r') as qph5: + if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): + # dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) + # dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) + # dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() + # ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') + + if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + # dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) + # dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) + # dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() + # ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') + + return + +def convert_cplx(filename,qph5path): + ezfio.set_file(filename) + ezfio.set_nuclei_is_complex(True) + + with h5py.File(qph5path,'r') as qph5: + kpt_num = qph5['nuclei'].attrs['kpt_num'] + nucl_num = qph5['nuclei'].attrs['nucl_num'] + ao_num = qph5['ao_basis'].attrs['ao_num'] + mo_num = qph5['mo_basis'].attrs['mo_num'] + elec_alpha_num = qph5['electrons'].attrs['elec_alpha_num'] + elec_beta_num = qph5['electrons'].attrs['elec_beta_num'] + + ezfio.set_nuclei_kpt_num(kpt_num) + kpt_pair_num = (kpt_num*kpt_num + kpt_num)//2 + ezfio.set_nuclei_kpt_pair_num(kpt_pair_num) + + # don't multiply nuclei by kpt_num + # work in k-space, not in equivalent supercell + nucl_num_per_kpt = nucl_num + ezfio.set_nuclei_nucl_num(nucl_num_per_kpt) + + # these are totals (kpt_num * num_per_kpt) + # need to change if we want to truncate orbital space within pyscf + ezfio.set_ao_basis_ao_num(ao_num) + ezfio.set_mo_basis_mo_num(mo_num) + ezfio.electrons_elec_alpha_num = elec_alpha_num + ezfio.electrons_elec_beta_num = elec_beta_num + + + + ##ao_num = mo_num + ##Important ! + #import math + #nelec_per_kpt = num_elec // n_kpts + #nelec_alpha_per_kpt = int(math.ceil(nelec_per_kpt / 2.)) + #nelec_beta_per_kpt = int(math.floor(nelec_per_kpt / 2.)) + # + #ezfio.electrons_elec_alpha_num = int(nelec_alpha_per_kpt * n_kpts) + #ezfio.electrons_elec_beta_num = int(nelec_beta_per_kpt * n_kpts) + + #ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + #ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + #ezfio.set_utils_num_kpts(n_kpts) + #ezfio.set_integrals_bielec_df_num(n_aux) + + #(old)Important + #ezfio.set_nuclei_nucl_num(nucl_num) + #ezfio.set_nuclei_nucl_charge([0.]*nucl_num) + #ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) + #ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + + + with h5py.File(qph5path,'r') as qph5: + nucl_charge=qph5['nuclei/nucl_charge'][()].tolist() + nucl_coord=qph5['nuclei/nucl_coord'][()].T.tolist() + nucl_label=qph5['nuclei/nucl_label'][()].tolist() + nuclear_repulsion = qph5['nuclei'].attrs['nuclear_repulsion'] + + ezfio.set_nuclei_nucl_charge(nucl_charge) + ezfio.set_nuclei_nucl_coord(nucl_coord) + if isinstance(nucl_label[0],bytes): + nucl_label = list(map(lambda x:x.decode(),nucl_label)) + ezfio.set_nuclei_nucl_label(nucl_label) + + ezfio.set_nuclei_io_nuclear_repulsion('Read') + ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + + + ########################################## + # # + # Basis # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + ezfio.set_ao_basis_ao_basis(qph5['ao_basis'].attrs['ao_basis']) + ezfio.set_ao_basis_ao_nucl(qph5['ao_basis/ao_nucl'][()].tolist()) + + + #Just need one (can clean this up later) + ao_prim_num_max = 5 + + d = [ [0] *ao_prim_num_max]*ao_num + ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) + ezfio.set_ao_basis_ao_power(d) + ezfio.set_ao_basis_ao_coef(d) + ezfio.set_ao_basis_ao_expo(d) + + + + + ########################################## + # # + # MO Coef # + # # + ########################################## + + + with h5py.File(qph5path,'r') as qph5: + mo_coef_reim = qph5['mo_basis/mo_coef_complex'][()].tolist() + ezfio.set_mo_basis_mo_coef_complex(mo_coef_reim) + #maybe fix qp so we don't need this? + #ezfio.set_mo_basis_mo_coef([[i for i in range(mo_num)] * ao_num]) + + + ########################################## + # # + # Integrals Mono # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + if 'ao_one_e_ints' in qph5.keys(): + kin_ao_reim=qph5['ao_one_e_ints/ao_integrals_kinetic'][()].tolist() + ovlp_ao_reim=qph5['ao_one_e_ints/ao_integrals_overlap'][()].tolist() + ne_ao_reim=qph5['ao_one_e_ints/ao_integrals_n_e'][()].tolist() + + ezfio.set_ao_one_e_ints_ao_integrals_kinetic_complex(kin_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_overlap_complex(ovlp_ao_reim) + ezfio.set_ao_one_e_ints_ao_integrals_n_e_complex(ne_ao_reim) + + ezfio.set_ao_one_e_ints_io_ao_integrals_kinetic('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_overlap('Read') + ezfio.set_ao_one_e_ints_io_ao_integrals_n_e('Read') + + + with h5py.File(qph5path,'r') as qph5: + if 'mo_one_e_ints' in qph5.keys(): + kin_mo_reim=qph5['mo_one_e_ints/mo_integrals_kinetic'][()].tolist() + #ovlp_mo_reim=qph5['mo_one_e_ints/mo_integrals_overlap'][()].tolist() + ne_mo_reim=qph5['mo_one_e_ints/mo_integrals_n_e'][()].tolist() + + ezfio.set_mo_one_e_ints_mo_integrals_kinetic_complex(kin_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_overlap_complex(ovlp_mo_reim) + #ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + ezfio.set_mo_one_e_ints_mo_integrals_n_e_complex(ne_mo_reim) + + ezfio.set_mo_one_e_ints_io_mo_integrals_kinetic('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_overlap('Read') + #ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + ezfio.set_mo_one_e_ints_io_mo_integrals_n_e('Read') + + ########################################## + # # + # k-points # + # # + ########################################## + + with h5py.File(qph5path,'r') as qph5: + kconserv = qph5['nuclei/kconserv'][()].tolist() + + ezfio.set_nuclei_kconserv(kconserv) + ezfio.set_nuclei_io_kconserv('Read') + + ########################################## + # # + # Integrals Bi # + # # + ########################################## + + # should this be in ao_basis? ao_two_e_ints? + with h5py.File(qph5path,'r') as qph5: + if 'ao_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + if 'df_ao_integrals' in qph5['ao_two_e_ints'].keys(): + # dfao_re0=qph5['ao_two_e_ints/df_ao_integrals_real'][()].transpose((3,2,1,0)) + # dfao_im0=qph5['ao_two_e_ints/df_ao_integrals_imag'][()].transpose((3,2,1,0)) + # dfao_cmplx0 = np.stack((dfao_re0,dfao_im0),axis=-1).tolist() + # ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_cmplx0) + dfao_reim=qph5['ao_two_e_ints/df_ao_integrals'][()].tolist() + ezfio.set_ao_two_e_ints_df_ao_integrals_complex(dfao_reim) + ezfio.set_ao_two_e_ints_io_df_ao_integrals('Read') + + if 'mo_two_e_ints' in qph5.keys(): + df_num = qph5['ao_two_e_ints'].attrs['df_num'] + ezfio.set_ao_two_e_ints_df_num(df_num) + # dfmo_re0=qph5['mo_two_e_ints/df_mo_integrals_real'][()].transpose((3,2,1,0)) + # dfmo_im0=qph5['mo_two_e_ints/df_mo_integrals_imag'][()].transpose((3,2,1,0)) + # dfmo_cmplx0 = np.stack((dfmo_re0,dfmo_im0),axis=-1).tolist() + # ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_cmplx0) + dfmo_reim=qph5['mo_two_e_ints/df_mo_integrals'][()].tolist() + ezfio.set_mo_two_e_ints_df_mo_integrals_complex(dfmo_reim) + ezfio.set_mo_two_e_ints_io_df_mo_integrals('Read') + + return + + if __name__ == '__main__': ARGUMENTS = docopt(__doc__) @@ -145,15 +526,21 @@ if __name__ == '__main__': else: EZFIO_FILE = "{0}.ezfio".format(FILE) - - convert_mol(EZFIO_FILE,FILE) + with h5py.File(FILE,'r') as qph5: + do_kpts = ('kconserv' in qph5['nuclei'].keys()) + if (do_kpts): + print("converting HDF5 to EZFIO for periodic system") + convert_kpts(EZFIO_FILE,FILE) + else: + print("converting HDF5 to EZFIO for molecular system") + convert_mol(EZFIO_FILE,FILE) - sys.stdout.flush() - if os.system("qp_run save_ortho_mos "+EZFIO_FILE) != 0: - print("""Warning: You need to run - - qp run save_ortho_mos - -to be sure your MOs will be orthogonal, which is not the case when -the MOs are read from output files (not enough precision in output).""") +# sys.stdout.flush() +# if os.system("qp_run save_ortho_mos "+EZFIO_FILE) != 0: +# print("""Warning: You need to run +# +# qp run save_ortho_mos +# +#to be sure your MOs will be orthogonal, which is not the case when +#the MOs are read from output files (not enough precision in output).""") From a982101a7f0366c896360199e533d3d30d50a291 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 14:10:05 -0500 Subject: [PATCH 248/256] fixed (unused?) complex lowdin coef --- src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f index 3196c1ad..4d513c2f 100644 --- a/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f +++ b/src/mo_guess/pot_mo_ortho_lowdin_ints.irp.f @@ -28,7 +28,7 @@ BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_n_e_ints_cplx, (mo_num,mo_num)] integer :: i1,j1,i,j complex*16 :: c_i1,c_j1 - ao_ortho_lowdin_nucl_elec_integrals = (0.d0,0.d0) + ao_ortho_lowdin_n_e_ints_cplx = (0.d0,0.d0) !$OMP PARALLEL DO DEFAULT(none) & !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & !$OMP SHARED(mo_num,ao_num,ao_ortho_lowdin_coef_complex, & From ff9760b1367225d6a5d6bc14a00e2b20b20ca609 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 14:12:38 -0500 Subject: [PATCH 249/256] fixed wrong type --- src/davidson/diagonalize_ci.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index d49b0690..dcca2cf2 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -313,7 +313,7 @@ END_PROVIDER H_prime(j,j) = H_prime(j,j) + alpha*(s_z2_sz - expected_s2) enddo call lapack_diag_complex(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) - ci_electronic_energy_complex(:) = (0.d0,0.d0) + ci_electronic_energy_complex(:) = 0.d0 i_state = 0 allocate (s2_eigvalues(N_det)) allocate(index_good_state_array(N_det),good_state_array(N_det)) From 5dd0a1c9bd09c1da0926cdd6c074b00507ab4dbb Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 29 Jul 2020 17:36:28 -0500 Subject: [PATCH 250/256] fix for bytes/string conversion --- bin/qp_convert_h5_to_ezfio | 2 ++ 1 file changed, 2 insertions(+) diff --git a/bin/qp_convert_h5_to_ezfio b/bin/qp_convert_h5_to_ezfio index 61a691c4..8b7c038d 100755 --- a/bin/qp_convert_h5_to_ezfio +++ b/bin/qp_convert_h5_to_ezfio @@ -76,6 +76,8 @@ def convert_mol(filename,qph5path): ezfio.set_nuclei_nucl_charge(nucl_charge) ezfio.set_nuclei_nucl_coord(nucl_coord) + if isinstance(nucl_label[0],bytes): + nucl_label = list(map(lambda x:x.decode(),nucl_label)) ezfio.set_nuclei_nucl_label(nucl_label) ezfio.set_nuclei_io_nuclear_repulsion('Read') From 8ba67e01699f47824728b3cb83bd127aa72b1f29 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 31 Jul 2020 18:19:58 -0500 Subject: [PATCH 251/256] updated ezfio --- external/EZFIO.2.0.2.tar.gz | Bin 26640 -> 26746 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/external/EZFIO.2.0.2.tar.gz b/external/EZFIO.2.0.2.tar.gz index 3d1e7d75823cbee391a86457411dd4fa371b7c99..edfc98c9cd6bb9f5c41c26319dc47b2fb7d50284 100644 GIT binary patch delta 25582 zcmV)2K+M08&;k0;0e>Hh2mk;800003>|AYg+cviDXZ#ARn^{{OS+?xh-Ne(GbrQSv zog~i0&USj+9S=l85*mus0;Cl+$$!7+1t396veQo5ox5Ajb}Ny!HdUrF) zijm50rdp-ie)0J~`|vqFKBj-er~7Ys`S6S3;qlSK;laT%e1G5HA3i)fIQ(MrJMgmd zsa&ZnENP3PyldQj@4K7(fATpxkV!F{>Ad_#AE>V%sr}^WP>l~C4Uf}DsZO;zq%VIv zR%3m1d^8*?@$csO&(G)koc-_l#pUiyxl-G`-)Rl>hp)dr+U)=Ez2pCf2Zs;8IQpIV zX?_07{lBIE!GFY*W|9|Hf7UfP{y*HP|A!A(^nY}4aPY++BE*^iTjVwbuIrV9e@5cenb3!I2;cD zjQ@YYXI1|LaJ6#zIoG%^{;$zL!2jbvO>W&;0*K ze7^k4-hasCdn3@i_)>f+N&C`Gb(T?KsPa@UOgY6L^Guhf$YGoyv$=VFd3pWKgB_Wq z^1)7OY_4WnZasMarw-yj58Rz~<8?`_E%}YOPxOxzcKt%CRkG(v_*nMN1gB+KvjRJDU$rNz{#`t^QYK ztbg_rM+td>o3Z@yN4fh;t-SM#=Vu?~KmQ5u%BjvpqY-*9!CrJy7IrD~qC`d>%MyNU zx3#prMH8(qE1Sz9{1_WiFZUO@oBqZHRg!4u%qY{JzV2E{jE!~Wjk1#pyC^Ht7{ zZ8c`m+QL4T=SWNjVnH%1yy(p7_}Ts){C_zO@H*Yh;K8qA@QSG2&taDvCK?%*=c7Bq zn?Wd7{{0U@(MRwgmM zi0OM+fv9>15A~_r%B~t>cK059r*7`aEO@OQ~dr< zis^H!Z#NFv9X5jwHjg^MQH{^!>q62>gpNZGiG%DJ#?WH$+Juk<()a+z`vFWU$g;Ij zs8Fzkndn^Zeh(COk~P@?seb~|6AW-4fMhDS-QG`w$uE0*+p@QXLGJ-bOZH^5MilxZ zeFcqmd5&3b%Jzpd5a}NT15D_G)o_*!%Edvi&P%5gGU$Ol)KD z!H|H_B=XIl>ZzMQk;vKwjNF}W|0carfWA|Izl+jn%b%vPdzAAYc7OcwbE@axtPn0K zd>;bHoXa}Mamo|_@!k5*|7rFAo?kpYdwF&Cx!1V6|95z_=KSyB!Nafr?En1%pWtiX zzI-FUJ$rff`t-Sc_2vm!g7nr9`}#k$b%-zz`tpCOT+893M_7G4E#^yWCeu>xJng~5 zzdh>HD|v3UmRH5NTz@F5<#|!%sX~C#mlt_5=nHv-V^sb&1AKZ_!sxOu&jF`R<#|>V zwlAL)uEg;#PUZf=aJauaJlr43H&>@Zov@$HyA2xDYY0k(<(3Wce2@^rrlQ$ohkqTO45 zRiIWZ`mLo6@~DBh<~glZz@uHJN+OTvb z7yqnC%^1y>L~#x;^gD%cs~<+JCFiPSDpe3U$ZD$5>jeBN4egjhh8$}kMC(8XmJ{Rc z53IugsT_oZVWp7*$ras5qOA_t%V=)LoMFn69IRiPT4Y}ERz#KubWXt}YChZ)OajKt zf`2hUUcnGVRM}wQo3SFO27Oqsvl2cvD;J>CQqSFExijohX5vKImO7ZF*g5Ed{J_t> znMAp1F*P7ml#!#CnVx`~Q_gdgkA2eX#~KEjdz6Jpjq!TK^=alnLZ}O^P-7H5A>8_{ zAXRi0*bo~$d1EkmZ*YPHu0tNK&~O1x<$tNGRl(6TFJQjKB($U@X?Lw$1B$p9ucR1a z-cT5Z=QE9~U|mM6&6UHd2hqVo3m+|9Y(c=TR~ay~2*yDM6tX(5Sb$1QuChL?!CS%{ z1A>6eKBH7>i?m9Z4ay;?U9e6h0HHZU)uR?7TEeHJZ5S}GN=h(nF6a0rHEx@l4<2R1QGZRvHOi`2!EBbX?oMz_Gkm6JUm9Z*W(mHvq6AhbJTzBxs;y@ z*da$vq=}9KJLosz%iFqOYfBgmj0?nj5!$;OAzz=pesLvFUp|BS`Q@{V>x;{mSMvPw zHT-<_!^O*Q`|{bv)%EL(CvWf-4SaF=?Be|5=_x+IW%dVzoYp}lZ;vEx*na}!m_=dV z`p|&L5cKARLfK&QooC7$ELueqccw*#*~O`)N4GOTpdj`paHOKD6A%kAK;`xLV!(3W zdd2*00f5#ZxxOIKQnOEaA=(3SPk|4Na*MVyQtZyOa-b$=8WNqd--LMXgk5m{|=jMgRzO@AWtY!EVAhc|~4 zjcI_-PNM${mX@-2pFiip5^kt5z7(}Jj5 zN&*x|O-U(Ht{9pKEAK!Y)N{mMIaMVPvXHrv27peH3--B&MrJF-+epjd zDk1UIn@kJMsbDx@6n~?ZpHj01u;$5ZyBNrzdSi5rxY^|7Au~t=6(BKiK8W+W0l)%9 zGdD?9R4(JyA?8pp2it`wb98jbFnFe`a%wTUdX@O%1MSnK+VT1(Qq60&qt%Shl z*AXf!K)Vdwn$e)DT1#B&5PJ1M214z0=?tE(uwAn=hkA`yVuZK!RFnsb#oR|2+;feO zA^?V2_g$#W18OGAIcO}$13aS0yRz#ICPYjh*#t*67*SDToH4r_Lvi0HQ?}C>X;Nr! z2SOj<<(gD-<$pIf6lw&1yT&fTGyrkWv}PmWT{s;j^2eN(Rj;W65>+`aA!^Wwy=sd2 z3CNZN3w!jJR?y^#hQqi@J{^iok~ha3rVt_!-jol9$D=$v7_IO@wuu6$$wu-5;dsyT zwXHuaPAlwU=m6oNftiXv|` zHm#|k0c}D8A@%$7kzT;=wdg~l&%v$;SmF&d7j6`Cd&(+ILl9^D<{{8RfQ^bm7A4v! zy~IW>rqmFH(Ie3GXnI7DP@>5_L)c@oDP&rU(Sj;N;Lc!>x2O~VN@&n*PkCNc5MAiJ zpOY{-MSm;e$+Zzr5dr^TbMdo-pcV?4en4QgeRwZmKI#d*rei_fHS+if*R#b3X_LB$ zLf2t@8r4}A@)wemRP7e>*62kiCK8nf;q9EgOEiV6$CzMSDZ6w!8;71_&;js9Brw-e zO0O+}h0kq*ye0BJ2eDQJ3cFcF2y{y$ZPeKzHh<`ex^F^5XWUevo}5o6wYk!gjdxHn zDhxsac(0%glurA`3&{t|Nt(h~XrpKLDJ@~|VT61rSL8sAI=P69ECIv@cHm&A!THe4 zZ~^Dx-V8*1i**j|P` zbAJx+`qpG&Hbow)F*(9;Wnx?_r-*J&p|~33O`o%vMkosXtPq4mTLRqwZQ3DR=P?Ed zSQtu(ci0j4su!qQ>z4@_v!Z0d?GSiC#V2pe>WQ)`?pa40g z_Ip{!OD`wNMTm={{vY8~SBkiG1jD$vvlw`$0U&^wc)fFP%u_I60YUU>;nD`v_Xu>UGF zhMFcJ<{SoNCm_Op4ain^rfPp8#NEfs@rKEP%rc11CH3EUUrVhl9n>^c1>qwK2+O|5 z;~qfec$&ox=$y~<2p9PSu23Lg^3ygzZ7;akUi*}US@uMsD;4o5MR%3c(gWc>&cC0g zgU#~io%{xqgb^`+r~l>wL`taIR=ORbi-1Xw@1=PDVyJb$^U{86e5z`z!>SzQV*TIM zTvelx9Y!pDk6c;@WaB2Na6^oFp<_W-$E?nrI0z5pe5bZun1MX$K=hnyhL~w?$kndT zs|#A4mkj4ID}2FoSfs*I$uva^6n0tVs4!8^6^RM`FmM5Xg@&)kCO6z`#WKr}=QwQ5 zoDY;SVT+KzkU8VqWCVM#L!M^tL*)1^n6b_n znm7#OJ-uws1yZW9g@Ksku#T=2hf#eeBI&y0f7kyLlYsteU!Tx+65 z&dW{-<_xwZ!`U=hj=ya|v9{hmVq&szJi?q{fzM6b_DQa9=s^VEpcw21m9Bg8!8dQP z;8me0vvfu`H6v4UqdrrM`tZJ}{|v6PAEpC;xuw9P>CuwU#i(1+!q=VF{f=)hZfvpl zxV3}ljY(}ayuR`+-Ik6^!moHrjs3=O$>`Ud>oLbQ`=TSnPKD!dIvfx96s0sX?eWQ7 zNdKN4m+_s3jstn)#|k-kV~A)XoFn@;d{Km*xZO#N&i4af;N298N<7Wh8_q(*4GJHB zo(v=g-?toBmQJf$_f32W*0j{OWnF9f*y;lS*)@n_N(Wp6(e@;NL4`pQ6t?jH3F@iw zK!2bVMPu4Wry%=!ATP$8*QuKVE?S=pU=Dzy{pTv3P$!QuN>rTkk+T3GiU~)DL1VAa zaC(648o9%V%`@XK7y9FBaMwz^USC9iR!CTw| z25zePsECg*AcssmtZbsbh!1U|yLuXQNzM0Yn$P?zN<`!x40D6;`BVSZi%BYfXt%yR zQ&bt_IKCt*ZLx$ZVYy2;3L@u@U_w|0f*+&af^Ojy_3@fNVBtS0&X(M?uYW-mNuUDu z!CR!rLv@9}@QKC%Tm|utKuCz4xepcRIT|*?V2J1G7L!)p4I(Aq!9GK{=*VZK9|d2h zIzu4MwJ=_!%h@S4fjmyVL;{_EF{$tm(i3BoYUU_vbA%hItO?;dCLi5H72J~yrzv4j zbSTlex9aat=4?VDUKYFv=JjDO-J#k`i<}jZLiS1N zVkzCU!v9PKPCzh7>Alr|E2w!5{58SIGs%}v>e~`N4EjvSfp}UN!i3iyuZhi+Zp0y@ zxC%D+>3-AV|Jr-^hc<4dVfg*^>|dcc7G8;iM}8GR0=?Dgu+;&10DAj0M(~R>+CF!hXnDNAw8k589?N0Vl!zTOTO&8C za~yz;IepRr&S52g;H89M$#I!T1#t&w#6Is#;gPS%6~&Tl?SOl7(H)Z0x;8Q;IBq2eACEwP3_B;ncH zh^jFDlf20Rj7ScUq+3g2*i~pD)4(y85*C5YzjE8mYlhy9_v0=?+eP z^pG9A0(QuMwLRU=U?O}fB0*-0?2~a|8E7?MXThauF*Zd9GT3ivwXAhV?SX2I4pJ3z z&L`vu$Ku!aK}}@$&KbcOotim~Hi&VE#qRXri3dGu@99EXG($59nB7QQ%uS(urn+(C z^%))D7@WsA$P$WZn3@<9P9mY=wtsaeT8hgVJn(bIC z0FiUa&b*L6wE@s4eZ0pxG{Yqg&Ie}6j>mr3v7rM3My3&yg@ZW40@XR{w6m*zsPFC7 zcMg6e7O0ff^TuZV?S4ZYylSX7d%NH5)nBWveeD(dLcQE;G}P`(wfU;P_gy1GxV;8K z*kz%AkE~SyK<(0d{&lpKmwRcKrt+Xyf0TjW-AC zhgXdqZx@UIVGHotKd57dtsV8l-qyj^&UaKGI^ynaefR1>z1rP=(bywz-4&>vGO9QA zy@RdBz6W@GzxBdxRH?oXXqVIvTL-Up-yRr$p*MM;Y61R3Xx8J@XN8smB!p`mi&>c-Hdp<)`xYk-X!rID1n@Kf5~`tIG+s6~54OIC?gdDwX8-N$hR}Qe zfC#j`t#%rlfNy>8N44MB`+jQ^>EP`(-qg2%{OBXShjFa7c6V63td+6zfJ++RBM-dY z*~ZrHHU9f8w5Na*u#Eb5z->rOtKYqUAGV-!?4fMuN0bE;($4=8*l1V1uK&o6**^+< z0Gh^g+vN&iij+I+&v%gq&jFt;LJJTn+pT_7PANxWt{L^Iib7!ePst(Q>M<}2wv<&4@N)hpzxaL&B@fr* z!C2Ve5}NEv2|`C(wm}OiM}Z4}|6l$@xpV&eHB4Q&7k9^XOo{)wzP6f=|Nr>O`uzO& zJv!pF06Nshb>$=d6>yP^S!pZ`n9U}F;L?twZGYT4Wlel zn>%~^6jhSX1ltFl94+OUIfd!i+F4Ie53x}}-BGbuYSDq{)PX#4G+ZiwXtGL|p7-Db z@4Axhbk~kb30!CHFt6#C$56oDGnN(O8M+_w=JLqshoGLFT=pU=1J_dv4}?8mesq7o+1nUB5GabsK(Cc5po2aueREz{lh zvz<;S_aJWLQCYI#niBJW8LquyIW(iXu44~iSvL0JF(hn4UY%?zQi;mfc47i z<27{vR2-nnz8QDoE45((B#gs>`zj?L0 z^J5iVGXOn4sn^FWpZHg6*giw+x915&)ye;lc1I<{HU@I~DtKN0S0nU1k8)PMe=Oq; z*_m2ys}hEPI#F(Hcnn#Gap2C?S6{vP;RTa#9w~oOTnT}em)XUs26Kyg)u_Kv-?Ee~ ze-(TWOAk;j!ZM_J|KK2yEPS4Zv@0Kfg^b*w+~O9wE9{l5l7JwN`Rtj+I#xsQi+{~A7Ws|San ziB+SOe8N36JkD;}e?Fy#p|aW<>9;uXT<3qrOeXRDPRLtD@q+Pk*fQ?_v?Y$4f*fc^ zXEP_DH6qF7F|LujecsB&gE1?z?B^5OEf1?&VP6o5FoM22XL0+zKDvrvD!%F_7)Pfr z%NB81rM<*u4QI+aSPsVV>6+*1c$2_20x^2dEB!}9` z+UH&Lu<}uS#j*UESmXssmxttYsMF8giwksS(RqL*`*<$9t6kxZ#jLy<$zoP|H4#Fu z^LY=*`C{;~-y5_#%zwm!2lhENbI!l`f0Mx%@BioO)i zvUq&^u8DBcwHof@$B$*cWTp%qCNOAqqD@qoK zl?97~CFUHt(vcf7GSy`tyOKAJYD7Kr=C(DU*32!{Mf`{LiG(>gm7{SmX`7Sb zAtNI5v|0p{8qq0n*c_ZRbym(0tfOHtHy+--(`5ifkZ$kZrIRKiC4b}iw9Bz1a720N zwbX+GM6Qzf(-n47F>Y`mcM=#_tu{21WIxo>@XMdy-?Ko<|OF6_?{O%pc&}e0WPQ(E=-3%0+Ant$Y4hMboi1vcC zC^j|&2l9ORPJdJbC?9^4&S#_!UV~^MjPg&=WvS8Sv%No^?0_*C_?B|5JFsn6T&FdU|Zm) zl(Re_DSyT=o>OtFdZ}Z<^4ziRthH$JB|Qc}zX87cR<9H7>Qd?L#-&UpA^Ico98;8E z7&h1FvsTiiN@adh0eIK++`9SvFV;<5 zs*iYZI0srY&BC^)xpG0n9O1cD)Dt`V` z>nFT4LD4>wG?-Jw*k$Lqiwh6$4{!c?~6Sbl}1ouAK?lvmjH-!Bf#g^&`-F z^<<LKC-Mg_}20|Lo#L*1QYi0m~k7>0YAExJ{ zU}F5}=!pT8Bv#uzOLNldO?JA{raRVoP+Jpgkjwi;J+U7jK3KU-hIC`L+*Qrv_mA4Y zgxo{*1NkFraa*NtI2t2$6)9L~e#RycSpn-(sq(mtQ|xM)w=($m+S=Os*N^S*?j>NA zvi#Xtf4uQEx}`0zmY+WT`tjq{X@8lPr)5%z6*uO!wsQha@Mb_9)@T$_6wL#BGP&q= zNBAiT!YUik;*ZT9=zx$1|G>0y5yY@8h{&2k@Ie@|%}SSFZe3th#z5x{H7z$&P9&=q z*<3uaj$ub#9j+b`T33jZ!S{%AQ>aQaZ#`6pK(Qi1M>$n=9rS{|2XaNeg?O-4oaTWKa5 z;=rtuSrn-$vxhsqp~eb?V1G|niW^sXif0}vYLdjwB$+hPb|RuhWdszSjCopKWvdDy z0b(qJpN^=Hrp(mf0&%;|^eRGQyKqI^Dkd3KNazYlkX`O0VR_LDm8z9FkT=zNt@S6vV!J1 z3w@99^1Mxs)hLEEcP>H+0@~$!y8TaYf|xB0Gf|>7^xeD9v_Zmi2=4jN;?xerIDTF} z)fLlz^2yh$vhkfcT(R8ytd<81bVV74CZa_1Br9 zb**BSuU!m0^}K&}WbfxWDv}iw+2I3^Npwq%=_V?Y&XJ-_c^vE@kJ*UA%`8Wm5_^XD zdi4o_14QUM4aJnrd@I`fnK)`pY_nu!7Q}K_bZ%B!=~jC!38iQ#myYSk)etaEu?qyR zX3dq;O4ilQ7h8B#e0T3h17qD3o@PWVlYUGV_`P+|cx``x@It_;K*KluepKG6EgaC5Bw0ooT%O>Upo^(g|8>P>6n7Zzu^w zm9bmldBV$-O@fS31baQ4(BlsukST;-*^W7u0kjQ7R1mg&pdvrh>M`X5V*WJGXpAD5 zQr|d6rE7o3^;y>PwNiF%juwcxeKt^E5%7PCDv^n+a1AeO5S)8P>YHy=WA|loA$nDM zi2oS@7AbeVeiTu1ep$Y1B^RvPB^grjKS1KT>)&+jST1R)bC6m8vYto_;Q7t$f7HkE z|Hi@mJJf;Pd)@ONtE(IH^B?!{+l0PqnDQ__AAE=d z%o}=K4qB>pI;?tYs!~l2DM3(5KJ`bftEyT^)Hkf;z7*$$Z%Yd%=i%y+-lV`!@l|&e zRE*)4}mQVfeLQejk5If-ppSU6tvow*=Q-K?ygQOCi;cCi`E1^LW?i z1WR*j;-;K5r3oj88`UHFG#Y-AXc$6Ha#i>#Qo#acp|1kdh?aEWT|5A#|L$X|+UqD0X2m;!z zF$814W2=m5NzkE+NrA4R_iI1XYfGha{JAwOMWv4=4Ou30c7O$#PwgHc8KCzzpxq>7 znoVM)W)sI#vq}8KLu;<{{Ry7j{C|JhzjF;>+Wfz|Udhe>kJcZ}=l^?n=JWpzr|3G5 z5|W#@o~FeKL8Nd9Wq32nYu*==8GvLonva6K#GZBT#yM8z4m_Hd1T?L5Vl%POgg~H4 zW}2s|y`yJxgy?f0H3z+p?AUk0rAnFrA1x3{VRc2PKX3rFJBMAUyxA$ZXTpD~K&y*) z_lT>As12+hpjwyL9UN65RTi|0040guFjiT}stYMnOTbj-BV(qWOr!)+7p=Ch+FV$A zt3|V9ua-j7tS;SU!=F7{h3MvaaXxv^AN@GN zcsWn*Vgi`f|Lc#R{w zZONB#Kz`&8{m`Rh8MdK9&S@ymHdZL79Lr1+`7J1f*R}rlTyoW4qCyT=wH3v$`5_&R zz*1`XPv~W=*Yin6KV!zf+^pTCw{miJt2(BQ|FzXeneo52y8h(JeEi?TW4my9yW20& zzpjQMuf28$Lr<51Csu#X27~v>isuGi&|e_ zEhp+LDSzdwuA->gkk-ND3tyTDf8%G&__uoX_H|4f|BqH5=jQ+QNAvN2AJ4@3|2k9u zw7FkB8$bI$bEp4j-Us`rCd~Fx@f5G$%6=Gz&phwL;o1?~*)@MW9%z-|_qBying0J% zzqByAyy(Tjhj235AAQjrXe*qtrGK*u#h32In?KI@$5R8pLmf9*|80N{Fkk=O!;|a( zJCFW;Gy894Z7%=s<8k`my3FM+>zLO6>y>=}udmPJf8WO=lcW0oYIu^Myz1@Mceb~l zEBr8Q_0c6m;_83l7ml;*ZEmuC7rvaf+ulp-Ri8&&K2^&nc*)l?PMFKRxPLl2TgJo6 z@cqr!rg{i}ane1%fc!7F>)-8TeoFJ|d#1qFumGbsKOVdSobiiRTD~+L|E!NQ{*z(* z4>SL-tU*JT4=)QyJO-yiHu);p zeg1zdp(4iMH9%NUUlwETwu1g0gR*q4+9XLjg}N^iPUhdFr}ZebrNAt5 z@=1RaFFP_{M@{J4A&~B5jb;;TU)erhNQd!;mvk1-Q|b((AIXU=WETB9a~`ggt_;j6 zxDVOA<@_-?2KtcQM#d|fD7DAC-KX)W{jn2-WsZ0q2R_b?e&qY1MsW%7DwRrj(UX=2 zHC0+jO3$9r;jj;3WKMf23Sf+&+Vj}~?dg9Qx;RdV#&oouh%Kk-` z!e;3VhxF&joImTHSfRCWJOC=`;WWAqqT81s2Jm2^pjG1W#L+OoH+`;+u^We(n^%4r z@|{M068BEZ{?e%_4%&fT(HfR}gOBkrFbPb78vo5E0#;Z!B=Z(NItcVy=f|Cvx~hLF zKk%0j@2hah4}GFgSdbM#Nkr7>E$t1wSn$@KqDRj*H+M$9doG1FIn4a;;wseS;bXQBXbu z;sEuldW0UzkPR>~JaQOVaTWk3<|}_l!fGWMe`Z0Try&)&H|~q+1A5DnLTXz?SegLBkmJ)k4s* zM>Cb36qa4%$!4aKl`dLk%f^rwWAMhfc2i0_(xus9CT>ZaCSNW0yHRMC@~?kMrb$J* z#LCYuzFtF%-!c$S=Df+LtQ|Q0GnFvG;#aR4^%sj_De`~n`{iE--F|?xNjOW^gZkFC zn-zPM4_Z6O=PUu@%H+iL&{a&2?cwX=!9E?W$C-L=EBLEC+{O@$--PAGJ|EIF?=yA^f=kdnc-2dl3p85Pgpa19c|KERh{!fp3+oAsO z)@uE`JHTNAROt3kw{~S8;B)svTlv3(-x#je=9tVH9TUd%+>?m z&&isI42|H56o6wi{c{MjG{o7Jb><6gH$%GkS{>8LFZfeATCA+D($7`;xw^__C*9An z6fAkryn7XL>Isa^5xjr*1R$~R7o>`NtaJcRowX9YJUr+|7&)zr_ii*xA>H1B=Jjqu zho}4P7$IOV8*K)PEyq_Qiufk=bqgZGBA5h*>xL=1!mm+%5&gwnxG$2@$Ro0ld?J4c3J*-^A77rF#6uHt zk6+i!d$&e``8dX3_nV%fxB=BI?;UoJLQQdmlXSAhn-F*WQRmShPGVZQ>MqqN0$)#` zE@TLR*Brs^Z;b-79Y$T4Q5=?`&xiDx0wN=Hzu5*MGHSNZbS`AI2neou>9RMHkc5Vt z2-0v=7aIi`EDnFbJdAGI{qT)BKv&ttJ*TvO^Sv`D{@%-c=LVo9xIO59V5`3b#Khl- z=wYcdzzw#zBwI=dNz5>4AvST(0q){%T=!`P7zVKeiZKU!1KEZ`6sY=^87KhPLLiK; zo$C5R2>(EDWl(_xNI|>vkS|?Gy^TT(f{~wtH^ICMGn{|qGw4|1*%7P*kRCu|IRt68 z_3g8gL!opF>xyD+cH+Rl9Gxsb^+RiSGOZ(DzMzEVd0xAR*KwH0sR8^Kw@19eiu4At z)$fj)%>Z}hB6Bl)jT$7~KpS>;ywXw{o4k}l@EB_1bO|ual{Cc^tG5*JcbbfM$s{_U zx8T)k|NnoN-C^9sG{z0>^^A{(PczeJD_|#mJcJxaWhp2qir}4sp`~3Q*s(8!ws zOfYn@bAaFR5Vtw=3`sAWyZ>^xJnh|uTn^cM$ESZ_1K#3ZU6Qq1lAZXhQ6-Hauh*hB zxNX)&&{v9|8u)nm;xdtvYV|`Wt5C-()Xhy5`;q@0?MC}c+-@PNlx6WA(2Y^0gYwd7 zoBI@K%viFC&MH^j<%p{@J4BZK8y(b@5S2tH&P|TSnir^1L`FAKvM$kIzQyC<=JUGo zrQCnorK&(Y!Z!^woC7Ax;0%JmgrG~pJIB#^16mYT=ihbZZdht-aGQY4*4XCNi^Ht0 zNOsva9Viw=PDq#}TOK*JN15Vt(|}!q^;zzM`V^c%ku|&6=meTrvzr-aYad^8QN?4Z zGl?!PMGBLaN^JWw(hP<)JELO=Xm7i|^Id-pZ&Hobw`w6_*cEe=A72dicE7P_C(}L1 zl(dl8-^C4xqevSv=^upL_SW;g`reNzQ4G;gQZ#uJohM(W9<&94BbewojKUj|S8p zx3zBTtWEmT!WxAu39uOvvVhG4)U8ukV5WY&VMki^U%MY~-Vwv&>-B?+4i;E_lwky9EZ}{nAai299J91 zaW3t426;Yn_zTwP-F9lmQTlRC=Pm$RibJ)hai9_7ik({ku%q?5Bd6W+ewAJWWWa8E@Ehc1F(P4;g)Q* z(wF%eM*}ikWRvg?6!e+6A|qs{vc;rc$FyHCP1<$XO}%LIf_bBZ?qt72+P}0wbZ?X^ zk75$vOd%+cWcZif^Rb^X`+u?_dpC7VJ^#O+i~sg`V`F{3|9211e4}r^(Kp}d`|EG? z@s(ON%O)J=uECP)xyas;zTcr@&+{I=769@zhpKfP#R>KRzJJ9g6+IoblP~0EY zHjEl+(3(_#V%I;4uSRm)8Qo`}y3VtveF^QV*?TW1X#cftV#ViR?`-D}+Qy^x z-2D%a9<6T7_5XW#g2i+qzs?c>GtImNPy~J_O8^p>cd-PZ`QU%nO8_iomL)(j1+KdU zz%p*R1i&J0w*Dxb(F1?D?SWJy`NNa~Sw#Npzj8(E zN@dG6)@n3&p{MbcW41QdRx<+p@^h(t`ne>%#9_<~72QsI=HgAx8M$tI31a0E#xr?K z{9H2oOPr~MHv!N%yDD3Ctqz_%dGbu?2_vl8K5N0)>WSw?69uOfXxuJJAye`V>hmY% z6VmHXoZNq(9Y9AOH*CUZ>fMPpAR_ zq9f;e{IC=1?^!2E@JyXRJz!7O?O-GZ_*D+zCkuZ+I-%bE48=4<^3K#^B=wI}7$hQU zMtCE*^b*WksxxSQ91P#9R=a(P%W4r#gybq>hY9r7#W(5)DmeZqS<;0cR8T(b;!X{E zfKtCv_9eYIq;)@KlWi?iy)G_*?6`Kbl2%o~4%=mpyG>rmp3^)P^sd)3=pUzTXK8Ot zY~g>|&0B`$XB&ni3Fn3VcB|JKn(07hHxK2whaNYkJ4yT}1kIr-&_hy&Yk{bRh4BQT zo*jw>V$&*;8beREnNFbu zejJ~6SwOI~Vstc)&%|&g4##o7BfKNQ-J5^MgF&x3IBBvzkmZ!pK?(mIm5?_^Y>k2U zm-O|7zMhCt=0EBRU$cU}G^QfaA3-BNAf>gcNU>q5B`C&aZ?bXiedw-_MKb&J`~ zmBVy%08gftqjzD|iB*#HpADK!D~V?M#43cz>_8pQR7fy}RgZ=EysIr8Cr!U}#8omz zdCDsow$5|+l5GLIBShScCgoI?kvLX^9P+b&)ET2bi4;=GqK`0Vt%zK>gW*6T|BZuu zykWr#j}^l5p@$S!7@!aq)9lXFqOt%~4@H{VygKUBdSavTNT&w;mModrChYx3H8_Io zC_cxv8Kko&Zc+#kQUWJy$Y5BRTQ29WdB3vHQx!!WO$8m8eB_m2=o^+@%^>y6`%SNZ zmC_QCx$&@#`d=#cf3dXxl{TbaN5<3WnVHN$bX7WBQJ+F-88suPs)(7~nuUxm77#hh z8VS}Jhw%r>7)C0!rT<6ujWXl#tJ2ykRU-;3KQMn)t1wZHFsDWd2D*n@SP-(5rEulnt4qu^BK=e^V)G>T*82TOm_9SPe}D%il_4XYS-1 zbhGYg(<4MmP&qN9p{7HN;2e5TS?pkXTC$DpZk#a zu9-ueMimvugPMH@SSdQlDZ<#kh zm&WZRTJ{kGT&Zth$!fHJ1AucTKwDMd1mrBY(J4-z-DFk+Cs<0Vd6luqbQ0WZg%PTs z68&1X@`96p=2ESkS?V@E)~FUq zfrp0~ia4@sX;WO1nZd6yB>5Q)^URl>KZWO&p0^SRH@0Yjby-uBQp)Kkv3~xV7HS=sF#|&Jg0^OlLOYFD8M=K= z*56EpP`mu%iIBt*TP`elWJ#0Es*&J-X#9KYpz(sIXe+z}gEU>HE+I#;n}8fxN6)(p z$d>4{4jH*e$l6vDZKo8mt&D}xyz9ml+9AnMqG5}2PBwRcPRcpf_DRM{4eI0^W6sQ2 zP4x_A=Pb6Jjx~g`y@sru;cGPo|ErC5qDndcx0ndtBalm!DG62$#l} zmrQ#3XH@%|J&>HGU=3(v^6BM!W|7dc<~a5HJUpmC>QnbxDu9}@wYyFR=yb`PmXV#+ zl~%L5q^3=OvyZD%Xch5nIx0W)7ao+JSM-ANg;rrnJE$Y-zwPHGIcWK})~S%gu{Y|AAO z=;;H>P-0|__HDQPO1#`Ae@aPNWTyHd@AYedXV$lWoQyFwl;qI+GqYGp1&FX@A}pyr zkf$7lXP^lO;w^yUWAQ0==7+vG!wmw^H%o7HXwiu4zu%xi*RiIpZcO9SJh$354P4;L%$TUidw?k ze>9|qn*a&ZXDHcpfB;_jNsxvQP#%83`tY?kFa@HIfLu3qjmk)$w`wx!QW0z8R#m8MV_jc= zdVc+*KRNwRE_b^_^>14I_sWy}{V$K6tUa3RfA{drjKy|O!|1- zh;9ev3tWqDi2+sZV=43|U-epa(W?`FY|(yRhSIzOd;SUrJiwmfdzT{66eRxLMNY!v8^wUgJG#P z`Y8y?i(!QS{1ld=q5o4Q_-QTlBXco@L;T{eX>DV>#Jzh!M@W+{N=yRFbCY~Z90Rn@ z>yw*GLm?aEGNw;#b}_#>dg_uQIu_h9eSb(S{Avw8cZ~i<2;QQT|4Jt)8|Gf2+$%TC zy+pZ}ZkT(SaxdR7cR;y=oIZR#1!w#WJYClqEB~)ElTJ%ff8QAUZ@R?4155Cf_+M+4 z)k^OE?b`DSnT z`>hv^J$0xo`%h)iM!VX$ z24fR3yFOx4f2N8Wo!ttIE!jBht*rPf2F&MO{h$o&P_|19+~PvZThPFpvP~c{$EOhR z>f(*lj$Q!y%Mx!fUuR zwi%2pwuYL*+#ax6Ma|~gS-}glWQ%;Mz>jjcg_+iRf63*s_`OQ`==7S)7MSdlTecsM z5|^J=a*efGrj%|-49!6P5@@%{?7KUAn+>Wj_Zp3S|9I#%nzp-u2B){7!FM;KLAL!m zPr-V3dIK;JT)qK(sAU@d7_gbl(36{>1MtbD$l3`ExVR0<$S0?Pmi#d1YPx;C#*vg_ z5*nF-f65X=`jqObY5b=)AJvwE_D^d$&PCjH=P}HWbgCs!0;g%?IV>wka3OF5VS=A% zag~?f*B2v}F^z7p(mNUvo!Yii$$nL#!)|hDi|@P=&NOQ*dQZ1S7R)*>DG*v5e`MBS ztp16jn$V=xqek`5D$-Q27~WYI*i-%L+D3>Of6n71X`RMiwtI4d^mhGV_3@uq)J8;U zSf~RoVZM_lk=ID(pi;FNUU9e&x`0~+MFTllao|@%HG?SoYe{mv-tNyU%+sx%+D&vq zgB>gc9;i)I7_NI40^H0(d<;7IGHNN<6p8o88dcM^nLl*5>n$+q^cy8hDZfA;0EGtnnQ(*Ll2|1ddLT{dQQ^8ThX*!g&~1ubWX z8oeX^ZK-xxL>)>EP!n7!xpN!L|A^X#nF@NWh%9WI*tJNY!mqFm!ie{&@y zN)c8G_V~L_5zvMsX()C$H;RHv($(Ih;bnV7{b?6T!6Thgp&wOp(HbVP+c0y{mrD|6 z5h4qG;E)P^_K?GUK?C;8VI(GQdXq5xB?j`i<~%Kt4$@MpP~g%Cc?Hzx#Ih!yybA69 zsmYe!$}464=8fx(Kx(Dne=37fe^KWlpsAl;vb95H&`qEnW=y|tXyYeq`Q=?{*H_k+ zZLZ6#gkW)QZny57b_}v|WooNU!V{K{?e~G7LWonNxv{I@!gmp%?j@~kgiR*^yrjMl zQ;sf2uBGk8tz=xKPX81dol_@Z?fRRw`euzW1%%9tLyMM^Xwyt5MVCfye+Lv9ZYg2> z9D6--W$?(6jl{s%hML9vEgDRj3azyh8*1ATZrEU2V&vCLu6KB0<0JJG*JOC7$il?b zE7orEUh2Uh0oq|)kD`VzS%ysjeA(Rn7rPz?$(yCe;)xY)+DarT@8^!^VDSi$(sqk=-ByF^?)^I?}YMSb})Z| zK}<`CqH*ka0@toHf*Aoe_ApaSCCP+#J4Or_l}W~n?Ch7bHcXT0;(~0EexjM7u)f?a z_t&d%qCFs6Ap=WYnIdLIy10ycW4ZYip?~rx=l^Hi9byayUG5Gqf66DftYcdIpVcQ> z|Gza(zmpbDdH&}9e-G3R9Q`oU%#MB!2>ebQ{ji`rarDE2Ztv)arOe{!S4@HHI{IN5 zw{-NwB5vpChb3Ig(U04HSB`#I)?GRJVOh6v^y8Lg9sTfIp`#xrjCJ(G#EFi62r$vn z4*@1Q`sIwuB;JFMf57B%G`gBz9mYpC>NwYB5sEU%tiTyG5}S#5jpW(W>%SR>+ut!e++;U~^wW3QSE7e>WuE zSE^AuZ!FNQtA`PAp>n$vUwY!2KX>ws*Z(M>!d<9;Q{(?^e>}>?|9SEVbi%p*_xnF{ z{co=S&Go;(zW$f<9TP`}NafErpzqjNU6ATR$BE%3jDpmEk0SO!r(h||Sc>N!>B!eo zQ{|Uf?6e7U-S5^4}K52)h?Mg{j#4P^089zekRWxf9Iid@*a_$vPZDE=|;aq@4YNl zAgB6eu>yL5T2fv50S~)0O*&RZ%{3jR3(F5rcXWO)a3WPDbh<@Q2H$_x*xpu$boMhj zLuY>q$)2mOrhY2D!vRKXa3lX0?VW(SyKF+0V_bH-;#93B9aGw?jRtF4yr9z-#4nV8kPscayH>xpjfCZ zRAxnlaG>s_F;ezJBgI_K*S%`QyLC=-MwYiHDLOqWhc_qjJHol&MUH>(jdQOgr^>R( zeK^{0SczzriQ#wNhhDoY{1EYV0P~O zK7=mLe$2{aeMt4e6joF|tvHAWKf(e?)^oTdKn+?;a&5T!9-977Db(kc2KHe4ayZ0W zU%P$KDSCL%i_QpT>%2J>fr>s;!9Dqke^SfbPFAewk;|WPc07sE|BhfSZ@%|fXMKroCC_&)yhX%TM< zZVgW_@rKzXEf#yAiP6=Nrn_ z9&GLI)chazwhkKbzJE|Zc)MTo-|qZtXZMF48U3`T1RlU4k99|=14f!lv;Y7exjB>Y zRVo3qlN(k&f8!(|Xmo)9a<)Hqg0LL-+k;LVg!I_zENbds+En+uJmc-Z66os=EWlIt z|JU%YpX~mB)t7T^Le;@J9>b+tXX(#+{M4L*vmfZZWS8W8&84WuLG5g=~eKJLlFyZoP{Rn$Bk| zlnNN_CcOW4XDlB^?6Fbv_gW8NIK1|wivehz1W_ua{L0PENXEQby-5ANDE7I4P zKvDW0lOS1G9M=>Zwm{)t2u{v{ToLqs?P~$m4IHC}@d0%2Ym<~&Ab;0jmLD+x@5(I( z?&jPQtm(zs@3AJZ>Zyb-FP51Zi)EsV;4PULs-8t5D_lAV%T8lcBF~U(V?PeN_AttR zTMH$~ZUNhk4>qHDFCW|F#-dA6MK@>3>Dm|~I};!UmZsn{vw~yOtzj_%7M2)R0G=6D z$m>eotV1^N!~hmIt$$-aDhl8df1~PhcoBQ!usHpUPUIfxUofAoYCg-XJ2Si$M*i^F z7cHKxE|?wi+qYKC)NRCyGs07h6B7E=g&a1VurHnq{9tPx7v-6H0A2G%t<)%aR-f8E z3~w|zp)h!<&!O!}mCjoD_<%G8pXra}OaYFCa>fN$+Mo%!;(royvcDdk`^Bc9CmW&F z?H6O_;FU+An1bu8!PeSp^zRS}nRY;>sz;I1#}{M}>V~AS-4I(uL$4b;?V8xK7hTZf z(T0*tCb-?KX#}_1tNosZ_%f1WCD(qM!93pcR%|{3U#U9rw;p`8`}z&;VAQv_8{6u| zu6nb#^?m)I0e?iW$(G6(Q;iP$7&=pf&X?lNRe)5rtKqU^-5lqpR(EL2;-_G2JCVRV zWmaX^Q;VEl%4kED@r$GP80C7RYCR!V*R3Y5F>2Hu&0J%2sr<|}0kCN1nhc(qxh5)f zH<`Jn!*y?@Cpud_Q>VBusZ}}(WjdQq)hlm4@sgtFe}9}h_l_}9r_?GpWdk8nFoY04L#119|DFZ?{IUwMSLpAfRr2^HqIME)8`$kjm_^=$#owV#X+k?ygC@X_WTt*b%H~P@(P2D@h zGV}p2n1ADAHr>&DPesvYJl++qg_t+->V=$Sqe7g!XC{bDLVKoSp=msJXA^`A?*ytuu`+ZA`+Fd#a3?-`#I~pq^iLdmRb9Y!VXU3-qJFGdE%oliQXt zbRYY+XRTrj?mfWDx(FDCEZ_W#AK^EQUcbu49)FIG4p)!VZz9uBQ5coc9cq-IlSNQ6 zvqDM224-r%yShi}0dTzxfKp*)=>WNHjp?Avgt{FUF*y=FN2t&q^gpnhK@)!lB{xfn z#fG&GgzQ!nY=4Or6+0*@Z{yeGgj#B*D-ETz_^KUWjMUaHtvz%uj)qM$tY3h3_DexKx1AQchb`DC6aj5rxX_fl?TRI%Bp83``Ue?a!dS|EWJ}T{);deePbov`-D%c5d8&siEOSYbwaYiOtl=&@f$&C?U{bsj;GlGfqIMKqH+F z+#3%^wo#)dMhyngV?r;;p_ud51>PzUaZ!~ct~LnW94Pv`(Jv_car?&)Zo^3`r)`C@PptcK%1G1DPZNNvVS&gd1ej2)sHZyY05Ba{qA*O602?BqwTj7obk zE1Dd!a0AY~8*yQcZyeq@sZjFyd;E#Z51Zk`s7L@X`->RJv-UoP!r0m^>mQ~!s3ul+ zOA8C@ou7W{!(U>@C=4xL%0=IWnGbrXjrUVoC0vU&aj0=u z0_5ssfh8zIDTm#oOywuNOFm>skK8OIgBAn?-D=^|!e!POL<0&umJT0N>0qJBm8M4m z$5%F^I8BE~0gsi&Gjl02R4l#i(~^8N5MS5QQl=7GRp1xaZD{%^IX?Z%r+;z3eDSFi zl|DkpPSG?~VChOX*Sjj9cUjXC#?1DtbDZtL`FX34GP2}T43dRJeTyco-1*e>&}^@j zjG7YK#4ma6kC@#$%PC*rUy-wZGHmW3C1Rr>E3{IELFlq&8=wv*Q{#9@PtN1;`oP83R@^dXa)KzBE>>o4VX8k{fk`y|i<_P6hHdZXpP1@)wg-doaXvUe}O_Q?HV~fqXDt@kZDB>nRF_`u=`n?_f+nf2&r* z+?W(S)3OVTzYX1ZT-Z<3FU+3z((m6(A8*u?O<`aJz?%0Lld)kNe}aLGfo@g~8s`@= z1LRB`#QBOj$Qu7o^9SrHekq#(X6Cj?y^qkv1gb}irs`GTzqJA$yyH{K_r}}21Q4>| zd2>JTBWy7KEy4oTmW}A&VboaLC|4du^-37}^y|BVRfS z&HVXNPcHrw4M~ude<$73^2Mh+sbfm~$49G=viCn$9zR~6$A7wy=i!5*b_4GBgsl(sf2Sf3M5)IyN_6YKWUp?j06A=e>oKaA0BzxWSb(x_@dWp$3ZE( z;3-A&shNHX3kndIkeY8bNE4JVI8U*%yi-brXr}-~RP^j~h-Fm_6qk?2r^&)6gN$r< zB06hnZITfOK`97JM};Uc(BT?({Sb=3JPwAXpTbf!^rO&^OtMv@e1ow8_2sFUD;oh- zz5~1oe+UGJt>w@4<^Ne-{<`_o@=r^PD@RL&Q|YHlsQ@dxkQi1l!59cVbfqJ7qOg-r z9bI1Z%pP)fRLl4Ui5BUb9*l#nh=Up=LeF;0X163S`ioCjCxe)aVp*rM(sBP^Lim zN&$b|&me>PR5d&w2Hg%SbR$r}B?coJC>Je_>{l`OQEGbWPNepmTYEqJ`)$Y|DDwES ze{#I>Lw-?JVfYNvfAfAr1-KKR;Qajj?aTeG|7oboALYWd2Pg611Z}&f!3Y3V1a__ve^=F@(#ujZz}F@;i_T&yrUuhXQ%DGQlA+g^8~BJv`@w&SlREZToh=p}NVS*=`==-b4Qs-C(zN4jOwe>zfT41p9BF z@9n-l*xG4Gyw_ARKi}GU5o|`ZIb3ptxLJkeE8y?wlv>|}dV=@xy|&rJ4`GB=?;Pm6 zUX35;A{U3J$WwH@EP5osjWE$df5$-*L4F_HX3WM|&DbCksgoOoAb;ov;g^)5@K7}K z;CzYkC7zu8AH}d@zN3vFc~BlcdGctS{9j*v^dzVMujAjlL}J|YH<$nO{h#^%&wT&q z@4Np);o5ljM@*pf;(0XsYxYaoT+i!w+c07Kq4iys4gJgWW~+B`)(ST4K-ANCa2}6_ zpEw;vN$@E2uISiwsn_CbN%lgp6?rb`*`d0T6wj+HXq*eXa3Be`SZ7V N{vXcKmx}-}0st5!bc+B0 delta 25400 zcmV((K;Xan&;gLp0e>Hh2mp`ja9#id>|A?u+cviE-}n?**R!@dvTXU0Y?JBCI*Hx- zP7-HgXFI)ZCj*g?goYxu0BJ={^4;%w03=9Bw%cjCbMLLDX)F>rI5^MWIe>Ha-{%*X z`(J$4&jEZMo}A#{!-ppa@!#R|#qj9C(ed!X$>H$f7YD=P$$#;|7xLuuvc;dumC8!_ zg-i5I&D6$mcfJ2#`Z**04<@EGlf1C{bF6_1esFxeQUAxsr2oUClj8@&gG12&(a9m` z|KM{l)BXHE*MBunRjCJVDqbziX_4>iU&p2x%$MRaQM1f{on_*Qa#Q~e1`l$R|DxWe zdhWu{Suqh4oquZ!^iqB%GBetTKRm7d^{ugUcr;V*^dKqnv6%>Gll_a=ugs3{nEPnA7{E*O3w#w=6 zQcaxrPwVG%f7t&?xu0!~d&d9B{|}E39{v^o|BO$h|9=7aSh@TRYupw8SM`5%a&-Jx z{QomPk^Vz)|HId~UH`*_qv3;&{*MnH{FVRzl+Txc+aH;He*^{~z7$_dG6LzQI?H5I z%peb^a$(9Tewk;wG(`^M1ewj-*O!;q-)!&7B$eB{sj<15X}Pui;mPUMcWJV8S8EvMr7a+h9o?W~?dwPBO`iFWrF^WiCpx{ve)0V5 zll=K-cvnt!E*g!{dkOZUld`Z&nHME8@<^8OWv8vBoh_PZby?Y54&lq#h{SdBN7bM73^LjbC>-YOVSP=Wke-Xh%%n!3spxTX?8H9cJ#U1Sz{}h}qrW z{xIzKKXnz;HROm0ILy}e;l>FEb$qH*8>Nlyf6BlAy&lx!aE(YHhukfawWdbwk$<7d zn7_<*HomoyopyZPv|S*$x3@`{cad&HgURx@iN@VWH1{@_b@s9;Zg$5WwxqOuv_6W$ zCea(#tW$?@AL5Q+z{)I8CCPtHaEN{C%e}q5NLEC|iz!h~V-hmCq}8^-9JhL2jc#hj zrT@8cM+R8@^zmcC(=f*0GA(SfJAZ9*`?Sf1X(2k@u_SAK9f2mm-9{pYd22ZEsidZ` zn#9&GyJ21%SG8w;)g4=BUm62e;#49C^{%A`HXxri2pvZGZy~^E1%OGJR2J8Jdimnj z>$6wSfB1%SAw2yCd>Nm<{r>Xxv#THJ$EW!7&lJ<=R^MzKvNvo79c~_Vh<~FRpUKyS zq?HIAhaM6K*)xox#o)CGAqk}M5sddEm{gEuYok!1U+&44+?e0TNS7a5nq9k>yBGf> ztR{ebzrO}q}r?ESf^8t4J>5o*;e^?=0QusaukU5uikmHmm{?B*o|M(C0|DInw zJ$rd|_Lh^cyfI5SO4$N_yk}3_T?M-?b*w-*Qd|rtA967z#ybIirClx zrL9ARdDxf#RpnX^zy2DlkEg|aY0YF>%H5|uc=(U6`}9hlTdn0)F)kO%YI$B%d8!bg z^yNjK4EjQz;24#^%K)EVl`y*O%X7eKQ+b{hh3(5Hg)4FVi&J@UI2<1A4UZ0n^3Bz$ zkY^B3mIZKOoSbVrGk;|XL9i@j0_;d^T&BjA){H6$5Ey)5=^4JnV?tSs0ad`v%p@AZ zlT3?*aDHFHc$rL9J~8=3ni9!V!zjy&g-!<|638p7)oheep17XsK+MT;VdV^1mo97` z|D@WPNzP1`>K!~>sHI#MfXc?O_q3Sd8#kr#z&~*T`zr@hK7UyP>v?IF0~P@fvBv1U zHIuKZ5iBj9`@I0iCNFiK@=}vZfs9K~1ui9TTMFNa!1LZ748em|=_(k8i`LtLC2%Zl z6eI&YI$1d|j{!=;IMHTJ2G-Pko`L*vagqG={R{A_?ZS8&SGNK zOfIIFR#a6^3xDgVYYkc}3sE`NAh5K1Rm`-Xw#g`4n@b9?7!coRDT1({YX=*Y8#ZQg zS8A0GdQ$#SRDcFC=--umc4a1sT%!0Bq#~ z0|M~+>!VeQxrOy%gO}AN&fJRW#VS=L8ikmu8&+^+9DkAbu+yyYCwIN+*a=yJAddne z-N4ca^ntWo7&q

!n~Xi8eP#q_PQ;PC+r21cunplp;(7n}x5@R2<_CwPlPj9c)hm zj|p>$L~@zy1@jx^{+Mkjkb9RGi<)j)AWesqLC%h}b6w!nQYR&Q4#hY}TFG@JORG^* zRD3%o4}ZcKnN)zSVt_(n>YO~?FT#|NakOanj$ak16^njrX@fj!Ag*~%YZdTlm#LD7 zC)$<@HVh-?@Y0M-MwcPTJCQO=RIJr#EXh7{NPLZrrcJ>vQ_b08tqg;uCBik=W|{Z^1FIty%w4W7I)7`!()K?2ty4_9co z0H^ZQ)vDlVninwNViH=?lC-;4t^q|{j8{?&F>fdg!}FQORj@82*5=A#)r06@p@okY zF18?G*Q*SeSp?%C0}5FkS1dp!CRbS>)_>qFVU7VoKxUs&Dz!ygCCmop5Y#SMClY|r zoT2Jb3lS~h)6otLm{%nw7&e!4e4Q=(v`8GDkfm}8hypSBRHpGq1TBMH(~PB+?cdNreraqK*EdEaDS$c z?L!T=nUJ?p9-1~};BQDn8gTS-;DaXE1eyz|nT&@dK2s@T8JT2Sc@9AYenaejqZ&e` zY?|J*c0Ag^C=ZWO?)5lD&}Cx>B5GaVf2^^`Y>IB3>3{ZJJz8J9Fw_Y)STL7RnNUkpkwAAcVUVn)8fZS8y z1Ebuct&9}AGp!t`iJ68(C$*t1M{ke@(gjw{4X6wZjHod4&4x3zc*IU^h!@y7EX!lP z*t|WrC`&wgLpvZe(HEY9x{SabV1SQp#)X($C+8G{2kxIVCNgl&N=;B?yWc@*gh((3 z5%=o}xFCV|B&!g-;}S)M#(xfw*1yh0(2U%QSKmVDd4{pvy9UKLm8MoxoW#aHB#$jH z=~IaBH;fPpFIPlXn;fIHNkWr|JR5|}*5S?JF~?YfWmV}6`8=dhpdL&`VYnO%TjeXF z_fa`O9i8?)WFu-2Nck2+G(|*Uy~q)7k7+^FEhPbpqo$;kC|3+kgnyNHAr9&}Vy~R4 z5(rty+(-jJr^p5ST*Gm1AiigWBWokG72<8A<#3gdcZUC@A(acR!6_v|)b%;3>%)xfy$s8RWG7O$6 zDGD>hWIReVp5`Nu-+x4sDKi790MjA$KbG&bo}){k1$cNTc$y0-3jq+8$E`@nl^1@bdMe5T#bWLw4DPwcM-c$StouGx=6?Y-ljR&Xmg4~)QRH3O z^#&6nrjKlbBO8pUC^62M-HoBR?~^IpX^b=}w6_DH5AbqLD!KBT8wxc7zg=UOU>bn9 zXIit7@GhK=68R%e%c|E@0g0*{mk>2*#9lSU`~+l6f`vW$ODkw{M8jcRC7%vOCdr#) z4pRsb2ye;U6pi z0=;612F)YfU5v2`YC$T95z4QkPzu4GF-4I#8k^Qs(111}fsp$B`A9Ed_geHJ(dS@S z1T66enhQ4yxjkhSrXh$ke)AA$A;3mOA&U}ilwM+^7JpM}h{EU*XnHg~B1kCF&@#NZwr-*=mu(|lzMNkU` zOg|v7+CID&Fdy}VUemFl?izV~gzMSjgS1IqM4{_2K8@-u3;7GlNvd`Wd1LgV6BCI_ zgYb6G-hU^W!qp>8u&tC`I-QL}&oSr#cq0;+>nNqymcYX2HbLGJd7pz=D*}bxtRe)u zrI9x3><}CDMBO)`p)+nOP*2V$liFNq$;LaV7!?Mg0K8XF21=)Wo3=hIvF35^Sz(XF| z$37NytDAk|{eYT%@}y2YqJD>Rou#qoT$S|%(Xly)cYSNJFqo7@cMv`ZEkLA)-<7;6lf4imEu-6!dUp$5 z?y-X8TpG~NVGmPOG5Q62Dxn7s+DodE;tc|_HR)Ge1&OlLMJ$5S>fvzwy47T3I@%X{rjs zM-&j2eUHaIfXeYSiyP26pXU)S@&{a@K)~duZGhTdaIwAiDG9Uei9%Q6QHt&=r=GdEW*|>G5Iv`wA!eEz za<%L8>Vj71CBu2l3SaOX7OAjQGELC}gDlW@w8p6+PPckDT9ngRDcN7Q?K!anfiqgzzi&!(CIGk5IKGa zW~?)YCJw`R&+kw`e~z+Tv$~}#0lHC-2?K9?|5zx2RI8kD3-MepB|K_Z-b1O++?F0B z`SA)`h^QmPiaY>MYkZrG3?29r{5v-Fl?+11${$6OHBgt@quMY_B3y^ij9hjItXN-w z+XP057`&(m=R2_uR<@!f9#SAat|rqcwi|z9&OOfA9BQWMe_BaIq|+^mgh7zuxPc64 zMBE1AW(`z-)Iw+Y8iSS=ln`vFXuSIU9NV~5KKV=^qIrZ=@GukGOZeOJr67p2ATU^L zTz>QF7(Ve>iA|7>id2PJp!B&6lZZh*wvIj5uqA3Y4Dv+;O=m)NY~_v>2_u}clXfvd z1b`NG1nc9se{gZZ*yi$0%@}zOX$h+v48?%~CAEK$ zeDekiUKNTmOJ{UbGcqMN>NB;d5ATcm*Wfz)VLFgoe+oRB9xeG?jJg#qeBEi?@A~%Q z#uj^zTRV8(nABFo>nq>VZRxlq{EDa4*l!G%jDE|x9&=o?FFHc(R5<>o!-D~zqLgN) zJwCY&>EE&AGQQK$aUgH}SRn^*3=vI)b7cR9FN&}ew>yc^`F`LFyqiK%iKp3m!&zv! zLE*!be}Tl{`40k>+MeVus4z%^!WRCY zpq?5J^an~&G^TxY3bKa-c`@d^PTdr6(fV8fa{v_Wzf|djI(dvyqT-Z~oCN?;OgK6W z8hd?)(*tbR$Xz~co*93+&>vTWyH?uu`XaJIf5O5fM=}Joon3$Z1vkZ90q`S00@ZR@ zxQW!gkf!mXAGk^BfquP2$4B~n*v7t$=>l7yxNe;pH_zo87ykMaPLDhKg$LsfFYSPN zIWwy=a8u1kMSOe#Ib`BtWfS#9d}tHh)zhF$YQ9I)eCA(KA|mf#m>Yc0pZc#}Oj1F+ zfA!^=qRJS@@g-4dizQSE%RRbL5IJ`Q6T&JG{228XbPK1bkJtPG3;#-Sw&bRL{SB%} z0u`_i-XcXFsw@13Pc#PLDu{OkLPG4!eW*Ck(XbH)Lp)Enn6&C{5GnZ<_8G!OM?Ne4 zDEM)zGX&CH3*$w)oSjk=$m7&YB+wa?e+qvgJux<^W{#pZN4Sy7nh>sI^3gq1!9B@v zni2*@hZ3E8tN#9E&L$+{W%2ys zJfm)1xToh^b=)^F<9@$j9x)@fTVcF=j0e!x^8yNQ0Z6SWmI^w=kRff4Ze& z#{B)dy($cvK1LEw@pHbM5v+es4S5uplrKn+x`6S`jU4_ro4~C(>iA{qN_>F__?Au} z@p9h^OF9+7+9`DTl7ucJ`gmUC-0yZ2IO$eP5|wNUz!FV*?0cxyyguxuJ5>8=k+T9) z$UZ4uETx-P_|H_}1O$VW-dnwbf1208UlWWxlYIH4zAfRypwEOHh^K`iOnBY#n%GR~ zMjSGVt6+1V?l&!bjW_}^=o@x`kzUPKoK;=95}q;3{bLYL*1BDaeShb*6R?bn?oQz0 zLAV-9Ws$|0M z8i&uPbbQ|0Vszu>f7*N3hBk6!VfgvF{VNn_*zShLU?9niGoJT2#F_9cfgB){okJMM zu^aHj*t~9&kj&2c?N8mLmb%*)E+KPq?@n;HN>Zs*DwRs55=?8n5$CZSHcg4xF|##t zvpUBC*qGBN9pDUB0$xf8f0i513iUq3lL4t)VWV6s3zenz6NmMrt~@%%`qCtv$r_{-8!`Fw`ysPF1>t zQy)EK2d{t~a&1qye>0c}pNdG3*&_R799RZg&DU9QXTBCzh zg`D#VIl{5{wS7<%*}Zc{a7L$QPNNNC9AdFMJ$T|lkJ@{>kQU9*Oaf*%(iU@5D4(fr z+<1LV2RH_2F%GhXA{wS9#>DtL%OMS%!-(!=!hn$nEZ<3Se?f=wlR>LTqnpOw@PlSM z)(Sx6T(C1QT0b$G!RswY9IkVxOvKdyR(LeWo^_*Y|#GL%Famt(_mKKy<|2+xqeOfqK5X{j{-1-nuJLJ7rWa z>w5=VjeQUB_-X5@+o)1~AJ8tT*INhAcV8VCVP{Pjc0niCr26!Iq5@|H7E*+48^1T<0J)qytLH)_r z_7+r$p2N?!4tAgl@-MD4=9{m!>(Gc-doOqQ8)(5n5<($B@V%}5f2sPuCxrd)S9Mbm zP#4O0e^KArq>jpTBsN$5y!#3#4rurGQv~od01~R9o;IE}HV?Lbg6;)KsAm7wi-yp9 z|9}Xzy{&c{n}Bb9?`O5&*!yW~6Y1dXHD1=Yfc)qqy@zqEwsv<|ysVY6^MFelKOqmi z+S$g|?lu1V6||>-6R?c>kHBq6Osn6$*IQ6IfA&ze^CQXv32Ep53~aQkUeteP$Lybl zJpfJPx$SZVFh$Cp^(VVXgC~H`7NG@*AVIK;p4MN~e{AeWo?!y2TAaxvwg0lQxrIL< z9asNqv*e1VK2f5DMZzwJF#iVhtg#@29eixG><^t*>M@9b!Yew`C@x_ADIm* ze>tct!WjNOX(04oV+ZI(!>PWx`Dzb_7D8YSz-Ipy47RNu>J$&#OQU&f@2MV7L}&G^ zzP0^oFUMn0^DdAOizHq%9io|RKa7Y6)YdboYV*1Do^nR*&+0jJ#ghhr)t~;fg_4Ks z@n9_MZwXCyr39g)E!&`ll%v3f|1W={f1J;MzkoRlH{rfa9aG|euCJ|bWaEEU9#!V& zzwhF?uOtd0d201j3$>^LBi3KHR(4^%^KRI}m6L~=+%w;6tE=CsdLIKdep36JjTbP= zBDJ}*w@*b^z;xL71SLSd!-f~h)x~I6Gy|Pf+nkUf9ZJ- zKJcz9*-m%usFc8U<_`0ket8T9>^);yF`lCP5pOP!jD85}+3`g$qB3yprIipAmRb>c zY)*>Eo+cThd*s@vT~A?6fJJ2W383x_>coCbDulikL3PAE@>!PRjTX?=BW=^V9zKzsyfQ;XX)lO^pZqV;bOfv#ludF^? zQwKoB0jlhqaVNf18y0|wsQ>B?lh#?gjFHbry(BIl4?RzO7&KFwcRT*NQ&)cZe0S&P zD!OI>dVEr^k6AwPuhy`Aiq>z>6Nsvl{~zs+N``F=C^$&ylk&0ZlOpRq50OS?L9uK@V{FRx?$kssFoxI4d89oLBe|KQ<+ ze|h}>yLjyW|56tKTqFMfqsrP`|G$fe`(Fh27pmjx;~$i)_4)X}i^u8zFC+l2KK?f< z8}s`g?&RVA-vbr(MWZ}SMqi?i$^F0fpzoOrHtVGuv`n92(#F!cY{9mO__f&)h;G(O$?8IlY>~G#DDHzmlti6X?aG6BFX7 zN_C|tV>sdpAy(#N9?&h_He))HL+xbk^Uix%`6#}BO(Rp=6UkYbgJbrlFL^$bM4fpZm$1-0sQ-%%`7_>UkrY%7w z0(R1Wzd)E3ZKGU45Xhl0%l`m>y5OJTOSvD92m+dcA(y(Xp4GA~Ik;<_6+em_JF{=g zuy`8QkbC^>`~ruUc&15Q2jHebFK%DR$T4pmCjbx7yyFv9=L0+(&F9qgabmUpR3$)L z?7f#mKJ{z456a;4md8Gxw@GoT$e9Oq28)A#CFUHt(vcf7GSx*NyOK1+j=;N+h#+s@es5azL-TtC`F{bZEi|-F=?yZKmOaP! z+C?Zxdo$&$w{Jt-&PdX^`t4gQ5o<_^YqJB+6&iJ#k>BZPkqO$VNgj%7A*bWe1Bf^b zy*S00FZQx9FnL0r-BxH?*JyizlJ7WhA$1uVL_EfK|oDq8NCsq zExY36J}gj#G=J=;2+!|P-S72)pe$NC>;0j37u_D7T=Aa3kB)ZnnIywKZ)fl^QYS!0 z63Q&Tc&;7}$mc#4!UL*64y)>^l5m?Sgz0`(n$6$71za4NXiIYTM;g(NqZYiBLyX05 z-*OC%Ru<@39AMMUK+y@}{)g^x&_|DGFG!1GV>56d&wrP1MKyr(;Wz1gM(W^gh!(;q z{{&r@8eKkqEb*TJ2OZZ9bsFzgqWd7L%}$(9x43Yl`=t5->eI^S?xCy62+-9Vy|x?5 zPHsFS`RLW<;BE#V)FkY7rD~U@WJ4#XZz{b21zEI->>LaSDD6Qay?r|z;2=p<`Cxbv zm-XQ%;eUHPm#8;((U*Ee%Ln0NycY!huK8#X#=o$)^3t}K3()B%Ic)amDgkCLx&klt zv=%@M8>oa)FDl&JlZF4FC=C_Ojk{O|N^QnXLcE;88sPkbBmdzE74f@e@A0(gB*q{c zIIFUbN8?_PXRC}NgiZt@#3eW;j4}KTKWpJ?L7DSc<2b;ro6rAZ-NdE(hzEyrpf%GhYLn`96wcI~TTxFM@>#il%u5p#?K4S(S;pvWLv7qsRDe4)bRk|b zFxHmWPy$B>F0A3onUFmTGNl|m6+Kix0)7Vpr~quw_r`W1R=J zHL(WCOki9{!~ns^!x_ZYfF-iz83k`4C0xKbP)URU1yYkOO`hmBLpmI%O%t%nD1V7# zM@gys>gC0VPE7N`hIh%JcR?p9MyKvSc~2;AM&&)+%YE)0bHb>*?H{+AYSyg|F(sIwR1W z^7gIwE{4vI6U{tj($qa~8?OROw0{YO9NYRB23QU|AtMm;=W27!41q;p3*aRXg zU|lLz9+q*6T`ltl4gX$STU-C`q5a*x1guh)KO5^0H@-u+wB^ zGAYE08}mZjIe{j4GawFYG>RyS=7Bw#ocFpT{FDS?l?`a|$7T<7K*)oCVA?njVptYL zWKALXAPm`NrOPk3&M_)up!0^BmYXRjl2warE}mG&u%j*ySC0s-OT@|GdqlY@RHd1> z?yEzf^=brk;D3$^YGJ#bu78H#u%6)ZuyO=Fc(_LYt{;U{YBiHFR2!^fjk;Iy*J>E4 zKzBrB`oSbEk4rN+@6)O#qoR6pt9aRHcO~M+k|Ail!{@=Nh34F`lQ*wDVOPfeK({l@ zgGztkpM0XGBK#?Qb7jTAFq^ z{341`oL;Bc)LDqEEW#`QA_5>is5CTRnKcFlm-P&!EqI9H=z>U?(+|_BG{1{P_iWq9 zYi$YPQ9*Ka+CANH$lvnhM6eQ8v6F_XWAg)IRy87 zXmM%>VjMp&pXiEdKl%8(RoVE?9IjaIeOAi@2D+q-^qTt#qrsmV{C?luO5S zI=)VS4ph8D&>3h23X;hs1U`0;RcZM{i2~w516sqA4^>%aThQojLSHpZ zc^ID!KEwg$4LvRgE!8?5R=qV%U zQsAffvO5YY#_(+%AIN=Ca#V1J|9FaelM4iT!4V=-S}8GqD!DQ;@KwlQ6j5W#r+#-K zsmDC18z?eQQH=7vdxY;bfk3S_r7$Utc%XHOSf@`m!gd5DIkZMPh z{cpc}yz6s}r8zZmQ;wU`gyX}F>Jfb!4L`|pme$olsZ{D5`U{DFq+42ENZ{i_z?mcd zBh=(?XNRHCtRH=bZ@+IAW82|ld<*D6&DMjTWSuW1b zp&@hx0qxcpf-&H+RmQX==upL^K-bXwwV&y=rBXTm+!~gm(#Mj9ER#7qzyi#tb`OvY z(0d!uZW1!hCNWa8iQ}o+B!1$dHP`w61W!8uU-Z9!lm;+u{$E|MWaj^etLy9Y`Ts7S z`TT#)DZ0*sh2-Xqr)hCQ5Gfo&8QzTYn)k(I1|S)Y=A$4lv1gsTagLR_1CQn<0Zl8N z*i0-mArNSindWI~@93EvA^O}$%|WjtJNBJ$sgfqZM+<~fSY6TS_Z$H2&S4iSZ*~gq znXoE<(CXsdJ>n`NY6GhWsMh6m2S-&%l?AOLKuMxEj8zu0>OzXt5-^qd$e3v-6DdK| zMXT+rHW!v&X$dXatEJF1t4nv;@Mq6fA-Z{9oKN2KM?XCO^D(49PW+FxM~@!O?LT+% zIQ{|8O^t)Bilr@yjjNF|GgC*4DCr_P@1959j@V7mxN6PM!GVG0xnJ!NU#I zA?U(*`^iBV_rC&&wbhMp38s~dnl@k#=4(^r@AdHbKk1H^M}t8x`64R7)#v~9jR*7i zUw86k`ybsf;N>j2#R*_q|F1uMl-vJ#IJf`Y$y0EmB{ld&uxeD^-tO)Jnjyy8dwjHi z_rU*s&$d`#wk2P}0r`j&|6M$` z3zxUM{S^J{Y8dj`Yj-g8bQxG<<#aHAc%Q6zo-s6~vxGVyB%@`1_sCTjV?Hm_4U+Iz zsc*Wd_4UdsrMW7_zCu=+4N|37>%AOCmq zOq~C(GWAcJ`_<#|v;Sjv`hVjb}wH4NskMBxjL@p|F=3{|J}ut z_WzfP{(i0a?;C4#`F|%5_rG{N@JlgV!T0X{0zLs&qT<*pFlhNri z9#)3$FSj<;efW!$?%6ryf3{u!aUb(jnpfX51-6C-7`^=Y;5p!oU$oNlwdwe0eR%vQ z!}cF+{$H!i=l{ES(*FN)cR)^&{~N27-2IP_9?s?eojmjVALsW!&hLMJ{OjNU__Xn? z{%ZT6d4N~3A5<}%NqQ+{xoochy!aCBKWVbuuD~Ikt(U6$CIBw&v|GcDS}bFL<>L?w z6L*qD3CY|X!P0VtZ^I}L3O+WE;WJ)3$Vs7tnZB{o+)gQhps5A$kNIGnj?>E_;Zx?O zLXUx~n3M^Ukom#^qdl*Gs0~%Q+oRmpH#jbzJMF^8Y=T@|ZW~Apz))0HQ4L5CT?hO| zoqK#e&+K{_y0|VP^FRNo+UFW6kgINSUXCnP2S9qirLT6(fg?ioy->A>7X>69gHs`! zd=uKipy+Q`UbES0829 ze-G9xkLLRST|8sX|IC*K^JT$&S@73i7RXlbFy@1I6r*3RO_HP&sQWzOWd2QhT8~0o z3d|xWA2;!`BlC5C)P%kr0_l#|Xi~BEmF?q&bQo`VL1*zirA{&Wk(}5BHZ^!PCy4*L*B=Cqfh0LBQaJ)a%Wo{pi5^01p-lS|uJ&91R0})92b4yK$Jg zdF7WO-$~>raqqb7FP)g;pdHv1tzo%0_!tiZlfV?H@!xDBV1CdgFvr!_O8=X zmsRBl{u1JUeHkwKp-&VF3$h}Jyro@S@_~^`p+z@3uZS?#fzW(O`0KE`ymquy3QHCl zn`f;{3!;J{6jFYQ;D3w0sSP_60}*1o;HQNIzG@=aaS?puIPcqiU=`$BuJwzdZ&1S^ z3d(0d9H4$xkI+LIvH>QBM-Brk&H}*1d<98Ztt8`r&nyV^G^8T;W)i5MA&LHG6Ond) zRa5bIi!j^+HRZ4%NempCK8`kw4zUnWxnTmopz<(*3_t;rbPGXB1xP3v*b@FGXc(iu zS_nG!Xr{80!m?{T+00b3(nYIm*%h?#0_cFmj|B7Uq zRHRFPto-ca>ov6aEd%jn&YOJ7+JVzQQwb9+e)GIhf4Uf!BL7X_FaJ8|_5++v!dbE& z)VH?Xtk|P`(Aq&hX9*BjCMT|ku3~y@4__Y-_UULn&eU^T!C&Rct^bWh>GtZFvi@IN zf3%)m|3BE6umA7lnXmun>;L)s|8Kkgx7OZ&LPDcLWcDLihrl5NxKz_{D#)Z9AY~af z8QgU>bYpp3p$LvJj!h0OgEu|K*5sd~CL@mpQ zI4RO$zP9N7LpaXeEy%$|MU6(Z#(~|N4@QT zP=9!9wf@~5;4lFybo(b;yRr}PxqGgy{6E5P3|DLN#%Jfp_WLQ$$&gw02r%Fpo-|Zu z>jCfQWKBedMsP_Az&kYka|p9E#Mz~F<_m2%L%R4{y`z&~@TYRLSXo`ApR4q9b(PCb zx}ReySn{BG_cG+vV;Gwwc<%{7V&5-+NEP>3=>VQOZ6$blc+ib7a#|Pf-Ds9Vy1fO> z>)nLTQ1{z0Lcm})+6)w1jxR?P@lERM7DR+aFbNFT4O4W7F$cMm;DwhTT0MiV03am; zNQzVs{*RFeCDdWJKNh;%x1m`fjFZ#Wc^vd2`ir@6UnHfGM`R)SL=Y4nn9zTJcX50i z4^6~9eqA%~-5Lev;~0P4?|X*g22{7aci24&HN_E5(#aNYLfr93okxQ>iD~7kyHukH zd_8@-kRbqGa|E})H44af7XzvW*daasM$W%xscT&Ah_nGi{3~= z5*ltINW)QGY!qa$H~{l7x@q@+!#CytU1b;doYMNu_s*dBdoS~y8-SMJ_MrcPt^N`a z6MrM3ho#N{H`wBmY$+imF~gvR*u*^txQn}S-ET9%Fo+#cj5*jF$Tk$BK-IU*KmoWG z0%3IRRM!_m_y>9`g9;=-3fi5AeC9&xZ4_D%jQkwD3Fcjx;W(c`#|qDXj$j>t^Z**m zAxN{WZ=aSN3Z+|Em)34%T4ugHK>_o7Ub~0aZW&%rtR&1eoPYnqrF8TL}0&O~$)p5*@%>@M^XH|BLQ0 zZekkahW2^JN5iL?>9ZAopp!lxLXM-d6ciLi>`uYZvaYA2@;25PPAW=}9LBx4l@ueH zBFC8pHqDHiAch!{+sD5Kwv_D&?VumHGLg-J^# zHhCFo21A;i&oSh)w_V@)v4%IN#_9*PkTC3uxw(%o0(-T8-`KO0>E2^XT1f2g;`YN) zqYat#4?=Ex>&aey@8^^#hG-}$n!IVwlP^;b+Je9l&crttlReW}H7MAUN&XTfEcxY= z&%RTKtq0sgMWCpz9O@w1>d=p9L*Wmw*w=Rfw|a>8Cu%REHBRTiKa_^IH^T}t$ie)e zRwcV7u?>5FK@obbmE%-@!ccek>@guXKm)IK3%3f8c=)O*1D~;HswnT zYZRU&z-C0q0yYm&w@zV!nfmdX9ck5n<$k<=M-1Oxtsh)0XX*wEIpMJw*UM?|r25UR zph7o1PT+`Z@w+AZDTiK*Hq;}+gIF#1HybdYmxY{_5b7{9T$n%-Q zU$7?cwo|i>(wAvEvHxl54b`5+fkuogcB1}cN9%P*PP^s(DZS>)g!&iq3ocQ58K|_L z>>W@LY1^x_=HstoV4=e;*=nUP^D~YHWVpyC z;VmeC=reIeM#xTOi%GqXX}@BcwCk{&dd=nq^F{~V$9|2pKWTyJ-Y8cd#3a6%LQo*d z@UOkcGwI3h|H)45t=2L1{Qr73{@cc*jmmug?=GJCM&Ep+Z@$s@*Wc*lE46BtjX2C* zgC*BPxtX|s|Dih^^bbpELJ8F`(U<=ff3g&2xz)%j z16TNf6KE-&lB1$j^7mH-X+E0k^&uDZ^%3{zG;(zHC^QF2Z2XV$m+v@Lx^D#14sSMl?qBGD%W^_`Um!N)8D40r5*)17f_>rBrT*(_mtoJs|WwlnC*1+|s%yFOcV z9N^dD{>a(ZD^uP1+fcq-`DNV_Hf+zsr2j3RjQ(Ff>)n1GllA|#jR))5`yVz|@&5O@ z{{Q8lU@@J@ud)QdOfxS56oKE$5`YBeZ7cz3KDhA`085!=2~bRdt1bbsj2kY00kDXh zEdj8ED=h)I?YFfAz_M;@34mqYWC_46%Ps-%Tj3G_6UHt9Fmd7%0RNe|1i*hLECCi_ zMmGl#@u$}y%>{2i^=jrJxLBvCJ>#DM9h8t4Am!a3;m+6x5C&+}whJ(&;1NyNC*+uQ zJ4(r2hl|OM%L!DYyytQ690rnqxu-Q-ksypEwol{sd$PH6g{*MjOHlxp=(A2v`?5jW zwi5nS^s_ZGvM0g)$`UF|rR=LoETH(anh3sC5PC1)&|HWKIHhJB3d&++}Ngx-?k2_Eb|N{)~o-uOFepTY}@ zRe1f6Iy_R#KhR=?Ut9FPKY+?x^yRcutoj}uF;xISbmUx*A9h0h zl68Uv&(sOj1NKzi4n|^tU*!OPvhbr5>fO&!Ofw|!Of5!I|44;@K_a4Ngg1gqFTt#( zI)moN!SKCmwc8iCtQOHkNUkDwm_Tn`e4~D#g5!^pC0+PI1?9so?%bdUDD@j*4~)j%zn7X;lU6uwCZ3+vJ7pIn7f+?`kcB{&CuNn)b%T7M@WfqJtk$i7KmC{7*7!D*`Zhd<~G4y1c=@d%f@8Xj#3ka50 zjE=_fu^6tz;W+Mhgm)ykd-L63&}$Bko2(CHIi++^!hc79CFG3}TVvq;8GSvbug7AP z`H#B9*Q{VKjj2fVN6?55NNKIA(l3``n8A*LF&k!gu=@|&o1n_l0myCqK&aq{XZXS5 z8Ibi#X;)TZAY{gog^&aNa3ce~h2P2sIt3=@=?pM^YZd_Wy9*pZlT>h7<+KnRbZIGE z)b4Egg(RhaLGv1QW*Rl=u%Wq5XyD9vT_|_rgt)efE-b3+76Zh&YBAfna+q!o;PKRQ z^scNrwn~!zvq6(-CDBZuScNc|9jJFR6%veL)ptUC-sP5#lcrxd;wl-VJmnP(Tj#lb z$u>rlaw^M69IHVN`C00WQJ+K#DP_?|n6p+yF5JO?a3GQY#z8*ZuwaG93Ss%sLkcSl zPzZ}@c4ul)SpcesB28^x9rbBFvC(*>Qv-fWmP~9D_Wq+996@#zpW)gJ(peKXDFg^9 zfs-|4Fs#fimvh&=-`EGLilUCDf(}eR@=7rD4a=@(kb3O>uGdOwiO2yNBj()Pc-Th$ zFBSX0Sla(ee;ZOSB;$GX*i2?1x+)#6s86A^jGB>CRm4ng%|b>O3y7R$jRfnA!}tSb z3?r4=(*L9SMwxN=RcURNsu6{iADF+YRhTG8m{X$!a=A*SD@qCate@!|tmtN@yb__Q zBecPQO90QfKQj9U$o{M*88Xm5K!kOm0;_9>;!~Ole{^86N}9=2w(iholJ`4fsClM7 zq6&BReWeI}=+(GS%7)C**bJDbzps=ubvd8it&pi4tcIq7vKAo#@_-wLj~By&<%c;$=q^CoM`nD|=#)_@&}LjZf>9D7pBxno+MxqQSf@}~ zzBUIHa&!>B=5hHS)y^!3u7Tl|>mJhvmyFnAf4!1Q(JdB2Q)(nm(xp?S)R&r7)B#=9=nQq8+seJ$9RCt#i_J-SKYGj@H-RObYL%(pr_-@7U}B zhn8Rvi7^_m#L(OI(0EP|rH2=wp2ejaadxvc*rVA>ykyrL1B}&B?t*kbdZrdXhVG8e8%xZVo8hQ2FpbEJyS756l~&OXGGDE>8 zF4gz2WHs6Wz&R73ttxN=a+cfZ6erJae=@6q6D%dwyvkT)ItgyH!U)wbimb+Cj3{K@ zrRB!?aDXQp(S#9{K4U4RUo1?d$Ad-M$zXm&szzbl)63I7YveLN@y68!~J1S7t+hyQs9k>X zL`dR@EfnPrnuHkO>sAzDSye#lc^(YiQ@Etp72ZF9+x-X<)>6M!lm)$C6iwM8P&dK z4eZf1*NDYDlye=&|xCV_~%=RFQlNQtQbW$%F%?SS;DxXUiqm zLTihq{Gcl^=%x~-5Ik?yos=PK+Rez1d%o<5)qB}Ue0 z-*(Hd#LI2+r<9aMW~v|ZUcUx-Y<2umiyf0Eh*dCJjv2AXg{ z-U28-CZA$we&~xc+@Jt`v-C!X7LB<6`#l%hDP(9A4W{MO7I8zgP$I ziEl|A$Vlj_9VUU?tT*n{Gh~~A-0O}EP@RDiJc#%^ zpLx{R9C2(%^bNeU?wJB^x}<|rDV?0?Ykv1z4246d-yFa!e^@^QMl^C^hH(nx9HC3Ezv@O(bhuD_6=E|p&K>c+jq^D1e)OMwbK zeFJP7sufxuy4T)1m%UOra_3%ELW6O|V@V6Y>5DRzf83O*eh(c8sG$fbi^J6~k(E^L zJ9(jmad*X5tOO5MqK>W;lsSA>Z<0h=sz!m(*6ZaR74f{z;t-|B~P#2w#`@nl~rEtal9 z`pJZeFV7JZ;i$r7XlDumFDdnm(+e!f+ZQ-LGj^vrh(nYb2%JB$tJvpOJkeC$YN`#Da`Ew zt5wu&uALRUFiW<`mkRtShg+Cwt$&wXyc54yDIc9)bJ+rueR9k8<5A-B(@L(fR?C#q z4T+%{$X^2OHko~QXK%AX_1Rvdk?$W5y++e^7trA3CN%i*dNjzkU*{=U?@n(327=2s zfDg4y!yf}SlNow)6LbJRnG{(&fdLn{K^ghvG|-YC=3Gs;&(}JVQcOZ4Gk;K7Vo0A- zT{VsW)aIkwQqcZsEyuZtyY4K8`H@bwXI*ipnQB)I}w0hL2 z{#iwu3Kqj#>jHbKUtQY>F@M8ZoFuK2*vocLPLSTLAFMw9^NQMtC=CmBz$MIg(j@X4 z$sAOwHp43p_dyqMtDtBg2P+QzN~mTKWq&P6j@RA&d4+kpwNtx}PH3=$g}^0^J z>jw+}>vn`){WV)~lj%xrWu~fh>SXV)L|-QJH<^&82`0;0gyy16`_*1~v}N7#VbJYN zQHfT2>`zCq{xLzzc%Um%Ez9a)f)cI0H(u5bDt-l##oeVJ%4GgghVOAD#0FqS1AJ8 za3l@I4(CQuP)WM#do;XgkElQGA}M&JQ!4bMO3quuBz7BSF8Xpw!Yo2$fe#!~q0b(2 zxG!kH9y^T0#7%D&hQGu>9@m_wCDK7!N)-xR8X>QM`kYwS#FJN{-9I(i(p!3^tlzzH zy%9*Q6#P$RFn=oQJOniL(@VB?s0_LZw8M<)_a$xoWG%nEEA9Hqy0Xo6nUxSM&Q0#t z9n_9NR<2NOwMlrw^0ECs@KXqJYBV=?60@S^<;XR)y||T( ztJLYALZfr)1gu?uvsT}%F{Xf!d2wjbauRKt>7?k=$bapCBEu~ujGtq#My?DVIkJ%$ z7~4>@n7=`TDN~`fc49+qJHj;^OiPUXddc+;FKm3I-f&HZcZw`bOub_5Chw&l3=*In z#`P#__>yJV1i)v_-G8wga-L1udEjcSnzt4yanxmxA-;N<5<}ZqgkA{-S`2!8IRGju z9qn#y`G5Km&|*#E3f|TbDKt+_=AXQo@T-oUKUEJ{WA;`k|8)oRR~W>!geV%vjwf*K zDkGQ?U}Fz6#Z;0^Xt!g;a8a3LyvWXeIcvi-nJzBK7U?IN84Bym-Fknu3MbkFvK2D0 z)Rie>R-}u|xHFcUUlIBze^UQH~ECn%6B2l!e{FN0l<{z`!u>jcImyiNelfy5Dr29%WO6QFQx^eX|0?t)# zm*Q(rT=VBvo&x=kA}QRW`ZqQH&&Gpn{C}T^s}CQ|^}oA#=K9}U|C{T7e|`Ng=Q}2j z43Wy8Z$RI%vAQ7Dg^m-$3m65d{~kr`flk3vma!DiJ<^e{rKZZy@J6EYEbg=>Tkv7B zTZ%y~(OzXXejwmd3_-JLp=X)VU@hm44_-0K@cm%-)#mep)QpN$gnU8cy2%0Q%UEKYF%zb2n1IM(VvsDK*H00SRiAXnoD&vp)De z=vKRA-t^0UddSC0!TXs!bDW3H$$xu9cFG>X;-(w@8ol?jRDqo8*To8GJ8DUF=?6UQ z(lqH<6*bp%lrAhkJl)axlfa2omC)%HK^c7id1HH99n#s)Pps;T=pi%N^y{e6@V6*4_dT*FeQ)hV=BKW4U$S)I&`>2sFqJhU8O%7k?Fv5kA(f z8@z;T;(E`Y>d=1@r#Bd+>%j?Zz9;@;h+MxAQE$@1`B+xE<5$7ig?~Rz3$V}U1hhUIL+4?wX{S*Xm42;o58Nn@n!henFI zoUeP;h6DbN>`c)$5};_8sX12RxMqQZ)i$Xe0DziWRKJ0Sjw?IQ7VoOwq7)9_$@S}S@HbvXkDV6OvA$5QsYOezIm{;z#s?zab>I0)&n)mhZkzqYCFi#!GPUy1N_dluj+`~PdJ8xOPg-;IY4=Jwya zc;@!sx&3!;|NXnze`lLnc>?g#+3&A8_06CEQ#k*Fw%5DE{ojpsNX^dwm9=^NzdL#6 z^Z$JQpU?k){rO+7t&4UDUR!QGg~|V)lQwDA9y|;Q5U*sIvWI{+o=q_u%5BqX>#5@@ zsBNQTo@x~>9OvDRYrb3CSPct6Poa-wzXV%Sle~03o(&>`cjO0K-pnXP~V%zwJBlkitC7V`dc?9SsOXXXsY zmMK^|7MmNahT%<@>G@klViw1Jd-)q#LGSeWos~%k#Qh@MB3*npB%0~NawT2kQ zqwWQh>sTLuMW3(wg=~eKJLlFyZoQ2Tn$Bk|lnNN_I=ugCXDlB^?6Fbv_YYt=yzry* z0cf2BP=EOnI`eCCDiI+gR<9sZCGON$;?gUy-%VJ7clkbd&w~O%8Re?KT?uMrnP>oG zQH{{g@B-NEX=A%VS*X)zGd3387|Eh5($|ll@sBe^+3Z*O>o{a*KhxKDPvGdU5t8)&y2PmC)tIGBabbOmq>v zArnK@vnXVRO9x@uX>3a58FFpx$6?nVM%iy`p#<42V7u|bW;E~RW1C!CbSbLn`YbtJ z8$)Dg0;Isw6nth@aBR9YEGEFh62l6>GouQ5RjHeG$OfJmz~ZL$e~yoe0=UHAsJa|p z#NIe8PCla(xkvgJ%x9~b&ob-I3~z;zKYZtl7SC1}%nteOTPtSjHe$sY;VH%m34Q89 z4jWF`7taNLu(ghh@=QH|uKA)?YLq;yPwgItHyRvM7`)Wy(DtNCXDxhuK$?Qj^ha{0 z0LMZ(EiIF6i-SLrEqR+-}x1g4^xYe$PUD8A-8{Yd_6k z9`AW8HXnhnRGs)+_rBSE@e+41>f76mZS{0lz1-XSseaG^ely$C#+o>2MNMPUJh%ezLJ(ni##FRAfYrSOk24lkld2ymZvJTO-)o zgDP+kP`AGMyuK$Fip(ZJ-M%O?Xin>yV)E+QVrFqH<%&culjs#vd2?_B9`cdGS8!?ELQA}E+SAK1;Hi9dsqo2A5J!&(PIb}I_Dzr>1)9Tb(f@oREIEj81X zhEiI5*^bXgYHOF)9y%9C!=@S5FF@Xp-lTfEf2}Mo6=1ZK(-sxVcsXQ5p>lhm6b7Nr zm~8?B6GcS(GidLB>W^BN4(jKvgpd4C>H1D${2;L@(J&+ZGB(0BJ=GTx3S}7Zxyg6j~QQhs6{g ze0_q)ToJ3g8}rI&gEMbOTv+29hc`|tlzjFcf8z4P zX815F5&+EpA_nrTy-%Sqwsy<nmm)*O(yKl#$wve6 zbuBGrDxp;ceqr5)rjL^2+P{1ffA`DhpGr~bBXsN(O;ZJyu5^99s{(qLH7#MxY|lE! z*&dvowfZO{OFqRQSxD3mXwu4^PfZWa_FBoPDWOgLlGpx-*{!pj@&*1CIqN6GwjUl= zmn%n-24k@N>!8~Y;5C#}qpS>WZ#~(o@BNGjEhHr*>H@$-nFh!&!wvR{f0>C^wD##O zSACid*qtUOrBha1IJ~Z?0f>&W1`I)-rg!Oka{> z;`p_C%tYAhE{2{O$3uE@9*5WWt}vZ|)>fYpDc(%vKBMAX)H1O|f2_K_87;QrmNAnP zM8R~iGII-4{n-jkqUm4U>|8gDn~m1YY&7A{Tl+qn8xCY6Wd4NX_)jt3ZkKNhoOd#O zo5pO1#K~|T#LdD&VF_0X3&m}}t*}s7)@_A_!m@4>7K&Sz4GV?e3d2HS!q~7- zm^d*k6aq{P3x$6G6T?E?r^OEILyDz8pQgWGd?BE)jEeNJAn#(KT>Jor22o^ZX4pc=s1FCstjY#*9d2yn%L@;SXgi5kc=>?N=xaoihf+~4L;K4-kG-0T?UY>9gJw#R5yu{ zIHW&E=;y_CQ)=83QlLNVJ-XDUs?>e86My77q7 zLbOu=A}V_JImEIm28zo^A^VIia4l2BJ^y> zY<5fXqQCg<>SPdeQ7r3JmYh}O2B^IptCOor<;4wf8CM0ix}5al_&kuy3=kr|?4r-Z ze2IVf7k$$8AIIJ)w{O3WDeFJH?KQLh+kpSi*ME2M-0$|=y$jGRzeja!P(J;^vp=DG zq5F;f&Yf>1yn>^ATJr3ypOO`f4wNYnzEZ#+_cO?#K2;6Rhe5Z43f%}4aEZZ)2FgWC zBl}IveUzGBx)Z7W=GNZpf4>SD1VtWSR*ru+e#kGXDhwY(`tRQFr~r53W1OF#yn433 z^*;?&dAR=V24g|-m)y!D#qXexpQBM8>v^`d-B?87jt3z4Wq_4DhuH&7!lIimAc$ z(i9Sc9cSqE^~Qfz{x^@y$KTzu;GKUa|JOj+XXO9Jqt&_mzl-N=(7EVYp>1F7H&izn zG~3O0xcAUMK{wc~orA{Sv-)O(2EqQTCwsfE4z_k067MyY%ulvRzQ&Wv|4|G}<=fr(kq3qRqX!Sh$^Z3L zNOR@?`oo8F`F|(ReE(;@|1;nJ`TOqwP`EbU{Sgx=y?7pt{+j(#HrMm|-8M|verSD{ z)kFW{tl8?FpSFSxJM|SEgm^6( zJHZh6p{hh`EmG?dwDBl{_Xm-B7^z2*`u3CSXD4kd0@@CwPK8z@?N+47Kd>?8L-Ymt zBa@Y(9al(3gk8D?UfwvDgJZsmxq|lBdszRIIq3`4F=hRa7T~P@S6P2F*Z=O~`KhtD nkGD>*l~>Da^8r48=Fj|@Kl5k)%%A!5mw)~rjuJ^w05Ado^0LzI From 16de379562b77edb028252546427797452f5e713 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Aug 2020 12:15:53 -0500 Subject: [PATCH 252/256] fixed directory name in EZFIO tarball --- external/EZFIO.2.0.2.tar.gz | Bin 26746 -> 26730 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/external/EZFIO.2.0.2.tar.gz b/external/EZFIO.2.0.2.tar.gz index edfc98c9cd6bb9f5c41c26319dc47b2fb7d50284..33bde1948ba66b7fd4eaeca86d34bd24b39a3fc5 100644 GIT binary patch literal 26730 zcmV)EK)}BriwFP!000001MFLSZ`(Mw@8A3soOFTOGm2s-O*_rDbCIUWY%ba+NYW{0 ziz22a+U7)-3{gtz;(qvh9;6Ne7D#9>#s-sooBmG``g>ko;`ik>-V1TK7S;4zb#vQm9|j1l#j0TwMlPjch~#> z(Cd)&pP1n{w1J1~zrVY^`$PZVglYQe~U3t!KBxF>wo*%?)D?u`xeYBUO)5? z`k$&R9Y$F?GUIPB#$Ec~=`ZSkr?~ zALJ^9z#xv#PLE#n=!wZ^qZd7Ka3JY|C*vp*M~&N2mKV@ZZjR;VXq0QcnV1y*(doFD zY^GVN;rZ$DfqV>qvzbn(Gw6TxcK`Qt>`(8+{#iv(PQJJjbd~0*Bgycd@Zo0q_xH!)T(TD``em zGpWBATi8(UOOAfj5=J0w$M{}V4*WSoWe{*Y;qle@a8yU=!g$x^{}2WOw>O$+6MAwVxozEEs#F& zeyHFXjTL2iuI(&KW0H#^#zGXE1XWE<#GE3_)E-7wVwT|Gh5k~|Ll)KuyX3i=ujnDi zU(IX=ldSrHNY255Kp|s!gR;5SxkaUJhrNIWC7o8S6ZDQ`?uB@h-K0sTVzxgr!3!KN zOOoscDb7@MrN+<`Rgr29I@lB9XE|_~^yQ=|W_w#(j7!6EW;ct(>Ts0*Hn_xgPPM+> z&CN~7h%p3(xi-JQ{~&Pz#I3ArHcm@yvt_eUaRbBC8VPzx?D9{r&vx^#@FYxiK`me! zCF)HjjhP*Tq*3Aei$Wg&jcSlsl1MgRRhc-5Yn-cTrSa*kME8QnGYx_UX=Ed`rYzA> z={%>pLp8jG$lN8rTV&@g6A7P<4`NH?dCZsaVN z_y(y$rx+d61)xwaP-i;JG@PyE8PVnB>b!6`(9T4y3{<%vOHdHz7wqO0RPn%w=`ap%qtMdv>q0lxe+yR zn_p(5OW&0{bauL8g+B}io(4z+5G1n*)tCZA>4 zzJ_yrWOA9RDKsvq!BCG)ic%+!5}+Q5t5p|QDg5~X<2sC2JfN?kW2p$HNwFVBQKHBV z%%_kY94aX0GabZcs#6S$-2kMjBMfBJxR8lfwvf0k27d=DA-{wdVu?Yv%@m#X*yS-# zmiSLy*rq^@%yWjK31^MO7eULR7Nz9?F&Mn8X7ti?TXPq+gkX;p0UYQge4;{2XgP~{!=me(# zB94@0{={M%lof{GLId3qXc46d_B@{svqW}4IvCA>6R_V(CSt)ZE0((}hO7VrB9+Z7 zP3AC{lN3};F>)CQ`L^>w=4DD_UwMb1Es12z&OrXRyVj(&;sY}2JNUqEIa^Ro=(1+iI`KqY% z8fMX87~`K~m!pPBNzBLr+yf7ZO2;MQ6jZ|p>vgb*W^YZX$4tD!J~ci-JT0HFdeB0i zP{THE6m5(b0^O*+CxMd4Dt+} z#LDm@FLf9=7jn30UES?a8?Wyz%?^#%@AAwEYe~6rfE93xx|jKOWd64 zqRgFfU8|(50$|m!!3_+;tgj-DbH#x>_z#BCuB6;}f;2E{GjAMIK`E)3l?i0~7-Ku2 zX9$Q6$uvk?4S}t|tjZXV{NDR>gT^X`#*QK6r86Rq7AD*b__gHRP?)kxSSq9i@ZTPa zqPb6ef!t}WwJ7-#j)A5x!R~(Z>%``8b@Xm6SL%R|9ws=)tm^L!c4^WRWiM$^m!D(@ zpO^xtJ{a)trs=I%==p?JOC*rtk;2u2%-}_SW9&-vLJMe*Z6ORtBzCe=7sKeGTQl9q zY{yG<0b#;>N(D$9ZM7jeT0t-9)D6_==$ELNDO#y{X+?dT%P+=tx2un#{a(@FK0bOs zS6g?jBG7gXPeiP4jH4|hluio+uN>jQozOg2bgC`*PWBLfbUd!UovGWKwpgL258#3p z5FPsWZa(g6+~R~A-_8nBuVGhvp6gg|v~RCPI_=xF)A^SO;C$8-xLfcm`|?7*v-sd) zGk6G*wX<+U{5$|t(k2|Fy}@9u${4{sLJmEXE!%!6pn?FP9_zzB0T_Ztwj;&M&e2pDlDyqpHul|Z;_hWjkDBESYK zq9*S&35RX+0yhNx)FHo`6Xxgq6ad0G|{k`OOz)X-)LLX(+-P~OTWHR6*x+ zP$@p#?$I;!#z1}vBrG();uJ`%!1cyP|5=DBwiogN4gcQW-rjlftodBD5^_Iuf1d6< zd-~!j{M_t?zyA8-*|XkVoi^|4B#|qg%sao&2{QSNGtY9`6hY5qP1;#v3VdWc-96qw z(>Iq1U_j`De;{qlIvSP*0qv$x`%bsZdsd!)sAe;r#vR|c>t%URTO#dh(VmNNyJM)R zFQ0m!iLEclQ^oIR>OIR%T2y)KvHS$G?gbzR{^#?GQF!0Z55spjPUp*~{%6qOr)~Oo z=X3XtQLAJO!*+T&qSq?^>U9Iz@rnp4JyfqY*S)KFKBra90z`#3?9Uat+aPP)s06wn z$Lth1L+ibv)pr>^p(=IS@$>91H+A~JKg%z@6zOjzb2=iT42B#OS)meED`lb_9dnPi zMNyhAd$iLVB32N@BrB6xj?J}}{a+z%9e#mfojN%t-MV+;LW^7oQ1A|@^>|l>n1C?0 zz#kvs&`xt>!v*3j2_5&}Zj_IvvAFRo1x&AZ?5T4Q+4>o7`4I-FU_Q)6 z)v_6QNaEr6D?1GRsFX_i-9>cK+#C7mcS6`JD2}c>FR52e?%az;#MKcVQKoV86|w*+ zhtDR{*3!@)yVNeoBp~q+PGB5_X@~CiJw8V0T(C$z3j;yEVBn z!C&lQKS6{jnmZnDr*q5gz+ykz>snY2wgbjb@(lVgyeOwbmS{EGM*sV))rj6c&%GJb z=}f2!yF}SZNK^1`Pzju{c7poZGOI4QRcm+`-q!NlTHdT}wXn#dAs3<;3b@*Xc0mG3 zQv8rV2l5GRtS@bj>^;F&G2n?;{h(z~bys52U~*ta{tDpcFKEw}0qGM65L48}?$Pfx zXDbSz+y8ilNS>-)DlG~q}CTim<<=7ahZiBp|}+p?BHZxL>~wQ~_h5I~n#xQ;FSAxL$k zQ6);;4IK==(g6wQ5Ipmt#VJ7sjK?eTLYzEH<- ztGZe5kPUxaviT*S?Dbc+aAX#GdB@y&@nXTX9zHi`R4fS@ZjR)?9ZxA znO3dpj=0O@uc{0DKE617S2cnVc6TFtOCu@&*nj)sP|7`d4iQD=eA;C1+1Xuta-R{O>Z= zvj5^m9}>YqHk;>WJSk-7pbHOweG$+rd6a7{&s_zrJj%*6Cg2mu<1`8(LhWK3m0kf> zmgfbuhNN_4Mvxnh5{QC+rQhFz3qO#x7ptTX!qfKU&uqqdUGtnfbaxiXo{N% zT&HjnsLfZ7FcntZXoUBfs(*a^+@MA9lT{;e*s#hfFv7fnBYmdjx)PtdQFu=vIo}0L|wauY;7D3?_sA|;!k#* z>EvUw1VJ7JLb^71ggc^D#f`C(Zcq&+vHTTx#vN8fU@5_fP+*8DOd)(nuvxfmbj3E# zP+P|6N&$h#h`B@}DJ}DeUoZE+vkiH2S6GPX>BgBW=7Tw;V@uk(p!4GbaVhDKVw@$d z__Y$rGS?`n2#v@xc@W0X!~$#;0~88Vr{w8w5T=BTqea^*ewCqCa$Qw4ax1KGrarAv zz@u%VxO^=F5QbHJ`~`?LLz5UnWv&+AsY0yOXj75_a^%E6&0;e`^CeNVN_}06mE>$0 z;R&o0IexdI(d)z*Yg}o@6f)#UYhHCuAp`SS3GY`%21unK9DgqDWQB4?Hf1ruU}CvWry?+i|mz_riATnbPq`Uc6V zf}?4gLH`_+(A<^Hy8Kb)nvhCJ7gG!|Z@5<8LIlTAbYeLd%<%LEI82d0;i83YS`e`7 zRHpFY!5Ie`kk9HkVg@RK#aR--7(6A+F(3%Y>{CjmzKCS#QjaT;Kmrh&Y2lisEn32* zqbFE2Q5KY7*j$eAbutfVkY;$|WjiezF;GLcM_FQ>Ce7aE#u>iG@75%pidm{3P}iA> zU8!I?rs$!NwaOf_+3M4#81!t)4MT2cd@94@rEgVyf$j60IDEAObfbcE4c-p}1hjo7NMDHZaP=W0ZT< zP7yQ?b9`}p^8Q>Not(k#>7U2%e-GrFu<^Sg6AW%li*L?o6@-vx`-8hi<2UK!>^!%VSZO)Uyyh zR9=lQLYDi+Df71h09u3O0zsgqVxRItV-Co@Kds)NsSFjnGjCKmYGSG((MfG+%8fTj z1L*>*<{DH621Znv`Fg^My4ho=HpC0e9ERn#3q|uy$`Y$++_?>45aAf8mJv7u4Dd~x zu|DQj$vNh)!&FKd6aG5^1f;l82ay0jIti){?voUgMoAgF-RG=CV+TmV=oGoI{%x7#ZYVx7!jYAc^qvrQnvwE=R$UL!4AcN{{qHDy>_$4xU$Q05*ISs0>m}}IJ zqM4bf%u1W^=n!)#n1k)YlNmZXWEhwPfdt27vz4el%|#wJi6~KK%A2x2_5WR7X+1-i zKnrm2PH;EtQx*asIJWPM-~Y(jWNz`JcW2k^%znMbBQe68J1WWn#cbvx49>a2M-2dm zS@(-ynS0bsma|=3jstk^b26M&zS>}X#B`BOaAboPB_+lwv%5AF2QHbioi>psh4ywJ zbOBzjNG0cPa($tO;I}L6k}G$oTCPfNd-aS(Ip_ z^b$8}F{Sz_j2?le_rL9ZdtVzzvgrMH=To#5lbL}*NCMl5yvlDemSgT>@ZphcE+#rc z8i8UVaWoPJCqAG3)}x;@qX!t1m*$*}(M)xBb#--hb#-+W6}KuREm59lvyF+)UWO-R?kKb>j~ynMk!54KJu) zw_*}kRdu&YFWI9c?sb&SQH=rMCY@4ZUeYxuF!9+;(0524u@G}4km^lVL-?ODUB}nM znX0T9dfIM6pciaZAe)?AOf!+H9etGioc{k>%?&Ks)cq zjw*z7yMUR2!5ncdM zLR@oL8G8;SjI=_Q?O9XLC(^hh^tb8Cctf=&@ z>f>n^8=(1u80$syfJ^x!z-Kzbjqzw?d3 zWcqVY?l1Ktl9mr+F_<5{x@xb#_`Ni9Ym+_H6` zL*~OiDxxSUVb_+ib|@%u&2_jd2f7TUZ{flCRILuDOns@j zI0s}MBUIQR#<idUO5p6596ez*4>x^J?TJ{0)zE!q}d>+r#`ptQS02Kz9*Q* z3*JK`W85lr&87u5cD->z8|3|d`f4}&RyA#SY5GPKQ-@FRUkCSg{CRZXp5E%LZ+ z>XE`TS7_aFu(lj$g?J4Ee}zOx-OfucV;b>T>9SF#KlXH?BR*U;q&W^x^XPC;TY9uk zYZnV}*Ur{LSu@b+lr|t9j#Fr6!bS5J(f}@iqe(jrxQB@Gdtl?Z$Erz!Vmy>R^knoJ zoB$kPj%-XQc-{WvMhU1o?vviaVQExTp48f#a)x&0y%opp7&dijZNaJ?RV-@;P$)Y# zlM$l>ejeW*)h-z_1|T0r6E~2RT57eblt6VIL^EQUsvyICO5G-9lq!P{W76{zFHfy> zq$D0vpng0)JGW$eSB0A+8|TF(?3paL604Gwwa6j{sSF!NWk4okGY}hVBD@XTQ|ha& zv^c7S$Bc^18(&|d8JD(Ca-~<&+|pF=Fq0yiU`#eoN43z$gE`GlZXLxZ9xKVaO?Xt~ zMtHf<-%xX>LM=NpX} z%^Vsf+})rkRtUg$ut_&YMQ7Y&!P4tC`z;>2Cp>g&cW3W4ks~ihsVx{^SyyM%#5vO2 zf@H1kKI+88;dq33h8uh~+PWvX(x3+te8Rw>HE5KiPd?c51~~)q^HAE8U77J_elL@nx;Ra$0OUPAvJ*{^WzR# z%|<2BJavvNzp$eSPh!`SXr1pXykK^dDB>%I6V5`F2Za<*6n%-++|GDNr&W%>iQIx2 zle#bTUQ@+ZVgW#W4Wu}y1FoXy&Lrue!b%csY~jBYP{7PUd7xxTW9mn0L-wpFwmZD8 zlQjjVs6H3KH2^m4zl_^wWXWS4#oCU;K~jpeI{e&S?&w~EP?KQoA^c`L@8F!$uCf7UUnsYX{j&yX`ZR>e-DVmP>gUBb;O zc@$Wa+fox$D>m866&Ojfp$paR?MAW-sqrLtGyGT+hpdZ{tl03ApkPe^741kp) z?$OSsc!&xr8YuHN!P_1GqVDo>n3`C!RrN zkd}AHR-kcJ_!(g&k!0r+?JXh2pj-)A5T6gaq!S*dW{u6JCeC;z4oa*ucl zWQebL0-VO#)rwcuWRwxlxXOJ~6gt$aYo%C|KCdZ(MOW&T?*twmDA!Qh7E#DYxi>{t zG0cB@V~(}#T{??sqm5)7iBKrg#w&5~$nFA2pf}rXwmQh*1!pmWU!K$Pxzk0<;{}#A zK8W*J4(qN&?3mdcxka7p0Bp?ZlMZkJI|0uSf+fc|kqyLcToL@Pivf-5w;Y0Wq8~a^O1WMP^`hket?)ktxA>D@*Y82*eQ7PV`&A zD5Np4SdSz;dmB*`+JBM{Ie-z#0g`lU6(k-AgVt5FHsTP%7>}XTC>9k2U+pvAp=xVP zwww;_)l;yUeFRHN%bQLvv;~yiJqnE^YbZo!6Gtnya?r2>B^vXot4}KrF?BwukQxk? z%Yf6A8erq2hwR|xutTQr<~W0iaFa)Z)DhW@c3>GOHD49Mt!X|sc^5L+Z>dyNx})+y zwPpvY3K{1Ua)e{?Yx|%k^7PJ`!6}`ZIgJj8ov^UHJb2QB9<_I~k(QdFUIa|^Q%lUv zpnR&iN%QqNUEmm8#5l%VobEZv%I8%YZ%d8g;)cYZyQ|DVf<{+?9uF|xi`Gh z0oO7dUOB# zdW3NMb%e0%LLXVH0)X11-}V0-)^`uZ+xq^S?ZZQ;?Zr=G^X*%xeDlRlUF>ZB2n4PF zXRH49Q2hA1zU%E_^*?R{J_m=JSYUfs{J6h;xV`&5Rfvwb``h2YJ`}I_c3#%^$y;{~ zTBm~I?dJaBcKyHuJbu`I>2|8Hc>rh^#E;vDulJ4)HS*ZG&E22GzqfZ^Mxwq=71jUq zcE5fA{r8~m?KgmN9X@XFZtWbsBuC&EP{Z!tA2B!o(U;QQML{}!7Eo+Rvl z9c}80fVxn}o6X%V8mQDjVt2()dq=o%K)-ihB7mm=kWh8;vi_>Rb-4Wl3@<=JGY3a+ z>XP0EheV*A9kE;A0(>|3e-a1v{U5fskPhB{{q5#9kRN@d_wj1{_TDawmr4-_54fcM z1MmzyXaOQf5FDbHn{PJ1uOCF7W&&zjI+I7@;B9?t z8~=dszLw6qZU6d9H7Y$TQ8D z0|cULqjEikJpopc)+d0vbEp#sF(*O#N?nASu;-+)qU*-EB}`P`@eCm0s37jKpY3!y zeFX6skLr>Ku7;S;aqkV=p*huc6?*{dx_kHm)icfWt@xsO(WG}fTW|kMtcvaZgUvTv z@CQ!=_;A$k5>o(@Z=2(uIB4Sij+i;AT>d5!7$O;|Cw7~|(?P!<^9n@(>*dnZiZ}!+ z4p3#^irewE*suT+#^GPxVbZ*4+1b!MPx>$@rqsW!%+H=zeEWKD_ophlW;8Lc4qCGM zSmcKPY7SfHX#Ms)2~l;*|D)9w$*?89{#rZ^-faH6j%l8#WYzn}Du;PmZHdD1u~_Yh zREV;Z6D&8p5RV_f{qZFQFk3F<6qBh+b@1*~Ir%xaC}nw(B`hHJ~~`sPdV9ZT8b<3MIy4lx0m_m7MB?e0)Y;O7De zsQ$!~tJhZ@QIuh%GerUO{0~(0V++dWeaC=eob?fFSRG0z&(nQ@(Xt5OcAd(kNvYnZ z#zwuyvHaBxb>ybx`Sh39vHr*p>wi3)U#bmM@@|>`8UBBf|M?*vd;Gsp`scgke=e^- zTj>7}@$mS=+O;|w40_2IkpXv@|IbQ`{O=F)q{m;n)Hdi>F*(1FHfD`~rSv2<{!ihr z#r%JW#}47??d`n8_^LHjc|FiYLG>&GYpk6Q2Je$K58anVSI}uP#@JfDNY2D1?2uOZ zw@0CxQRiDF4-)uSh{s)c*XxVbL_C)DuRZPx(yHNG8^hQC-bDBtKk4~z4d=bJF>C%m zDLqZi|0m_rV*WqKlatZNlPQD-iMPMEcPMJ`7bO}h!d8`X>oq7AZ=(^e_-iO5ifg{d ziLGmxTelxzxfNg98vMu~`k{F4QBocNp==j;rAcP#flu_R)f*%+{k*bM^>q6q%G8q_ zmri819>3;?$7TJi=!aqW9ConBl@qa26J<}qV?raj`K>Lri}e5R`h}&@__7xVSK)ND zKlmYIMusKEmi`+$2>+R*+otEgk?i-^#;p0j{`6UD{%<@hmlpH?A)cx8KT2*AaT_5p zLk3Ki0ImRV>cKQ;&EeS@?|XAs=tyi93pC^hW|-V*FW=wz2}GLKMwzw zYvcC&zw(pHv&H`JAs#dS(stcY*4z7QW5)Pb%IoR#-;HOL@@L@oM=55h<({ z7?n&NDflWB(1}QNE=L-77n1r+iMYpod36k!<=UjCB(+|TX|d73Yfgh`{hhrZb`o%t4`0 zXdnAaiGQMcT3kxteq|hlQx{ zp`ajn(-U9?`jye30PO}L(`XPQH5xdd8V%wno>~hf>re2Q^?%&|QX0Ul^}n=UPTPMf zPZ#^Y2YD9j{~ed;O`a?yH$QusmOED|g+r*rn^RtMUR1dP=xue7mDuyH-MGfewWBv^ zwv&LCm3FKb7FrMpG)XPt|z1ui=UEkS(y<6U%Pn@WY7%u=`efK37SR9xA zbsw|-%goOMbOpZGXhO;$Q+Vl|MsyU31&QZI2kwh}1jwx_V|D0(1BTNDf!%>3@1!J6~pl{v2Jj50l zFa9EFTq1%%lmLGzyC!2d2{X5>{7aMXEb=kjbkScq)73#ga44F?B8F!l2Kob2pvM2E zKLS=*IecapPIM6MH7`!vO>tcne&DYl-q+!ZANoY0FsCSj$X{lN3qCMXA++d5_G*N& z4g|6_;a|tq)ym0AAuL#AY+N+2Er>E6p&NdR;Qy9=-5L&PBLN1f(VrF)_)`(VJ{R{f z^+2-)D~fNAfmM-#SPqs$U!#VH=)z|}oS=SH&Cp{xWdr;eo;VCFxCj6f^W}WPX60x6 zGYtYG4PTLaQy*xY;S>Fv{)n`LZ<30iEW+>z)P%!=Br$Mm`Z(LrJ76iGdcy?%g2uxH z3IGL2(k%ss3h<$zVGH;-LBkyN#Zu6=XEW8EqeJ{33y{f$r-hs zsM>5dgU_T*1J#9_FGrzy>c1tKrd8<@E4#Y*>SnX_TLt3DHE;SUn**o*G!iCQevFsF zm%~Ejzw7(OUk2TNfU8M3Ptn88?H#u$jwm0rImpA(=-$tkuI!FqhiYQBZ-=jrhkQC( z#g%$t5%{Y-X8(_&ZSQyAubvtE|Mk+7wEsWow2S+{5ArPb|BL{e9>t3F3+36hW+&{#_*`a8~zTWBzO{f*W^Z4=rvE{ zUV*l4-O%{5P|R@v!($1|7((}kj^Y2xk*GvsJ%T=-MDY7bB%Vg%StPzW0obc%Z!AH} zr6Pcqicmq){TNFJBw3ll4mG9*YoyIVWAtIrK&Kh?l|P)0G5)M78F3R4ReEbc(z5az zv^r_`!XW>|#+X#}yz-GQ%FqO;@M1)yUyz~$|KwsWmf1!YYTsY&G5Q}(^;MM5_pJra z@c-B-t*8AzHp)*I@gE=LStxo7MQ@?#{q+?+R`F`an;uv5lpDNs&nJbz{KhjH{R7W# zEGKDsTWx!%&gUkuh3pOo{o{i9P(TZtOl0`)_=Y_49j|7q4o;=s>GtEcG{g_%(RkPw z<*fgDV9JpNOdWEdy-J$LjDvmkB-959HvSzvW&lLFOQynMoM0@^ z8dj@3!wLT){}V`v2y^|6&TCIg5e&j5{IwoYcKZIPwjn}Yn?!3``-$EDD83%a+YZU7 z-R&FGDSaJ|p28gBW z!4FgL!X9&{41!Pa_t)HUKzBw2RbkGRY?ja?PPKwW+a2`doYo5XUY#v<0(_f49>(5p z_+*ATw*~b}mw)S)z_7Illkm5AjQ;=SV!+ST|I6w7|LYhMZlV7_z_ZZ*7yAD~|Nraj z|1ayWHjj1=8;6*R>9C5)qfAivVsXum;~rn5u5UhfhnJmiOGN~Mm*z)RJPv?M+pXrX zEtdJhP>7XrJ!{KAg14`}Es?|68e52qgPfO*4!p*oGTUbvjuW-wWT4&YF^ii zgS-}yAgT@c8wft7omX}{44vN=k@@SdMe9-_1#;D`&dZRc>Hx^mZ>rGl8E`~sb3YWV z;W&rH6L899lgGi{i~m~=1u+Ilxt;A7VNQE#jCt5{#&-hBa+v=CM46W*WEb04`QLHA zG=R-o?`cX5rr@u5%**m_ZVw&@Z+`;mzl-!GZ+$+m#aR1ZhS%q-LHYYHwEe&3lXL%b zJnHuD@%HB|{eNSp`By{m;ey&&B=EzyAGCPw)*;ncj3?98;3-vlu%0 zcKf9`@xIOgSpMUcCr?8H1jS}ZPP4>cn8Uk|5!{8W{^i~l{QXF5jfa@97l){Y38A-N zdX#5T0?4Mtgr{0XtNdlRjdpztiH%a219}c)gyu~E#-7w=}6`6JLWsNCJ$M6i%ftQ1?7;y{DApP4@hypiEqWLucm(KrWprFcS{Q|BSoC zIG~WZggoJ~w&t%DbqHT-pk`wm@}WlHyu;boCo?p;Bai#tQOzj4_%oW;3|qD>%-1Vf z)B*D!HYAEoCeIO@>T)1-U&(i8(C^(?!$IsW3*n(efEyKxo8|8V_$q?4 zFSu{0#Pt?Iz8155ny#E_W)CcOHz>)ou+QKJo|36zFf(y7>bJ^NFyGi)BknoluL~i* z9|IL0D*`Pfj(~Ddjm-|zxM2@!NNAPg=vlDjVRbe~%w`CU0O~=pQ=(j|Y@`cOiO#^A zL&`#DJOWlCONRo3At?H5Ypxta_*&T$9`OVs6O^lEx*kO#{uMJ2FMMn@M?tz$$qtcf ztusjR$Q&#}r6N3Rt@)I_8WS-4QIjTe&EKzYzGS9BY)c*=on{gKU?KeZtzyRMdZt-T zjQm;m1`ra8%7`73U0u^dwu&!c5slk4A2s9V^Xf1rZf%VFd<+f6ayfUwt-0KK9|JU- z&sZqsFxp*s|7dq2AHq*myK4TyAxwuiesnnit&;#Y-@b*x{5?69h>#Miw-BjYSp0Y6 z(p#|K=dc0|#o5R1WsoB%qfGPnD?zm^lN!K8R3kK|kAclz)_3Yuga&=SU^97F##wYl z>gqUDrLL(p`UBqG)$l5HR$I%tvlxIbf}M_F-#1I6M*RnQ%B^9t;uev(A~)(#a|pJF zj0M14Pnc*pKsI#P36OFtoxpZI9i9_)Lj8jW5?Ul>37C)Doj&-ccy{o0n_o*05@$Wd z#iRBuQZY~AUJ5!FK&}WzzxJ&JRUMq5hOvK&_pN;aeTw|iPFPw9SzTAN!Inwnf|QX# zTzTFF)Y~x2k68YTa*Kw$JGTTCwK@9|djhMSa_I76k(n`HCb|fICKE%`^C)DwTL;Oq zv)Gi#Gvw9?S*P_dO24bXmS_^&@pTHklst*|&=kdC9c27~yNfPC4c(n3XKQ1K>|B7@ zp#Y)7dBL&k*0h)c3tJ2cKVRjfLf%&Dy0(Z2Po4*`xoMvEVhJuU*i>B(&tq?#7H1zZ z7=uUpmyA_Re3sgGrg$ri{NbrDwRpC=U~wpKP3QTBjaYF`cnak~LZ5~Z_=XBjG`{%3 z_Bw9LQ|$n{`i)qt(Ps4FGg(L_w%kV>XlgjriNs}?>!AdTaJ21wE}Xf70`B|(WW z*#||)HJ6Z65h9mP>V3C=CY?9?`ItF)Wl_kd;Cd<8u9Twxgh)s;0OhKhMVN&|bZg~E zPD0fY1KSO;M>O@iq0_IaJ$u;&JwBm$-ct!~cWV~G?f$}Flq6IVU(Tdh1abzc$sA6h z4%vJpe7R~(e<2<{-h1;FPcSxjcIrFg<(_!Ezx~7JVO@p6mSi(BMmMAG$c4_*pvoD% zxe1V}b~9XethysB3(X3f-u&duZQu46_k`Y+-A*lXMk%EYS;j99m1v_}PgSkuWyO16 zxF)Dk_q1|N(512~*A&3Km1{b9YUP@$(A{O_nhn>zlb+}t^~_x2eow8^Q7Fx7I#aK_ z`@&0#p8sLy+B?BSZI;7nP#KZ$Nc-u=f>~npZc>pE)nXCw0ZxiUo^%w#fK{GUfrEg$ zn_I6p_ksWB7ohG~OHsQlc+0pZu`Q7uzN8-h} z+iMGU`_ms1;tTYn7*R$KVtp&r9^WlWTg8^#fNr8HbR;*JvK+V#U&7xod;Ka`dptV9 z6v>~YOhZLs{*ek{yRgE*#pP{ znLZCzlvXw``LlE8`;XmAOqi(;L~J`Z9>CPlaH2GoObTjbXp9CcQ&Foup*B|3aK#B! zj%oEBxHle-Y@E`w4y`4uxAB8AkBWL|rVv<}PYX*rCO^X6qttmcG=6}OR7dFH~K=;qK_loKdJsMUd z$HLOmdi&kGKKx7U80nC=$V=p0ik&yCW7`JIiXfnzSGwC|Z$A3zu2v5Dh5sSUP+#(!oNL8!g8D z7M|gTQyQC7oSNy8!()ZX%v>;WPca1?ZplXj>FZipNi{;d3Vg%54adrMT>DqgV!SXS zbG^>cG(}+PN_W@0%Aj{y%M#QTdR91a6T6|{$F1`Lrdj+BOYAmvb-6-kcU&>6S5<6GYB(u{L)PjsA?)r|6&G?aVMtT8%1tHOlw@ zF@am}XCiAM^Cz6ge~S5bzkHkHyp!Tv-f=BQq(wz8!M-?Ge>t4U{B!-Ov^4T{cT?D*X#M?G;NUXtd1>4>6WAP;ZCFE1U=6U#y+1*ZO$m=nl&8fe(O{_ z4e4G2AV|iJkIUPGF^bGf5GUP)ZmK)w_z)aA5$I0LXWxkEfMA+%tj)ia?hdl6XzuEn zIb_e1=5$31)*CfUa^stal!Q_-`H-sJ3iG{|TddWusVr5^a`4%E*_ymyq?stoZzCp&WJf z?1;>)47D=ydq<&JJipgt;y+orU+*~q#Ekf_PfAb9>HH7tPZ#l@9^_f%|5}8FU4(`G z+lGY&092}E1~8fV8&x0gtJU1cI<^5TDAd=FC^dxgr#e0%UjpqC1Ef0^z6l2FuXK%< z$RH`gtQ%pl7z5&ml(pJ+d`oZFxiR#n3$7z=lA(I9$%(=CR7?WOtF66iFrzcMUagi- z(B0Jcl^+IsM>Q{@$#x(D-;ac;oK!#CZ9{r4I*uS#B6W|`V`G-(PoBzUjRE|cM#k$lxK zufm)PO#XM%Aw|%1x^K%nrI3rZ0U)9}3FT7_1I6V_?bBr8lR`!wcOp6!)0!+u`R9YM zaFUA>107dRD4lZ=cDTW?@GdMwLq7`rNPo6kl<#0}Kzms#X6i;jksSbU3If4#bM@oq z>i;XPe%pAr`fg=;?PP^;D!eNfa(cuCastTxGRA~EVp z^R{%bmExc#Q<&((ZuxoHU;d^v9fU88!dzjU%968!+yIrAV|98{MqYddE|Z$TUKf*I z9A5_O{6=R3DK9er{Z*fI{y)q{{;>J~${SCfrt^Pnz{|z{?;)PW{%^7WTkQY-w)?-- zW={Sj1xWr4+d`No>iz*o?ZUuhN@G$k_PVUR2BCkSD?b$u_=Wcz2ZNpt`2|yZ+=@9D zp`024UmQ5aeE_8@w$eghE7iT|)9y~*N;yR(aRvScVK((S{V(ueH{K%g(J zm5C4ZsS)a;s=coCCUsM{>Aff&W|@mO1R%3EUZXzTv-`u84EV$a{-16uF?6>-5xU#A zp*_Cv#aDcK5&es$de*fMyke|xmJkFv)f4)9SHl}P{#nt#yEV#Z_~D!mSN_@46xX1t z=e^^uRPvq8P=$6w?P{+2uRxrSrg70-snNaM9__kd)2jVR6-RLYnOFTrU$~2TjvFbLcQk2X}c+|t03UoG2J-w$D_{bH@CEBr5R;gvU!=?!A5-yJm?d{0iF!q%umav11xl6}QZWom^t1p|@sXVzbI zwPXU2f1A&}0md*VD;fI>;LK}L81e>wW8AKqN`5MMQ<%4{=F%L!Jcbe{MOjghck9Z4 zVIWVnJQa7a&2U;(p1Kd)i`$#@@eO8<=g9&6FsZ|zHdRqOjCo#ZYS@qb@5#*RuW-L5QT@zaWT2Y~7_UvT7WWCzm?z$Uw~1?C zC)Y$y-T5X&<;UsQy%jG|r-+On$k$@%o7A(w z+CGNBgrG~pd&klF1+>U*&cE-*S!&C>(e~ul_fxF7EhBQ+%<76{mu<~Nu^=)+!Z`9- z^2ljDN>!g(2J9NF*RboljEAF}paWIb>}sP9bg^c4GfcNWx#hfuCs1b^U0jOfep)H8 z2~0~fn9>}Nnl6RzZ0>$v!^>8&_)aV(@)jy3QNwsHbZzzV(LsIR{tO$kp=WNi>i6>A zD&8wKXI%OZLQY;mHAK-w%iaje+;+du%k49wHmEjiJ>U^40(os^Q1@@)n?FhC&=&wz zOoj{$d7Gvswq~#SLP&f#edaszd`gIeylzhO(RX{-v9HQk+IUM|-|KgHz;<(;!~%1T z;~fXmYX8>bc=v(Ou{`D+2N%n^hQUHk@)(^ynb9%&&Ap(Ky&-WA{BDVUDj_+CJ=iU- zk&H6CvKi`rp4yS&Q1&~lPUg7UB#v`wH_cO%>t@GEv-xKSNb@@tu|grn4OF?lUy`l?SoJ!EAD!6X(*r<@l{MdWe8;t~y3CI%!6mj5rZmH>WyuDPm}X1F+EH zmUOe89c{%K%skKNdsEQo;);}zoyiu{MjgLV+#T7k0Y9&R{4oePwJ1X_E;U@SePvk21VZ1$Qy$ z?y02GImqX9uA9u?H*`=T=bQ}HXLKypGdifBw*xkUUN$QQs(6i&&b>XW3tNMW%Q41A zz&L?l1)XUB0O8M8Umv9q$dNP*oq0l$2v{+jW?6; z&5}UQ8GT0`Bu`=UecD$sm-llK^(KY>p$Iy%lJy9I)P#iP z95p|77D~}nN)&s`k8w*V{u#Exf1#8|u~oE(fibCxZ@={@P7M2l2C|4e2I#ZfRbC!Y zgo@iW7rtXEuv52W8g*Z+x|v#1aYSSpz;xc!fV%@$fJnb3>5Nq*k5ZZcRDc?6Ez{mV zMY$9f2g73e!*@WjP|O|6#2`XA2z5URUM0E;}!whKkx|TCXS_z zidlS8s{wxo1k-Eh4#YOSL)cO|BY^c2G<=Z zEsy#s1(s(Es;qD|mD`_#Z$cGk+)4TxJX@z?@>ZyMFIkj)d?d$NRg)Uw&o@^sU5+n; zCnCPM9Nna1)aI;Wc3*6vjIk-@v?Iidus>3MQki;r5$)4c~=&HVa-Ko~=tS z$XQruhb=!6n_Gw5d%G%AbR-TAHxG{vYW~sgzjyb3-1Y5<*3bYj54Ihl4j3seQ3BxE z`e)#T95gpRL?O^e;{H|OqraISVfiew#FuFdnU}mwgvyC}MP`n6y8SMv=9s4CW0M#n z-S)Dvmw*ZRwjIS(Mf-nbo$e_}Y6LGk=M&whnFarYhji8=2II0cL61fIK-i^Sf&OVYmJQ`?g@PmN33d+LsTV z4?1WE(H%wrXd{897T~hT z*+>3~aY~;fRf&8bTg}lNYXCEg}?d&7d39m$|Udzf9 zWjc12jx;3${MmqR(FH)k)L?ok3Q2->QuO-$=D(5u9G|D5@;%+7BiMBLU#XN!>G*$7 zo|G5z|3RKb{D*~G*upLBZ|fH3nK*v{`-;^r>zzjyJkF6k+lY_AjU|o+7bawCws(bZ zu`W3b21-So%dst^6@v{XY|HROx`~>Yvb)w`zGDTkY7E@!Y(t2KpBk(>#}JaLGHv$7 z?YCodrHqYDmG?B6L~N5GUDw?}$MT^h^fa5kg439aD0DCws4mGd&vMKgJ|jPE>3&ZI2Zu=H{RvJwJPITn)~p_Q8% zdg3$|6e>TPkM++g(gdf3xSt`&@t;@Jx~W_;gEWo2 zS~3Uas?G2sq_`>+fJp>-6FFFO;MZj8%fFK($Lr01USSSBZ;f%+*sk40Cv?4nwsd8< z?_CPw>r28%qm!+pX29lfkon`xs@dAiA9~o;6;>MbDQP5gk)3iX$2lYsRqMj}Bz(FD2W z94!3rIuJS8^lsaO&sna>SJ)OiX6YPS&P;!w1!V3sl8d-N|Fc{f&V^OE>DHk!7$(pTQ>Ndybnuh5{5CFcBTgIIn)k)3~gf(G-RNqL65!hb#!TjRnuDmE!RZ*UZ+T|d1^ZUWX*)X>)iQM zjes?0?}hTe?_~ZRCNXUx^5(HI7s0^RZZm@!0XFt9Q_LjElzux#3>TGY#*6gommA}7 znoK9YM(p!KWzN}NCd%3E8k}kmNH^$&;!9OAFVgvSJQ&OUv4WW`o?Aa@|GzH~{%vOb zk7v))@juo#;Pb-&?*X2L|KGy@Z{h#<_x1lXd28u1m6Zfu-KpYrK_-40x<29xW?3e8 z;t-@4TZF~BnSS2_N(JcS3$7A;!_}(e$P&dP%v=^3Y={sC(nfEgdawL zD=W#Xos*Sshq>CZx@()&ko+YwR+(4`?xq0q`kFm}y8h}>VE3!gO3i?3qNX;c+M)!& zvvTM%uBeqQ{VII=j?vAy*r(8efEMzA(m3$m4z#)m$BK7SDuFE^;$-PnDQf5|kDdIX zx0w7EZ`9F2nch5}&BzR#S1J6^nSIY9pEOc`_PYw8HwCe8%*z z^9Asi`(;iNd+Z1P3U=x`T=7HSB$!61lXMvbl)plgni!)F7Mv7T1mGlAaq7Uoj;pJc zla)ePNbSni=Q2ih)@}F^{NJ+LVM`|<>;(MDL&rC`OzL9!qGI02tVD_&)58Tit)v1j zs)5x_`Vm>_=~9fp0)w&QH)NbX7q&vc(tw`>9_ma3Ostv+>{L-Y{WA8+1kuKP%rGB} zZNabVz>jq56lqX?2o!;EUZlUZ8KJ2c=f8EVKKVo9<{nd)89i6z2u&f)q!IF^B=)OHCg*&YABCcn-5DfNnEQT8XAE~~ zOD0MXEmc5u%)GR1p3eKY)oTtlxZ@G2U{LzMk7#*}`{N6WqQS!4;&Q8=6(DlAK@NbFMEm-T$*1V%klt!GNJT5s2TD@ zvSQs*)g%>HR~BB&p9HIdfr<}AHTrI+tmdW}l2 z-Ldovm0r1H=~XJdddJcMl@2oc@a+_w$t&<|U1OsBzs>qQYjvKw0O58VcQrV7G}oqk z=;}4ukEl%ZckLFPx1Qkus1*(Wo&;kpeDY_y!)mgT#vuPr*Jc(0?4R}1T`%23+VrZK zIl|4ZooWNFH_2rG%ZdL?krM7R0Q9W?%Mq-epOuu= ztty+gRz^3}@m@2)cG_AAOkEDY7?SQ!YEcf}M4-=Z9%jI$$aty$-V4{_xtGW2e-s%J z6+{$h_v!|KO5U?)PbTSqmG#W||HiXti~JuC@+{8(7w7+r^Z&o?`9CG;9ryV>jYvpG z?tZbj#y3JZL@g`_e&m1fL!2^zOI4rqc92O61hk6xoB&efpX{60ph5K1OD>6AfrtMp zpRO`18jL!TKjh}S{mZIlLIG@K##Q)04gr{y+3Vs3FS;|;ph(P(#znK+Z!{=V8ufUg z!QhjQ|JvvjJKx^(!aFPeYo)xA_WyfUezI8qAL4-}bPPKl9(!BFLA)ZO&qh z)tnuokgC%=gdl(D4&fWaP`IsR9$aiGe~-t=e_rS>diUSPjQFn`Pu8Dh;(u43E#&`0 zJi#(g)7$R##BKI^g23-(uP5$nuP5$huP5f*>*Z76wtGGC`FlO_*?T>4+r1w5{l4~k zdRuT0dp+@)dp+)1daoxY?e)a8y`Gr0*Auh$dSd!s4;ExESbqGvzWI{>^y=5Gm{>OP zYWg9#SbY)uI``qAqcZbh*#pclhzH0sVPGE00oSR1W2yodHXgx8l~O5&74@GF7Wa<)I6@-SMuUhR{>^@+Dpe zYpWXpzWKROJo{LXqr^!YG!@-Jd+y>*8M!jU_6o$x80Is1z5iSQxq!uQ!Q_GY4GgXv*(hYFvA+H^Crx#p1fqxK*1?1)cL;(AybmhzF=QWXDS`1bYUrZ2ZO8D z2uejjH!`t43sBNa+Sr*k(jEOX#~6cROde+;=`Fu_5|4}K^%V$M>^*?NV&6K4A1GGg z=WpWpM67-%cKH+#em3d%!2lX>(wp;kwTjYRzYcZ)fnsOSYd3mvhZ+DNfiPYchT3dRufk=Zd81w zEMaikaZ9ZF^mX&9x&VrEpilj&B!UA@-2yCg2HX$LD3ZwTiJ*78p27GyeLFX!F|~*1 zckdb2pY9mWBwQB`TFqW_sFwq|x_KzaJv_M7!%5;lA!v4PgIT4fYmTVx_8U`#dU`76 zh)t_bnxeAOl(>OD*)3^EJkh;~fuZrBz9!@-;#*8h0{d$IVk!(xSsmIU-A$)b0zZw< zx-#DzNh?N2;mEm8ba*ogyhgNC7M;_w`<>=+n}VQ~k$-v}RUvT#TauD>xV_~I45 zuy_W~&jslvhJnaE+(O8Ke!7u@-o|%D4Q+rsy+L!70;YG39AN(K0te6~5nNa0{TS@f zwWV-Tzti>Sl9VRRkEk=#tTEGu);dW8XT|G6y;B#&N~w)YV%Mz(h;!R&b~5!a-5kKq z%z8G8fH(dDeo9f$V;=EjQy z;(w{y|Haz=SN1^&&L$@)Hj(&Fl)~qFF$2+6ZgWF@x&*1!jEt(n)!D0%*2MxMXHg-+ zI^!_DqJkmi@oa{&Kwm2}4!;Vetx_{mVdV$buWA(*$`O`SD1ltAQtg7i1bx=eR0&pe zQ%hcf(8Mh#>hmz+62LR=8%usH@7zkHkPH;<52Fl@P=QsgL-mGc5<0M0#T4>{tvj@s zUte7Ovz&)MjB4B`Wkasf*bP{x|5+|5>T)@ISfNlcD22L#)$e3y=N{xc z46_<&Jt9O(P&u)nrlv!S-~vWaSnQxjS{9o)-nz`}@gicl4F%Rbw#u?fEXd+R^|GcG zH8P0PtfK08QrGCeENG#<8vR%P1o)bXZu!Y`W-?xGk9#rZ=~Yz?#dE5ojsId{YVi~B zE@t(`$r>!H+0DZt_aX#9*Pw^tb2=qT54XN5>25$;CwhL;?3A-oLhE_y2uAr4%JE;t zpcOh$gtdW6^R@Qy%+R5rGy4#Bt<-kt4jA6L?FoHw$%s8xJ1K*1z7U$xB5{(cof@UF zRIJkJHAf(`V533BC8IE#NG1XP(55qnZd63u678r(sJYv?XkL=0>&|zJcC^3lroK=+ z^hL6t+H43BT7p4JjM0E4Mmr4EHk3a|rH415p2ejK@jiD?VUK1j8Hcap7+|c9@(?I& z=In8*XS885I8d7?HLf$@M50D6A?6~*G-Bi}h)%n0;>0YQwq5j@gi`aFuz8nK%;=e# zTkg7BPH*F!dh9)*Ue=O)1Z2axZP`mT-pS(Tge)x-w&d~D7*Mex<`$<)6;FT1yaBp2 z9w*VZj~L)u{1djUS~~zZX92WT1^$4X<#yWOhH}SYw{8&#idF)v(#;TtXVB3MYoTa zL=cKNvTJEmT$5hGZ!snL84a_{mtH?5&kMC~C2Uga_UK$NNPaG$VMs)mek~_TCxM~sK}}n}!HR>ZZdluT?c$cC2=M?>< z8-&*7U%U{KIAY6%C66p=lG-&A{EzkjY#-KN@)E7BtqP>!GIaqtiroYdHx%Hl!NnyM zOW-Yq%Sy>TLe{pLC_AMT+d^9i^>5X=TstHgN)&8f$?4|KX(cDxKFL_AK%J5k%$X^x zsam1zlKHmNiH1-sQgOa1uKBs9xX)ZEe@?BFIvkQ9=SBf~!p~WIT-JD(T~g5qXF`L? zLTdY`Rr{Jfk({ky4QQjwsqK4elhCx*IPqm3o>U<9X?QIaK+HJWT_*#y*)p3t(yO{q zYF3xjv|09X3@c))cs?7Icm1VDh3DCZa!sir(ON=Jlus!Ot1Y4O=+SSnWj z`0ToP?)l;Q&k=vuzEB%8?tkNxp8u5!%>O4}2p{M9o6mn|{P_w9|G39CX32jT?ezWs zMf|4+dT7YiZWYZ`>al{eJl#Om2URy`UzLGSI$9n?rL^%4!88*z0UE#z%#!G5;Up;qfn?!QTC>KN!YeqK#SOzp;^7|DSCv?teeXGrq)q zd@(uqQt=+Vy;k$0r*DONFPh1@`~|?pez*Tiv(b((6ZLm*aOTMigK?YRc_8R@T*;#Q zvw;C7o8Cq9eJnK&4{xDv@4tQZZK(nK_ci-BW}M&`P^|N9sfgvQ-;KCG0v3)F&k1Ge z1fXy~SwSf1!!rEQqQ8dYKK(mto+W?z)rjXm4el3f`&f{KB+fm8Rk7oT|Oa|VsJdf{b?(gj# z)*c6<)fSHfb%Cw$_}3Sk2d^6kdq?|Q^-qOxtymP|xw!n$7OQUs1|pW{(}K@{8kaW# zr?i&Q$He1bP5qzJfry}ie-+5nI9<;eBT~w$w1v6g9pUS$GTIs=yO7u38!xx_>syC= z`#))zabH7u`X%0KRF5tKe{Ubw-)Nw-cr+U*nF1ul51Ttjb@aIAJ5Dl9`kaO3Q{`hK zS(c7J1*K?8Ms4=sGQ_xwho=K_46{40-V&(|rH3(Rdo>1dN$_q*93P9-k9zQ4ZST}S zi4)9fpiS^RA{=Z0_$6+Q2Cxm}yxyZKIe+->DEWNoAhR*y-LX#B)6G2+tL-~B$Z0RT zr@eUoc5^Aw=?)V-S~?q}qhy8}t$8E!pelIOi?C-i}oRu?@CkfOJY#3 z+LIBi+zP=1s%7Psi?JjgX^3vWGoZ7^U#+$um$80~hpzjZQ@O*p^HpD+qgurg zvc?JHPEtwy_M4%B%cR(c6ruTKZuOGC*+q$b(D`f17G}7+_87leT@i%?c?;d01%~8{M_Xzm}uuQ+i<1jBHf` z6Q=OEGO<8O%O}0G(X#RQU*hYpHIRd04oP4QnN5;hRwML?(S(g(FG+R0FcBSBzE0{c zRJgi2iI}shHl)GD@^++2<{{18?2^YXljLR^w&GCf@p`@#g-+sZ$Z1E5a4F)}@p^2! z6bvQNKSwy&bLuN}STeMtN+g+D%_PP}NO`OkfE~5xVRGK>D4#Pk9a+KRx6hw*46*`8 z!kAc0buwM-YdR`YT&kV}cKA-jm>H#?!6t5>-tm(#F% z^(7eKlBC)4NbAk54R}Co84VqvKTjlOB(yDhh#bVv07H#^Di|M9 zpvG^&yuSfU86Q)tqp(B4EzDWm7pp%)4M8hsHNaY-(&s4PeiP`zthW()IE!aCiB(;L8C6uH)1me=U3?Q zr~4e9-+4fIOCjwLP|Yi$g&Z$=iwKgpe=Pgo7drjB%lTjB+0(`O-{M(3i)ZmHp2f3x R7S9)X{y*%+(TxBw0sz+tu+RVi literal 26746 zcmV)2K+L}%iwFP!000001MFOFbK5qy?q~c8teaU|9a*;Q*xkg_nRODo^_?Wn#Ljkl z+Z_)?LJ}H^)B>axHOYU!=LH}^O0v^V+MT;w&2}r1z`?gxq5dq$%>K6Zl+qL z+J5o*Kl|`GK0c;@!>9Xic=_;);oAd_#AE>V%sr}^WP>l~C4Uf}DsZO;zq%VIvR%3m1d^8*? z@$csO&(G)koc-_l#pUiyxl-G`-)Rl>hp)dr+U)=Ez2pCf2Zs;8IQpIVX?_07{lBIE z!Ninik{4Eg)-^c(KisJQhYwfue{^tg@Wme@#Q$>rSMyYrdf=ww)v}xx`JVn|Y>L5r zDJ~N=%lyw-CY~ra^}k^7AUFBX>L%557rtl3L`-z9EznE(naIp&5B}k4?VmTs&f(Ea zz14%H$j4?PoK5yFUcWkjw0|>G`Ck0H)U!E1fNA4L`vaU8{l0+&2DYmmJ*(H4*rJ-d zU0@4$)OuBwCW~Ku1z!^SW~-e3U8;%ukI!{2|0f-P{xyC>{C_wc4*!h*f52x|{{wKf za``#exG(;%(Lccd<3Hp7AMjb#e~9s)Z;iY4KioeY9rw-yj58Rz~<8? z`_E%}YOPxOxzcKt%CRkG(v_*nMN1gB+KvjRJDU$rNz{#`t^QYKto9N|33-8=vHbBz zx%*44yz`6aXCLK1{|WEPsm?{C5qdAdUUX6xb}93sL`ELV5`JvAwY0rO6Rj>Qo68~m z7#mS9_ZPXF{>BAWl4$45DAS+5?pjHVjdkUXvXctCC@az!b~uV{HD=M;!akPgNK6J| zK{6}6=*;Q(+5R2;ISueS-OS*@uVV0usNK(Dmm4M;8J6dxJHq7S0$xe^K3e<15b1vu z(SFwuZ`tjqk$?ONWP?R`iW~G!QAvLI(8!=|q_~HUpl5HvBIWL!-^Ei&e6aa<^TL+0 zvF>jk;Jauma_b7B0mZ477i@i!sMhVO@#_vptySOP{0-|8?TG1nSb?Z|2M_h9!_22D zLCUTgVs`f)ydU=aAG?a_8gfJg9A@jm!Nv*ub$qH*8>Nj0f0uv#YdxsN;Tn-Z4!K_> zYfX*VBSVuhf0^rSd}|{+?fANByFhSvcat#hBi)DwljW}yjr$bQe6qQ$vzJYAvpe>n zC8Y<4>!T=a61`!~I&}#5A?^?ctjq#clKj^MhuEjS+}+)cWJN^0m=fhQCLxncT5Su= zajWOm=%!{|`tOZ9GQi@eCntiZVT`|HTG(WF+T`wOlMT~Cbh>9r*7`aEO@OjPk!ifX@m5lQO9+ zuJ`ov#jDq6ub%(#4dp_3`VIIpKE3(=^7XT;AL;8;{Qggh>2s@ZHxAhyHiHf}k2=6n zjnCxkLeffvjzbTLgX|f`&|>h~gpdT%_yETH0Zb~$vb9mDP_TrV=v?l84-|HiHQ4~E z0?`u;a36qVD!1LsWV1#T`XhY>jdgjBS#HelL!`?OEzPdo z%l(Ug4tby)e!@tf%CGinaeUbO@L{t3D`gQG_#I4aWAMR{fYBuK&7bP2n?I4r+69c< zoo@doy-|R^Q-8mU(rC+{rm=gJ^B#8m@pG!@->eWWDSRIS$ehbM$Z^UO|MA`W&;M!l z|DInwJ$rd|_PN)%yZ?81wC4Qp;labN|Lp($0iWP&-@be!zdd_-_WJa>eD&rDSc3G{ z5c~Q+v~`Fu5BlVwlAL)uEg;#PUZf=aJauaJlr43 zH&>@ZoaEGrf|9f(LEudG(HQAT;Z~({5D0lm*PO062?@ zRWrGmVp>sEIW4TCt~F?_EJWp4gTT_xRWZ|k+9soHZ7wOmVnBSOr3k`)t{rSpZrGT~ zA%v=Q(3A3qq5{m2(_WX7c_GPrh8-xdD9Dh$2Vg4~AlJE8Z&4T|)WAp|Um-(QkF~Y9 z8xVlkUmvYf%q^@B8@#MGapqP`FIK54(I~`J-Lirsv z@$HyA2xDYY0k(<(3Wce2@^rrlQ$ohkqTO45RiIWZ`mLo6@~DBh<~glZz@uHJN+O^b`^b?O|Ex&O7|oYNaSku^JB4toA4aSt=c;5X zRS-GIYO2xe1pF!u?U+J_9BUv%>p%vU6XWd;dOF+g6y5JXhjVBnjvBB%y^Sg*4ZJ~b;B zpwm*%-D9~k>``XoMA?=)n5Eb`=z;ve&%K#MxoI&qAXJo*qnDYUfSXg!bCi#L((A_> z2AX@6g-DI@dc^f<=0HNI3$0LN6g?r_`mG>UbQahU8$5YqFnDipf&{KZ9zW zu2&f_vk1mP1{AV7u2_IdOs=v%tifBt90P)Y%s!)3YKyc=m<`Gys9ms5Bmki~L)D`e zB3ikvKddOXU<01!Qhm3$i`RvV;^uyZ5rHEx@l4<2R1QGZRvHOi`2$iyFdehqW zXal1>JVv?K;}k)&L4aU$)PL={l%ERNAxBN5iH-t0=r`fZ+qz(DOBf7{3&eX7+PfPe zU!T2xaV1Y*K7;!C<+F?Hi_4c+^8E5O{CxGp#mjH|^4Z1J_3Mi#Z}1fjd~x~g;{4+2 zDL%ku_6LNV);xRk5AzonTuq==DV)ORgqAc;~ z4efx?L|=FY>M{a%fB`Xrp?R*EJ5hB4DMBJ|@;DQ9+ zldMAUj!P638aqH*|2h{zGjc0leG8%I8OCz&8WiJHnp#b95*z!FJhs53Pa(eFGD0Z4 zToGAqa*Wm{2~8sMY!EVAhc|~4jcI_-PN zM${mX@-2pFiip5^kt5z7(}Jj5N&*x|O-U(Ht{9pKEAK!Y)N{mMIaMVPvXHrv27peH z3--B&MrJF-+epjdDk1UIn@kJMsbDx@6r+}(QnLoI=E-ck7|5V{V|0zU z+2rIQGe`p!ATe-0i1WGuzyd`xH%V1gF5}f9=1?#P+l41{bacotc&4N%%n+0DDA9PD zk34=8Nv6yUqykKb)PEx1YCT7nKnw8jPVh7rQWgRrERS1}kSjmjyc#*3!z!4}U~e^P zfnx|oHuYhI1lpnlL!hmMz~d^*{zf?R4o3p02Q6vonW! zjaOoXxAat$2a3hqM;P35jgKM#hFSMrsLTUuCd)Z!EXM;pqR6|l>kTGEOdr_ZHy zQDU4iyBkAs-zQVH(->(|Xm1BXAK>MhRC47vHxz0Fe!Ipl!88DI&$MPE;axZ#CGy9d zmQ}B*0uog@E+J~rh`nlx`3cCD1PgogmsZf^h=#+sN2xIodc_hAnn$?17-JRG zf>aPAlwU=m6oNftiXv|`Hm#|k0c}D8A@%$7kzT;=wdg~l&%v$;SmF&d7j6`Cd&(+I zLl9^D<{{8RfQ^bm7A4v!y~IW>rqmFH(Ie3GXnI7DP@>5_L)c@oDP&rU(Sj;N;Lc!> zx2O~VN@&n*PkCNc5MAiJpOY{-MJwXTwGmGd0smlg@w0=V77CbtKw!0fcrRc+>IuE3 zV?o_D^7shXv&9E#le&mP*I|4b)mawu7m|}y?H2OZ=tU-LPKZV zRG^-mPbRgw(vppLP%$bDLIHTMpbV5w`^F2&2g^yC!dPgdXZ9&AVeestd?;7sK#e-N zh>R=�GZYV5hxU+bs0U&^wXQ>q{Qq2TElfA<>0e6d&o~9YCaqzm>c#vI=|pV<>uESy-s6d`NHh$I!P4LL(c( zU&I|pO|oe$Qr0H9!@H4scMDzav4Z4W8qm){4^vbz`WbsFp$87yORAFM4Fa+?=~r9@ zj~fyX2a-V4CJY6^09$6>r?{m75@_JlX@ckJh*rRUYi-nL>`7s{r%ZWp2A%-`Y8P`k zGRgR6eDFSyuV`;>%P_C%p8@hC-imDAD#;Xcm4pQeM&^5>oW1|1}utP8IY0~R1R zh)Pz1r#>;0f;jbe&Y?DJ86gTa&r}AyZFjb-(k{ertTHYOBMl9OPpC-_=}IqmUg&EPan$S_fp~Ca7>jjCrABK~~4C z&YU<15955Nwq2NkJn2C6oN9)cX>Q2XuFtCrTAh~+=P@gM!E;!o!cxgJMGF*mS>>oO zQO*^K3H>l|0fmOI$0j%2YsE6lkLNgS&72REF=304zmPfO+hhcLutT0@Dh3YCj$oJH zf#Ppb=!orvn`_dz4p_FovY*&p=!g%qhHuB=X&xO8)}5Xj)5guws1yZW9a`qD9WjP6_4=wj{&ZG+B;{#td-B0IZ?NE1p(wL-MmIGhQ*xs|Q;YiWzNr5UuCpJe1G%NZ zqv_F-&&8-)(ZbiA*8PreFK%qH_qer#=Z#5iHN3v^E!~!mOTw>sN{#)-aLMS`oa-^i zHT$9?#7>3dZ#oVylYBAg@pH+)fqow(ge zjL!E1U*O#oib_1q)*H@3!wm`_o(v=g-?toBmQJf$_f32W*0j{OWnF9f*y;lS*)@n_ zN(Wp6(e@;NL4`pQ6t?jH3F@iwK!2bVMPu4Wry%=!ATP$8*QuKVE?S=pU=Dzy{pTv3 zP$!QuN>rTkk+T3GiU~)DL1VAaaC(648o9%V%`@XK7y9FBaMwz^USC93NLZNUNQQv6 zv*WM7;HH=>0Dc5Wpjr+KH<7v*(llQ512-u>(65*1_(-1*+t`;eU0~}I*R3<-=DB?1 z!e4*F>2XKD@L=5Gr5!LYXJ%CfZmRjHh>tHIhfF-IY@)u14{f5mdKz>|&G%@U&-^P& zMC2U|bA#{sQ~%YANh)Z!zC2S@8RIy5HPcK>>w|QkLf~{$}fo3Y7pXnES zeRTQ6HJ2)|%@3x!^vyHs)`fd|zE#J415+;jS&*P!Hjg}MFOGlE!iX_zaTw0{{6!kv z^u&6KrN4#Q)YmN)Gv@Et?NwpW^f8ifil6i4j9~q9YRIF&qFv z=JjDO-J#k`i<}jZLiS1NVkzCU!v9PKPCzh7>Alq}sCf@F+@1G&_x`#lbE z8s0-750Lisq0}+<0&a}W=QRmQPoKa2otw1M?)t)|q!;fw4c^sA8jVJy(P%W1HR3Ul zA^yMv;5g3DRy?aFqnvogS?+0B@2q956f5HMnh{vt#PXfM%>(TkO3R`l$}Cx%BCDj# zfBY%k*0NXWETU6wB-0TfQ>nQ(gDt4CE%rmV99ZrNCj~RXT(15OyQBQ$Q8w);}2i} z;|57W^4vlZhB+{$HZRKFB~0*Ll3_B;ncHh^jFDlf20Rj7ScUq+3g2*i~pD)4(y85*C5YzjE z8mYlhy9_v0=?+eP^pG9A0(Qu?J>AY=B77<$L1v5WlW|}fXf;O=S1Z8NnHynmLU&h;fL;?)2b^2R&-<=|WmGLo*4O z-AG%^O`&|Ix^d(686DsloX0rG5{hV;nivz~?<|Kja1JB7lL-Sx9W>)-%Nd;X)Uzj*_N*Pm}U)OP&` zAZX*?n~gUI>W5d29d8$l|6vR8**~abhOHg-!`{}x*3NfSAUfjiZGHFZK)u@Ce$m(? zZ`~EBoieI7^}U0w#=Zx5e82U=ZB(hg4``Rv4_gPXcHbTtp*MM;Y61R3Xx8J@XN8smB!p`mi&cUZivm9g`H zOB&xJ54_#k#@6mN{`)Por+^c%jQV%LZAeV3-@PBUpmOY?Z0ARm1rpNE{}I?|SG}(P z$d1`R3VQ&W#&g@{3Sf$qJL}JPkp|BJpDjWQ5J7@q7rm&zu7B6qk37Q!RJAyhM{55~ zV{;3CKsvA<^z}AV1xC?-zr|jJ4^oJ#Lw91+kPoHHa10`^?Pwl>y0halNbAnEjIz%(sei#uCsI8Y!)#fYdJ>`trAJr@9isuagtH1bu z3ndTNO z`uzO&Jv!pF06Nshb>$=d6>yP^S!pZ`n9U}F;L?twZGYT z4Wleln>%~^6jhSX1ltFl94+OUIfd!i+F4Ie53x}}-BGbuYSDq{)PX#4G+ZiZvPzep z_uvEXx{~d5*N#dFTxaeuuj!Y^P{7_ZmKEa}x*zf8^2q3ipq`yv_97|+*Irr)L1C#C zk!R+li0o;SA-YGdjoS4T)&y8YR-XXs&Y({0$Fw4%5+=}@kG<1zV_Xs@y6w0Jkerb% z)7|#7olYnBAa3JPS+e1p67w0ZyCknuaQ+G!1s2mQXpG$VlZ z%If1abpTWxpvt}(cj7CxVF4tJ!+&*$N$b2_#>nTRUJ{p2hMp%r44Ns;yB&YsE5CWQ zyYpieT{8eZKB?EoET8ySYuG+R>$m3#MAgavk9J2T!!`zT`YL!`|5qdQJdbi#y?-p@ z4%wMnZmSZ8e>zcaY)St0QCtaumY3PZsRnb4dex}EP~WnYEq@h!4@(bFEy6OSdH>)b zkSu|pVIW=o6LT(KeK=9&@=9@5z`QttvVLwu-lFvK>1X~9wE9{l5l7JwN`Rtj+I#xsQi+{~A7Ws|SaniB+SOe8N36JkD;}e?Fy# zp|aW<>9;uXT<6A2Ch`4F$XiA6g7I?LGVcGhC61ed9B4;pGbf-mBFW`3u93Ta-pa*; zF)Om{=M&m3535>XUl55fg1$Rvar?bKx{6>bzUn3zN2e~!7I9ePrH!h;+45-r43AN1 zpX;*c{ead7qEnO>MRBc8Tm9~5w&k=qG`{hLp(q$Fg)YaQxrIWay^tSrdNqY$u zC07S0(2GYWCd5&d>Pk<>aKsfttjxzepj*0a#&jfy+R57IUG%W>QGCU*{Fzwf1xc5O zWaP;&a!xX`>u&_(zP1yzGS8h z9VRenb)rpMf=UGJw10^(E80f6f*_DXVV3^^{&c}V!H+E*qoKl?97~CFUHt(vcf7GSy`tyOK$) zLkjlABq&uwooTV+#X;gIwwuo<%ZYOdZ#=ewhX7z;iU2CBOzB)szIdS(y2a4Q1yFP( zEF1VV5K)!RX6oMLpaPfYO&r6CggH2sqj4~4n+u7ch93V4bl#@P7s_cwJad)~TbE*_y%0ag`_K3&97r+XgvQ7ncL1t^QfYSF zXcwPJGTifa1|K7J3S=aq%;JmZYE*L_Av~Z82Lp?tkbG2YvL2_JXu1HZ}tX@_hMDR0Aj< zev{5;qz+z#Xd#U9Ptawl(dFaE68{Ns&~e>Rr}5qt8E-pFpAD&PV zzgzYmPm4}s46=cOtFdZ}Z< z^4ziRthH$JB|Qc}zX87cR<9H7>Qd?L#-&UpA^Ico98;8E7&h1FvsTiiN@adh0eIK++`9SvFV;<5s*iYZI0srY&BC^)xpG0n z9O1cD)Dt`g9!sqMg>bx)h@T4<50KY-L**IzK(6qtqQ>Qj4xn1;S2NfLO#fTxLymcQ^?p> zNFll%pi_>-dFkD|v0Vm28qdVh49sh00D_NcwH_a)=c8a^{OIV30hA2l|%?oAT`<2x zuTH|bgDi;J+U7jK3KU-hIC`L+*Qrv_mA4Ygxo{*1NkFraa*NtI2t2$6)9L~ ze#RycSpn-(sq(mtQ|xM)w=($m+S=Os*N^S*?j>NAvi#Xtf4uQEx}`0zmY+WT`tjq{ zX_=O%Wm1S0H|Djra{^89W#Qfx#)FA_$dj(DjU$^kIf$FfRG3Oz_f7@ z#IP)g$eKd%K^U^lN|#@5U0_tkK<5oLEjLq6B&!zLTs*OkVMkpZt{xFuSBR6r_lR;+ zs7f<$JyeH4>(vP8!2cW-)WUWrHRk1Z`t zI~;xy#VAg%Q*7!iL{=8zm46WdkRDVTny<_ngM!O?2GSNhL~(RMB+TiD=~SBEMWTDQ zZR7`S3E@#ea&+8&NxEv1eJ`q!!T}|ojy)hrhyvb{Lwl2bXKARnUD6@QMexzeSZv!k z4Y44l7)j}B(9NOpIV3oXyGER_?9z>-SfNU>dp91T?hpF3O&~i13bLgH6_a~JG4R?g z4%}6(5(Ysv9GlJxc{NHw=&P&2t~-e|T$(c6Y;3yGFFe8?D7>uPvUrH4b44t$n2&5- zndP7>FdnEq$iwP|Iqz#)YvrG1tw!b5x$U-0r#&GfcBy2cP)x$xDkTzPtw-s%JgOqx z%o<+A+gN;^<;_^A%p!}b%t$dLu(3glkia52X7XaBd@`)(j3ZSap*o;X)GCp~P-#{| zvWt@gBl1fGFTVgha|TA+?F z^Dkd3KNazYBYg6ZZ}l)@ioJW{N&%rU(X3$0EchjaNouw1P;+d*I0Y4!l>fG*J8?1X zLdtKdb1TkpVs=5E3W0E@rsck^xMIX@bnJ{l8F+^Ae=uGkIZ2z>NwR|GItzV|@bbJ( zj@2lJGd7+40J^q%PZz({D8E^V~*!@V{)}p2qDE}a_ND&{`J?Hp>?fdmakn5 zJoUVGWbfxWDv}iw+2I3^Npwq%=_V?Y&XJ-_c^vE@kJ*UA%`8Wm5_^XDdi4o_14QUM z4aJnrd@I`fnK)`pY_nu!7Q}K_bZ%B!=~jC!38iQ#myYSk)etaEu?qyRX3dq;O4ilQ z7h8B#e0T3h17qD3o@PWVlYUGV_`P+|cx{02Lcpm&$pj#!zOQe;Z75Y$`yf$TL*8vl zX3Q*4Rn=+Zp7ZjQO`1Y70v*yNhFqeZX}tdGd9UQs30i7Uh<;jcC<#QBv0LGJ!poFR zf{alFdp(@c;}0K@DTH3xjyaYAv<*a55Vm}vB0tmWG35hd{xr{Mj3Ss)-#A94Ysd9j z*7CJdc5RLph`4<=P+t-7e~K!RiK}o8FKZB-dq(P;Z&YLVWpN>TReFg3837h4cfEcT zQF4A+zG@{GtlA|RQt>}P;=1eKbnI9zX{mFNS^u)0NDJWk&Fp{F$MOHh!TdYaf!urD z^B=3L8}suY_weNUUyiUg_3p?W)G?+1*DC9|_zzDiPv-vr_wiUe8gc)FHa&WtwWA?F z2Z`rwNDTOQ85C*SaBtEC-E4+SrIm8IXrDp~y6Cpw_c$g4{nFoY8RU)G$!HFae~I*_ z)kF0PJu&0qa4<~pD7reqIJ?6*8eNUZ=09v+l0PqnDQ__AAE=d%o}=K4qB>pI;?tY zs!~l2DM3(5KJ`bftEyT^)Hkf;z7*$$Z%Yd%=i%y+-lV`!@l|&eRE*)99Q@j6CipoQ>T%KP*L+A(s+O07JW58ppjA=>Gp^8a? zuA%p9KhtYVrE>haH7rG?k0lLRCUbUx1(;9m9v~T@_coy2BxIURVx(ph$5XRO{KP|R zuJio~p4|L@*}roQVA}k@x?ai6|Bu!m&FBAnc;@r}4X5Zjj}nrbx1OfO2|=WA2xWLP z%4^;ilNo?yG@6fsyu_Y$?#4M*<_As12+hpjwyL9UN65 zRTi|0040guFjiT}stYMnOTbj-BV(qWOr!)+7p=Ch+FV$At3|V9ua-j7tS;SU!=F7{ zh3MvaaXxv^AN@G`vvAJ3TnM{f*xIZy6l0+`nS>yMx0_kSMG z?LYVN6r5;D4L%X98kM)VyL*6Uh_Ut_AMHKxf8Vn$7MN|xmvBISe%=ou@_4aj48~=}1ALr)(^+)sZe;?1p`Tsgo|FpSZJsUs!KXa%5XWj?zLO6>y>=}udmPJf8WO=lcW0oYIu^Myz1@Mceb~lEBr8Q_0c6m;_BfSjyr_#>2|+{ms^GtdBGPlVST0Gykux&*%Spcyj&!JKO;|MgDI< zcjxbac|4c@_wmf{f1Ka{IKTh#uYdpJi^j|P+wFtq0ba#^P{nX2>7|h6vaR}i@fF&C z(qy?^fkQf5FIDwb09@K>w}u_HSjGU$Cm|Llek6+$lDRp8HRTH5hEX0Ad~BY;XS{Tf zlR^hGePgA$ol*ipQw!i9^T9YBrDUE_4+9XLjg}N^iPUhdFr}ZebrNAt5@<|gfJ2GEKP3YSpknUuSW)o{)**;!K zhw+A&bQaH3>I|bF$%!pw7X3SO9ZGRa!_&&z{lYun%EmPJ1Z|V2q&J^VtFI z=@_~=PKd^Iw4I18r|INO7Xo}}4b7!eNo2xi=?sVT=g6Et>z-JlwQxKDD(T@gx(=e- zmmmi4V4|~q+1A5DnLTXz?SegLBkmJ)k4s*M>Cb36qa4%$!4aKl`dLk%f^rwWAMhfc2i0_ z(xus9CT>ZaCSNW0yHRMC@~=szNkzKE%FiyoUPFuDG7wMZyve7m9XS0nl`z5LSFalN z7mHyj@_*|4EqT06++ECJ%mQLTWfD2p-~|+ z`w^@|;E(}as%bbCWKs^0vW%Jx?z)-X4PGcNgUE0`Uyiyx{gHDbSHN3IU&f=g))b=? zb|P=#J&qTaQj6G#Mgs|=mgPg76zMQuTJ-)Qp4|NJbmiUDG1>p8vhnC~&j07}#@gKf z=RThK{6C-n=kx#HcK%O~dfTD?@YZVmyF0*P0#xYsPq%huAK-KMLR`NtaJcRowX9Y zJUr+|7&)zr_ii*xA>H1B=Jjquho}4P7$IOV8*K)PEyq_Qiufk=bqgZGBA5h*>xL=1 z!mm+%5&gwnxG$2@ z$Ro0ld?E-64@~GEU!I)ALlbe2U)Rigw?={aIL2T1o1US#0o5(<9d?gGO>u;ibh5>p z5O@4h=g}ZeVp_TCF4ZUkUr(PdWC(!Q9Kr2xjRLYAMqQXu9G0QahxC~OA|rIa*#;pp zYPQdGE@ZU`2(EeQvNw{Dgoc|4(r{E48wD9G4!}H&Zrc6ujX6M9*~LAlw0`rwGbsMv z%Y5espe49H=zn0VzXZg@--zg8sWZS0wzwo)N(f2JFlZq*anAwn;%;2`X$BYuu>*=R z2YUnAhC&pm`j#0e0M|kwjIN#P`a%f*KyPJGfdoiFyYrAQT}Zu+LJNYCpMy8SybCj& ztwAw)O3^l0%_%3+swvZFb_ozZ{(`KlMXvcQUObU%sG(<#}Ga zhu3kK$f*JR7q>^e!HV<-vDNR6n#}-r^^A{(PczeJD_|#mJcJxaWhp2q zir}4sp`~3Q*s(8!wsOfYn@bAaFR5Vtw=3`sAWyZ>^xJnh|uTn^cM$ERQe-r`@X4KthrCd%Lpg205JOTs(H(Rl+}6jtZob>(hY zYHM(tfXvp|=GBYCtgc9Q*)|<07DP@+m?T>sIkiWb;&ao0U4r#l?t=OhoIsH^yV&Ri znpm@&8D?uAUvp8#W2iHUE-pn1la@+s`!doDhBP~)V+d$(yT0>X4R2D7)wgOPVb~RO zlOJCU_IAIqXD8D=$dt5@*x$tsh@(gwGU*?L-1gSewojKUj|S8px3zBTtWEmT!WxAu39uOvvVhG4)U8ukV5WY&VMki^U%MY~-Vwv& z>-B?+_g-ucSi`0%B zhtk@Z*CE9mR~yH1F70*(c|LRa3)bk}c522^`f^R@E&y7JL$#-Ipb_JWom&8~qxHHY zr`_^?m0km8LjMc-1(ztj98_9Q_75nCwC&Yd^YK?PdZ<7hs;rR=%OsnOI#NbAr!q_~ zVrYT`u+ZU_Y_-yt`58w8GF)Vn@D3F8nYbb&WT&#lq+Z9gUocJDb=Xb4X!C-3ql4~b zzeL)Xzuo|B63Z3bNd4WR-y{dcX;^l1|A{Nhcr@&+{I=769@zhpKfP#R>KRzJJ9g6 z+IoblP~0EYHjEl+(3(_#V%I;4uSRm)8Qo`}y3VtveF^QV*?TW1X#cftV#ViR?`o1o*YMKXSJ8%2ap$Hk2<{ep$DK4cqfD>3@r-SpP4d_wKNc z$@>4=#-sJz{SS{Gt!~Wq|9g0X#dIRS&JqAK&AbFq1b!z=01}vYu>_#`;MPk3EM=A@ zKrscby9B^8Zn*@&B5t9x~nAsmUWvY0Jki=1i){FO8`t5y9B_* ziAwu3l#k~s{Nami_Y(;`Fme@Xv+waN7&K0u4 z{UAjFSfbB5Iqky+Y1>NpQ_;`X$jF`q_a{rJ2ob`x%c%JNV<-l{S?Ir%pBO}~4a1k< zN_vyN1mhd>?1O$qq4T9MYcJK46RmRmolBK!B<_AeEe|qe)X@XD?SWJy`NNa~Sw#Np zzj8(EN@dG6)@n3&p{MbcW41QdRx<+p@^h(t`ne>%#9_<~72QsI=HgAx8M$tI31a0E z#xr?K{9H2oOPr~MHv!N%yDD3Ctqz_%dGbu?2_vl8K5N0)>WSw?69uOfXxuJJAye`V z>hmY%6VmHXoZO{_#yupIyS%5+>Ib6xKkvIpp>|&I!s~z3;gMSYmKG!Y+M@UU0aV_iFK3-4G(+;v)M6y{k5m{W zB5Fo>Be?Vu%v!25Xnq_F->X);eTmCz5lw{TDq@ET^wz~U>IW(~{wP_}g&$NxXQuGcc? zAE#|+X>Uwy;n~ewhUI4)h9e2*h5dG`*BYAXKxQ`&<+z6)H>NvD{3is>p()TqQif}R zsD*{`1fiZCiUnfRDwBq&6q*q?w9Ay1V<4f|&d+0DXx?*_Uc|2o&$nHUI3+DGO!FE; zPqvv(p#**$pLSV5u(V=yG>*^2a3v1Mala$HBf;I9$AdwyIXG#uK9J><(m@IT9hHzb zMr@6N_m}kbgub4LQRYAD3SYB=y)>pG(H}u0J|LyFs!Bg!g<%Fe2F7fd-NEiZY;S@p zO9vpg@dKfPA70`Ii)TRAE2Ujmg@KS6M;1a3^y7^T^cH?A8|W06oToFu^sQL{%U>q5B`C&aZ?bXiedw-_MK zb&J`~mBVy%08gftqjzD|iB*#HpADK!D~V?M#43cz>_8pQR7fy}RgZ=EysIr8Cr!U} z#8omzdCDsow$5|+l5LD8eG5+qwz?m2K<&Rnb;=m{YN!8g6t?h z$F&)xvnFm*2oO>NCu_)HSeaWc=dO9bvd>c$MIB8A9hiLNm0;)_mR-#t_00QCua(jg zk-71(jrw0I_J6Uo|CKhRUPs2$=$VcmV+?s`qE*20u%NhyR z8He!)${0o}wWa?@^^G#)@T=0=Dpey2D?c!QRjV*jjxeW23FLB>N>`K;^jSaCIatxn zOnD_jQ%7in0ha)taerj?4Uqj=O)_MleSiq-Km}IU4#lT56X?KVl{Ay5Y~7*FB=2{| zQ1e`UL>2D*n@SP-(5rEulnt4qu^BK=e^V)G>T*82TOm_9SPe}D%il_4XYS-1bhGYg z(<4MmP&qN9p{7HN;2e5TS?pkXTC$DpZ4=)N4lt?dPZe*@GoYj8h-=c9Sl1( zSc649y16@KEkXd~@iq*fErtcl4|9mnU4XQY%=o0yDWg)L&A4;~qa;E;IVu>mLkEhm zPNA}VZ4M^n=pcN}ue+HP-bFLx9g$toFGaMFF-wuOEu!`R%@_Fvz2(ot~mx6tD)Ql>3;M~EzY!z z7ECD)R3}P}s~k9ys98venMg5-7)2AJQ*VbjG0&zQ7kwt7Xg*^W?;^!gJ=1W@O;^j= zWt>xvy#_SXT2hRFR9sk>JynAyB-JU&tu(geLEIcrwxROje^`#@>2H}gK$phtBwF?n z16-+ZV99E<1AucTKwDMd1mrBY(J4-z-DFk+Cs<0Vd6luqbQ0WZg%PTs68&1X@`97*Qmvd>>NY;ss1`|qhld%8II?SL zQ(Tgn!LKnS`56uK%$J=%h3A!?w-Pofb$hfg7$iTJ&@d#2`@@_rrb%)Rx=wcnqNJK} zPW!wA#h43mm1EP7Mm^S5r3(}rzwvh4G%u;i6SZUq+)2A zo6VXd0$Vq>Xn}QEQyc=(7$Pxkt#_ zRugTf6tS(0h0wg~#ueHj$xxzUi*imjcTUPV*7ixpN)77d9AnPRSWWc|W#=rmosKnx zvb~107MkK(w>8Dxa;E$_Gf$?DuqBGq1A4;Gd3#*mc$c42(Fm8umzPX>`Dax7nmv%5 zrC<$cWAf?cduEZ)vgSDT`#e0TKH}vyZD% zXch5nIx0W)7ao+JSM-ANg;rrnJE$Y-zwPHGIcWK})~S%gu{Y|AAO=;;H>P-0|__HDQP zO1#`Ae@aPNWTyHd@AYedXV$lzj4?HoXvvmNU_?Fax zjD)V*VG+p9ii5TP@g1mh{=agG%bgwm`#)39|E;fYy{2!l9qt&qwlX-j^4;P>Mq9Iq+VaX4+)>cEm6tRk0!rOl|q=uUS3DajU1v8Kh za=$=e@x*8_cxP~l6E7%=?Jh;Qnhf3>oOauG1q{B;kZlHXuRAh8bp}fCAmVR)=22gB z#IYUGH}J~3X9~FKiVjMpbaJAt`Q4`&`i4%wIe=NPeg=$a14I z_sWy}{V$K6tUa3RfA{drjKy|O!|1-h;9ev3tWqDi2+sZV=43| zU-epa(W?`FY|WpTLvC9;yreJ3xJFz&8c zb5ZP=R*frk%8jwtxL&sSZrSk{%VuwtJ#;UUr50V$K@@;G%I2ARo$T1VWT#vtd#zh! zi>{Du8@J<9$^NjGe!1oqvs3SvO{?@HS|Z>ftERsMow4ML)jR{cM!@hJiBtd{nn(#99inR*1~x8+FHD zsXO^j-LaSIiZC%JV3UPTI5rK%O(!p0@Nq-oTm3MOxZ~R~p6pAd#nKH(KbbJ`)dgZA z995VM?MxxyC8eHmdVvLb`x58J&O#@jim|OPkAq>UHTo$C%8Oxy|NIn|qM`p&CHQGA z^doaIg+u(}uW4;#yTrYFKu1V4V?}ys0%^wekS~%L(&Se`x+E%1DZ4R9qOkD$gvO-Y zMU{d|hEm-(QUz4U+(!e+Gf4V9ZueS415Vx#Xv`=6dHF<1(gCY<4lfIeO}n zB03h_F@1kXEc|K>K6i}%MhM=bcLJl8ETa#xCUxBJbOvs*)6}`#0JC3Hoe0VYT}@>* zyBTvYQtrhY=3b%PD>ux&M7fu4n0uLWFW)eCK)HjQK72g|XZ#F2UDp^Z|F1JYPn(@5 zPC&RE$5joE9mBQR7P@*(J`t5^P7ma*s08W&J)`08aWK}zC$HHC>%m4EgZ$2xmQDiL zKI_$;FD=chH5_JVO*gf0?$ir#vq&cU-x&LEy2QT&OYoHVUu%`sO78yeCy(d*|M&6C z?Z0#T@7(_T_qG3e5A_{I0Q-`is;zGx2WnDiE`8qkZfmFcW^ecVtrv|wb*L=+Pi5_C z7*V99rqPxaE@(K@i``A{0W=P~h`S+$qQ3yy*m*&49^Sr2yV|%0V-qpEK4Ma)iW;5W z3XCn;IP0yf_$vm?=Ux4v4D3+0OAOrNLd#pwz?-s7ATh_M5b*2?mgxmxR*}4B?Sr85 z^j{B~s_BTfV$VzG?{UOlV7)4d3YH^CXd2jUJeR{Elx)IlxHPsIj4ZZ>n!?;3uv$gU z=Gs}o3$tX4e5t^Xa=3+=)_Te1vG~18`RMeT%NCgIlUueQj}n)kR&tHCTBek4NDR$D z{t{@n$?Us3dz%faFZUXaeE)dpHJY}&fCi_xp}}`Iqd~U)I#0oRcX|Ub5L~_ie5hp_ z{ur>C%+QmYpaby9q{!L{47j)r%E%|DftLI*=W4orzQ&Q1ViFpefyxp?`jqObY5b=) zAJvwE_D^d$&PCjH=P}HWbgCs!0;g%?IV>wka3OF5VS=A%ag~?f*B2v}F^z7p(mNUv zo!Yii$$nL#!)|hDi|@P=&NOQ*dQZ1S7R)*>DG*v5e`MBStp16jn$V=xqek`5D$-Q2 z7~WYI*i-%L+D3>O&f_F$oyK0advb#GcKu-W@t;@JMnq{?r~@uxzLO@A*GT4|QneXg zakvk{zo9V`SMs7+HCu6q{(+{{9J z3_AHTYAM(hiTB4ERnxVZKXkY2Eimfz9G>Y-f`!OtaJ5n0g`AA4b>ZMRd=0vmIM3ZW zIYB389U>eTlSB+e}w#D>GH4Qzv_WCHgX%zsZC&O)y#3A~Y9m+OPJ?qb=)>4})%Jib^aiQ8QCu z^o9vJn!!IcC`KFPS+aQsLm<|Rorm3%KKk`>DEU|3L%vbUydwanH=FH?-erRSdGQtK zUVT;CEU90;his*hvQGwskzF=sb@KkEGuZifvjr_@hZ?;j{cWjsSVSF44NwzYG>1te zMJ`nOwMo}iKJ)CX*6?ozFdZ(M`#bqG#-d!~NpmG6N)c8G_V~L_5zvMsX()C$H;RHv z($(Ih;bnV7{b?6T!6Thgp&wOp(HbVP+c0y{mrD|65h4qG;E)P^_K?GUK?C;8VI(GQ zdXq5xB?j`i<~%Kt4$@MpP~g%Cc?Hzx#Ih!yybA69smYe!$}464=8fx(Kx(Dne=37f zQRg9`sh?i5wL@jlO`siSOuuhv<0otRJ#uC6$dQf2z}SYG#r!QAOqmL; zwG$g^+YxTqU|M42*GsNSRs(EXX5=UM37~-pzDKWH-Md+1apv9oamjj@p($VhLmaiWHE!HHi z;9U)oLi5yQ{>hsOzv$TcQ}uu~X77aZUv@Bmfk8}5h@x@qcmmh1GlCfbHuf-6OeM*L zb~{E47nMoIi|p)|vo=hV>EeQHk$$3?p|HN(E%(=}aH2gRTOk8WU6~?gMY_0*dt|Gza(zmpbDdH&}9e-G3R9Q`oU%#MB! z2>ebQ{ji`rarDE2Ztv)arOe{!S4@HHI{IN5w{-NwB5vpChb3Ig(U04HSB`#I)?GRJ zVOh6v^y8Lg9sTfIp`#xrjCJ(G#EFi62r$vn4*@1Q`sIwuB;JFMz~pf>x|(V$r%-?- zAt$e4e^X2$|xb6-LVOid1dHzeIxs!=*`EYPj1hY@h0a=R2?dg7Wtck+za z|0tlsU8sLkO#kf;U$cM)PIj6_CTj#Da%-j=N{?E*HTmEmv|#lc@}qClP&l#*)7GOmT0ds8$S?m zDTbigw9vE6Xt0)Z#|N(%W%z!u`*!nHL25=tDnh=XaouG0w%PubF4dO*Pk$Ue@N)7U0K!RE&T3_?{tPg$yL5T2fv50S~)0O*&RZ%{3jR3(F5r zcXWO)a3WPDbh<@Q2H$_x*xpu$boMhjLuY>q$)2mOrhY2D!(&ik!ZmTd=TCL$KaJBH z4AS-B1UBCj|1m_aUx=tTY2kb#E8X#{;OufNM`7W8i?ZEIytZi?S>Mv#PBI{2I!Dcq zw+Ot#GkVs8!z>~1O00u_p_E6lRkpi;HHMWP)R4B%xu8PfM9m+{62&(&VJ0wV|_^V!4y_hKCL*22S36BNY-<>BtQ*X zOLA?v`W~A8Pbt*rl?L`;`*JwMTVK0<&?$O&&x_6oW$U~-6oHC9Q^7s?ic-tmPFAew zk;|WPc07sE|B zhfSZ@%|fXMKroCC_&)yh5pN1^4NouehS?-77JHzH(bbUT!HfDq185`wbw{WJMw&~s0017jIZntyGvh-P0(~Uze+YcMUdN9xe;!$L)sBs!96(puMa)>e zBJYge?RS&2SYvhXmo)9a<)Hqg0LL-+k;LVg!I_zENbds+En+uJmc-Z z66os=EWlIt|JU%YpX~mBs#cU|IO{=XJj;ElujgEP$RkUzibUUv3Zf#>VEC4-&K9c z()oBchzQ=1A8b7>KMnm50X?w~yxQGA*m)i3Qi^ibBi}FkeuTNBe`9{K>6k2$l&9$< zQ3>TWoN8mwMkJi(jJb)I%_qqAEw&mucJ{G`_98lq<^4J~b_-i$X}7;+?CnJxIMa>p znXP~V%)h^>aehW)bQ;YOv*3v1y~SyLLl;TITskJA(ac>^u)&rAbYf#>cCLzoRZg%# z?-|zta{F`a&f_Cz<_yP{DOfrdn;Wc#;cfYWhh!!jUG5p?cC2UYd#lGir~geR#P_om zHDJ(*BcL1%0~NawT2kQqwX~z zWH!+dJ0v^mh8XDp*(%1Jk+?(S(J*c?uMT74*5+lOulj{-g`7L*)I3XDpNo z80{v!|8{3AA4cr4QSK6fvI0znz&s=r$aYGj#c0Ao>&(9iG^*z84PyFpo~(`Pd_7Tp-hqASwZm_Skb z9*Smvz^gkBO_9^qih`YhE`p85KseJhYSe#_r`!_8D{hVxqUI2+4;jlF7opH*CqT+A zbPU_|?2}LF3wI>cNXim0AJ;p%^V974&Np@bQ=FWf`4lIQ+Se2twm{)t2u{v{ToLqs z?P~$m4IHC}@d0%2YZ%3S=thdNHbMT>P3%xT&a9^E(O}CYyv=4@%(%jUG1p+0A29## z$}I-&=G+pj>BZUau_mzUse~>smYErgWulAVEtwdqo<$)mTsjELPGeId&yZ_lKMuS0 zFv@;g3nj>I0o#oaHlukjAKT={qDxUlH)qM|+881`6Ceearrq_0MLpJcl02Vi`V?HVh;1YkM>T-Ayd*iS;{ftiJ9_e2&pRH;>%d9&yycI_N z@YokEo~YGzFjOkK{}Nj)ii@1y|aj3Ay4Da2Hu&0J%2sr<|}0kCN1nhc(qxh5)f zH<`Jn!*y?@Cpud_Q>VBusZ}}(WjdQq)hlm4@sgtFf1En^jxkZE)8QnjoXB^i{bXao zG%Lu?YA8C*e&4dFiNcw??qFM^)e;pl*HhReet`6q!wcx_wb((45vY#pKnq z#mwSZ$`y%RDAzU1-h6?;@zX5(MpN(jupG{vwCp$AgUkLXD}zZ~Mik#S`q1i4-8;lG z^Z_rJ<6}16(R@!u(Pli}6|RMtH}UF)oMfXyoV#Zxh)hCzredLKJa%UjfyKmH%=Q41iK$W$6I9ZH?)m%Y?ce7cn^!Jx8d}9`rx3n?VzQ1|>I3iN%Js z4utGh6l{Nq6%{)uDsSW0gl$! zxKx1AQchb`DC6aj5rxX_fl?TRI%Bp83``Ue?a!dS|EWJ}T{);@aj>MdvRTQW zA2Z*5?q0mKPYv33Zrp&Wq2WYpD#*i$&D6-yFkOx)A<$r{v7&}EPC%(ZBb^T18xKde zQKKeC4F=F-LNCannDf>J-YO7rQI#XEHVEAuDEhn6FDU$R`^OYOq)lVpYXrJj?=SMz zZesaja1pGA<3BOeAyPA+AZrJrZ=c2R(4AZ3+tVq ze(J+tV#g>9Endn+@y_O5TkR;!+OhIk09deL3z-jksEzkiStVSHHF2nMR|4efWPv3p zLn(*dqfF%|y-Pl1NRQksB!d@W2qc}~6 zM*)wO#xrv%GE^+R?bDKcG!S3c(o&`pT2&}^@jjG7YK#4ma6 zkC@#$%PC*rUy-wZGHm!j-<@^;aW-}oC$Fi7BFBhOs-LMt`e5zHm<~3tn^X8Vd zKaypQCwb~b3>(7}9->SM#wL{M-hgu~Rl-Hht!WRdS?z5>cNq#u%UY^byVfftf{^8% zkU~401?yy-WSIMVncrrKm?YO~(e*0!eX5>%p!B9B9yO89#qr9w?8(-k9a^ra%$i!R zObb1gzm>wCI;PDO+N0CDn-R;xNn^r%k(1XvU(5vOPASEb-xOZ&(VCf!Cfs>z-)D2nfoz1# zpKu)iDaPB~@@;|hPKIyOnC*}lxdi*&x%&6R$-3S6nmCQ|FIsaB{kY<061QZ0j&30c zY4R77RC_SQb6(ewh*PhUzJYu&UhziP`s)gX`u=`n?_f+nf2&r*+?W(S)3OVTzYX1Z zT-Z<3FU+3z((m6(A8*u4?mfPI8?Ic0D;Ma_=2BbGONC|)$GP9y)y_h?hX4qYvE%J> zz84upZrtuBbW+{P$D82Lh`=;rHv2|I8w8VtV{P`SbZ3yCMGI%o+$MXGG^Zn4FyH8I zl7(*(l1sn9n)eqdu_zIeG;IV8TGSe6y2`43(138NK}{162;72!jDc=e4jShdF$3gG z9K`vGImjCSPxA-tDSj!N0A}X4NWG8H#RRHHi>B&T;J>v39=zjI%J;_GyaW)k;CXXD z@FQ$6{w=}+)s~Iu-(l2P+bCBaMfFM;`s3CTQZ9^&+YbxvsB1geylQ|Q*!60;a)j=tzOVf-*gL9q0abPa75ILn z(!xpgv)wktbJ1}G(Nr16p2y)cp$WhK#=qg`4z3Z-KQ*z{DY3BL$RQbFQk9m{WflFn z+#7tP%e^ygp}PzqSvwffuBmPkBXLN7j?mAG>!#GWC!|1s*avi}O;xFfYA624`Rp<@ z61LMP)z7Jfb217fS~R24-#;3``CxeV^cOp7#X>F1b z2SF(aOGkw$G0@=}cKr~FzdR0xrJur5H1wm;k4&;vqkMz00rlmnm@69rRlWnf2?zv- zt>w@4<^Ne-{<`_o@=r^PD@RL&Q|YHlsQ@dxkQi1l!59cVbfqJ7qOg-r9bI1Z%pP)f zRLl4Ui5BUb9*l#nh=Up=LeF;0X163S`ioCjCxe)aVp*rM|4+NgzkmzH}*SszLoF_j`CT_v$K9mRxmnHra<^g0e{@jAcOi; zH9Q{%-3}^rBT&F41|u3M7cGtKS26cdYI^BTr1qOzdq4d9ZO9-f^7yiHyzxVRQB`61 z4AOt|enSPg6QAJx{QT|9{jL9LsLJE@ryGm~#b0tOj}*UyK7N5ld93H<)^=kNg*!SZ zyJ{;Q-@&R*Kcg2i=0Zj2GXZfCc{0H>2rXoEK z_R`BzGQig+G>gt+Dy9b0OH)V)c9NmjmmB|MB zJv`@w&SlREZToh=p}NVS*=`==-b4Qs-C(zN4jOwe>zfT41p9BF@9n-l*xG4Gyw_AR zKi}GU5o|`ZIb3ptxLJkeE8y?wlv>|}dV=@xy|&rJ4`GB=?;Pm6UX35;A{U3J$WwH@ zEP5osjWE$d$3YT7ejnUs%*I&F*dP+AlN*E}f9M9`mz1IKP&D)4e2MWTo}Bz2#js+& zqm3VVP#!*c@@Sm=UtfLnB&Ywc_CbN%lgp6?rb h`*`d0T6wj+HXq*eXa3Be`SZ7V{vXcKmx}-}0str4wABCr From 5c821e525d10065cea402500659d839116087880 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 3 Aug 2020 13:02:51 -0500 Subject: [PATCH 253/256] ezfio fix --- external/EZFIO.2.0.2.tar.gz | Bin 26730 -> 26766 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/external/EZFIO.2.0.2.tar.gz b/external/EZFIO.2.0.2.tar.gz index 33bde1948ba66b7fd4eaeca86d34bd24b39a3fc5..bae3035fb2300a4cd105b9409e3be21e3961b8ed 100644 GIT binary patch delta 19223 zcmV)CK*GQ3&;gFo0kC-&e;nnv7|SttG5GLEHWw2eA&o$>kT@C%gAxor3LK_<;esThd}{F2^pICsox)r zLAszFP%gqWDIAF>awT4qDv&QGZ+-$)YI}G$RBB+FKjbW6JamE3e^@NYx<)hJ((9Sy z6}4%&sD|`}k;`b@>#6k%s}r=_9f+%L{2?V1sTQN*1@-GzOya7l?pEm~dz8ezjp4#^`HVvYn-y~%0_|1+lR_;#`%nsU&dRG$aMl zs2vELa5x6mW>vt33n1|o?!!hn5$q|*1B(g|&Cm$#SY)j>{ltS|jXuq!lsqDPM>9z^ zjW*};NEh%@JjaL2s#***fs%*zm@HxReM5Uq@zQGw$yHn5f0Sz$*P%9rvXl}+o=X9? z{~B`$@AFs(P`WV289Ea!s! zanH_>N~&79<>7uHRq`tG(yA88M|p>1q9PLF@20pK^u~0(#KXJcgCV(=4Bh^*>T871 z=}?J33pqPANi)vVj|?FH*>ImS68c z&A2k*P!Xg=P12!27@)~a&MAG{)2L6IEp&87ZKXT1e4Pep=N;Kmg^+F+Ff%ZiBd+C$ zB-nF zYwGz#e;Rj${x)41??}brK>Hi_>n3gv>7d5!Do8&ffp8N^eOxL~eLT%#12kU{W4%Zo zaH$OfE`IDCN;huhg<*?dBU*%+_EbZf;?@$K9vo*JNblqIcfK*0On>gl9mb$FiMzUe zBmqkbYs*UNsa%+8fOzRookLCNGO8$KJZtso6 z+kf0B0aeF+(pxwzjcUr1T6Nsg;hD#6t?ye~-s! z=ay{ms&I2;RDmjLGKds22KoFsJ#+t)uwFVgkkWZs? z?3sg>r>CK!FKWt~4mRn=sOXG)ELeKoX1~Ql_k@Q|?e6ToCUWHED76LSE9>fPnm9*#Tac{P-AA36 zI2?~K&v1j!MqBqJR~qy{f=?J2v<8im^vMT%-r$C}sWxRpI-@)9o_0rUf2i*@Kj_1I zxlhdYhwFj0Wq?Q1r#E~qM%D^PzfPI%18H8IXkri9w1el3EzLFDep8xsoiQGf{)(s6 zXm3wY56yZtiS`w}EeT5gye{K>*e8q6WS*Y@$km8A=FR_~284u~S%JDamTQFl%_l4eT zs@O^_0En-F6z6onRrK7MBpp;(NrH_n{Fed>m>DP!lq_jX{YY)do)yJ*hu3woroa@{ z=K{C}z^47zar=xcd90&Yn^Qh=_COKE1t(TO9XX!r^Z?B@BH+X3e~YekE|kaBFkQ!S z5=NfIg`^7;9f=W;cLM4Df}LWlK=C7m1a`}+VI!$SwM?UxRP=QdsW}qyVH?k7 zTrSY`iS6o@adKJqxRCBoSlqVg52P}lpwkYpSJJ&0_h6dFd{o587qEt$Nwv~Qea}9$ zv3&K=Pn?YJRx!Eqe`f{}HE+e36Xu>g_0KvcHPz^9=NWQF$Ew&#R1608YB1@wcvNRo&471H4onE|j;H0h=V^Z>X z>7^=gGU9DUkhI-lYkZNA)Mg2H+Uyw-9^2JheyASXB-Lq(0JnJpzlf*bx$SVyu(s)MJI_0M)O?7NH=#FmWS&&Dz zY=(U9Hh$hzf5E|e4u>#q$NrcUg9s=IYV*( zB^l(AU_!j1af}BT0#keBcoe{UFy<3;)r{VWf4~F$A)P>?b6*Cfxa}!!C()&2Uc*$8 z@_f)|dv`*Dle}75)|Raa$`TcNE^VmeOMTc&K2&S%e?gxIpbe`}n;c8Y(@G@g#51T2 z((>-u3N)??KO>AJlI(nFtrTn0=QSm;=t{lvoxsBbLK6kokdAz`~ z#s_g8%VFJ>h#fPVBe$q?9e|BFebNCgU?<=iLa^i*C$fRKjVofGPo`A-R!bCvjz542 z%(3oAA~`^kZmojE17Xm*iq=LPLKx#QbQ;B?g5axt#yeDP ze~rnO)1ke33O2KkU`c6t)5(RlfU>(sp^;<_g~)8;XvJ0z8dji0V?K5DY2_iN&Ic7z zgQ0R6aGFvBY<%>P9lRWN$n@PDXD|_N@<@<6BD>KJECZ$Ht0K5H&BrG1LI(RSm5NGt zR350->>yPk<9tGna4ddpAJjyi-Z?Wkf2C71r_lki6Bd@22Tyv?qxNn#(o!?ji-3uK zYKgfSlutD`X}&(E3mk)s7$;fc(Q=?ojEVMlmX|be4I{d%5Np8lZG#IsjGqmfJ(}G# z_l8$G;2LQKAacg+%nRj>4Ioh=(OlgDx6Z6^TnzM<9k2bcV?!GRj9f-^5zgq*f1^m% z=Bm@~p7?2Ve}8lL@MmIya#6gfZ*3kO)WzZJx_G<4_rw0?8?k+$ykcL9SNrw4*n1_m zUT^OIP>&F9zm5=gUFaigRRB zpMaqCe{a>_9*Un{*LS@=tp2BMf57M9a1#q`?~0%Hw-2{>f1nD{5qE$4hu4SV_1@0Q z`aXH@TW-ND}O*Z=DX`jf*6SjXlMz->rOYuvq`wxMwxq4eNKR0KYl!T%Z9 zXivP^{FxoIf0pb4Xll=Gmn(oN40mq6*h3n;0DQIyEkFbbfZQ~#C9as;>dWWe3v*^E$a1`N%tVC?WaAMbx59N^I97JB*RXhT1r{`s0 z+D`Ew^2N^H0Wupja=0l7WBB()9ijK@yFf3RPMcd>NBc0f5CTg8HU~#A*|v9SP(17} z&F1a>mufx{oyDuof9;*4{S1#m%X>gVtde+54~Sy2gD@f<5ZkYysjb&?^n^2Oe-^J{ zC|=Y7Z1d%h+bDUs9S`Qh!M3Eyo~%LA(Uxt{Ln@Ku!vB}Qx6b#!-@uxMhj3q}jT!mh z)+?orO#ZL()5ZPohj_jcDqtxdp7)J~+NAkH<-nx!!pqZGf5^S_T`85m6`OqwE^;Fd zw(4(SmPKM~cmKfqioj_DZC!M7w3O%i7N%osXFc6qVxx-SWv*9h-i2u6K%O`nE>$#L zr8D+OGuRk6K)u=!>S{@`f=< z?fzUv*Ni6S)j>;EAB)`ZU(I3b9IfA;Cn2g%`G2(9A{n;C*I$dr!JEy0)iKQzm8^RI zSmiKJf2%D~I6fAu9gzxAc5;H{h8N=TX48@fs(CR9?IMr}%d0pRpDZXbZTYMbIjLRV= zK=b}_@xI+1N(ua200GsXSaS9Hsw0XrjC7_be_)>ffr@@?LD{_T7*LF}K4J~4LkZ=1 zx-T$V76II@Q<*d=)!WqAsMk1_znP(q+>|_@{_;B3fAYin9}nl3Y6F$LTjqa;|6k;P zeu&2&|1XsO`7ZgN%j?e;`u{^bJpQnDt&RqRUh+j`z#ZoQv(h5}`-42`@s}>O4f<6~ zf6nitjalPgDLqMz|5NyDG5;Upu|s%zdpj>NzG@9sUJrCpP(6#l8f)i+!TV&*L-%FT z6?B@6F}7AOk~47$JET?q?NO*^)cID)g9QE+;&B(=_4;Bp5szj4Ymd8vv}*X)#_;uj zG!g#BPkR1a!+CFQ%$omCN>5Ys|4F&Df0+Ld^5kSR@?;93LE`Q2?H!65{6&d|im+9s z+>aboKl=GN^8SZ>9awgx})hkhuYdz6$1Kq%VimzAn?&432+WWHlO=#F0GxU-%~^AJc7@rl{3cYw`Imedi?-^o zXRTtPsDXaUHSt0g6q1|%sCiu#ONsc7lbpPg$*aFFESdGMbfS_};;Z-?mb$V|e5ey& z15(zC=~0ULUYr6tUM-&>eyB z8nO$WQYr>X$(GaOLW zPDE-fmsU4Qi8x+*lAM_8M4^tB^@18dy#M)m^@+WI2|@KCS;iNa&=H(JMZ8CcF4zIj zts;I)f;Kg5YgO*3trUv!$L6pQ6+RRcByV~GtU$jq8Wf=2AY>X1Vx&d`=ToCW{KQjh zp=A9D9<%Asb!v)_O@Ed5u(py)EM;I zGGlW)Tq&Cm@X`XIFRZSp?~fb+mCoC)RQ|HRV9rcd1)5!qf88Ndg-f-8)dN)Pvbuw# zDi~!!sR&S$)Eg!$3u$%1AVqdb^^!4DNycRjQeCwAUb4BcaHJ%(EM6^yx?6NCBVT*A z3enB-;$rb$JnG@~KN+_EaQn}*a;5a7v{9*${RdQnh5hFN9y9*hEAMPL7+)qubk6JC zOB*x%e=4Pof6V#cv-0Bn??IkNck%y!bQ}NwM+AN^{{N5e%m4q;z4-q>n$!P3p8~h_ z|9|xP{{N3Y+yDR3ZT|75RK_*legh)O_er11h{Gr zBcyZG?p`F3%&21u9MeB1+WrWWK*Mm;fTvvr3_$!F_b-3b(K2a#lDT*NSml@)M4~$d@ExM7t8eyyhfox6q*Ku{VaAKP7VFKP5QF2CYC#p8v&EPX>(?E6M z=F3rNp89V|rfF5W#LBKNzPi~g{Z@f^a?P85%I3hSKaGS5mLKC~@a3=&`S1FEfAQBr zw;$kY63$cfaC3XdEs7(`2W<}Wur#{&v!yG$G`=hp za~#0%SOPPK(7mB!_`h-_Dv?-^ppPdJ{C*ONr;&ITiEmB-_Nv(%OVDzu2%x1RRFHH( z#?k>vR;I8+jj6#JX>-sReHb**X-0kJ52s^{KdVYc+(bl`-Wrg!th@%Te@@!HFvvf# zF(wr~uY9D7GBg1yyciMb7o_OGKe?ETWww!p+V@v`jQ&SceHG>NeQSX;{698I>uLXw zjq=k){Kp4*7K+|N(OW2be|<%dRlJ(gG z^SKFZA-lst|F~d26wtyZe-j!0E50F*e8;QVs)JLhce?$!Ee-L*cr+gNMLFxg9++}u z0aJ$@Xs?pyG2>ugJqh(ef{lL%j~RefN1%LC_3At&G)Qlb{nD$j7j zzsUat5+cG}Kcn;7(^3S3a0!2{N0gnuKdNnrP}e5Wn$~_|w?B%nNAk8qGHQ4G#&k+w zhhylMb&(Q%<9p6cOneUakLoF~SDQNr^)y%tB=y;G?iT{&K@+D0=)M7B>3Ztsv2M2mLswwF16ZXG@&`-{y~pvG*H3nPJXt zLH*L@-?}9*Y%Rhh{4E}%|9`m{@H6%Qa{B)NI);Q>=>HG!EcE|{{=d-w|N8p>%lfO$ zqn*RXA*NzFtYY#g6BNE!T(jf2$JeOqo6p_hW#`*c5kcUkfB8`rj|1S+cB?sTi)Fqr z6k=su&)PDO;O(n#OXM)N#unn@Am?SH1FtdYIDZNq%v8jB9i1LCU;$@P58yxgg}!ub zg2QJ{!aa|HtN1Aufj;$yqmz4HULUG5g=Dd%BDk+!I{m`VY=K-{ZD~lcn%DK>Ag=`^ zh-w4=27*s%f9I9m4nya+MP&Z^Ytgz?NP%2+tMf8ssX731^qVTQdj=d4+T0ICYdFp! z@dTW5+2nDs_u~JSLqUuIQf_DaMVQlG8e<-|objE2vK;1r08!>;3E9Q=RsMIJFAZR` z)_a-~gDLnc9`mxio7;oO!P}of`tKrr$y=Y#YcbZof0yC)`D#%9{tIpYZ~5fh{~V9H zy?eae`zt{saDY{f7xxLUEe}tqZHHY49J`hJ9^qkm(0n7J3GNF?i1^r`W8`7@-Ow2H2t*BhKs zzH=3OMxM#U*B}s*03#)ZQ|SxTJ&#-ODdl*Re?5OGC=*xU(Al{GkV|I@%!C8-KjZE& z4k%v- ze^RRx%4iN^4%W|`yA6qAlgV?$rn(#m-Bi#;EO}U+%@MO1LL-2BQ0$Z_mns|SLR6wN z@aB-R&>4?_mB`Yez+ec9{@R)=#}K|&_Jl_~fye~qYMHJ_QHX!V48#i`Tg_3Bu2ix^ zq+06?QamyTi%_Wu4_j+KWv|8r%zo6QiCpvd>zgl`X%O3z$494Ggg;mae}1c&e{s5= zX;u>>f7ZPLgoL6pVuxf`*YuFB;tNDA!qy{h%)d-F0V_>tF^_@Bup+TQ7*i7D) zaTZ;Xx;hS3scUMD{(yIPHM~ll)z)(EEC!&9V5cM4_s!C%QU5`na%-5ZxJ4wc$c;MG z9D?m3V*xPN6DArCkPRJn0;JqZC$L>lhv!6{Q2*e8gceCz0_Nj(rw_g?}4V@(j5(Le^uXr@dH$%L_JDm&5be z8>hwDM-0Z`k^UuP6%(JO_MIu-3L}4b>Ps!2tu9y`%3ITUzF{L)f1DGZLV1wTry&Hs zp@I{QFMhDSj+^pSJAkf!Bi3s4*}{9eAOcu45tBEhk|`Ep*4E6bg^v$N<9MI}lC%t( z3q@&3P$EqBK@oDzCFE3u$fc8d-|e4C=godTW)5Ci6!Iy!UJAA=rRd)w64DGnxvFLn zW+4&XS~-%FP<6z>e|AIc5ly{r==5u9&t7&xk54F`_f&%0-I_&kyT9-kB?*Qxn{$4@1!R>M?Eu_xIa>> zbQDUnn$FZK@4oPoqUV2@x%N&lQJdv(8dOH)JJNo-v0#=My_-~IM73B1e1MZ8ktZF6 zFkqD@Rp20?f9~ei>&<=Ozxf5II~I8c%~>OpPhPcJ%q@;(y;36Q%5}xEci$k81h(xP z4Rzwfa#&4ueN5PIv=5e^{qe9(@Cl7rDoMq8x&XW5vVR=7;33k*yY zk=ma|o3Fw-s9!b{PTG?Spr)^`p+wY6IHZYl1HmNCFBm{DvpIq z$RbfvM&L7m6m?JJ&|E_1Q7)e$fP>A#BoiUa71>`}!qQRbBtFii@E|G5CCjbZ`c*y& zJ$qKP*=MC$)WhbZ|?sr!*nB2mjEV8bwK`QBBxpzQ>I$cTIcsD> zC#SAFfLFC@+PtQXYu>`L_Mc=~<3*kZQ6(>JV*X6m<`$%eH{cR0<#1VXlb}7Tf4*~t z=@hiK`;18bVIq$iRp+91xOcSmIu|={PK&K{%b3dvB4@c+o4bcbf5z%l^v~~hW*8=| zMispp<@^7bz^(T)k+qQd6VBs5#eBP8zRhvoN%1Z3xRxW*q9T`IU!1GI98P5Zx)V+l z{EI5ir5{(^Oyic6&(UWHLR$Q#e@Ut}7~(yzTS&xw@nFSVzJq+wUh!Jj`s)gX&4Yvb z{^5ji{$7;A%$$^ZreznF{x+}n>-GF`nl?yxR>u~jbjwltaHmmnf}ZCFW1r8ZHfNM_ z%^Hq#zjdmehIB6h5F}&A$K~z87)9nKh?8zYH`SeTd(8UCrM~kND zmEnJt93H&qTgnf{+q?yke`LY?=6>Ku*kSxP4+~UVHllxrQN6NJEI)}h%OPdt%iT-J zdSO<4{$t;8Tq55&@7%m>M`-3tlY2noB(1*{MRR?C*^ehhxMn6_)ib= zEb@OX!on`X!v1Z;!U6y)RWbvZ%>0e2kN4GT?qeO>N0b^u`BNRAe~>SMc8LMf9Sh$C zgY{Rs#!F<76k*nlFj$NM@k7d5Z9BfDx9i*(dea5hkv7Rtz1QT#V0$Vi0p-=!UNxA} znOv_{%O~h=>ifzMgT14gm(XN85P|PU!cA z{@%q+1AA?Vh3!TTf5`}ws_ZGAI>J9z3T&q@=opBfm4gwTnyM~2$-vRii`%BJl(zwk zqCYGWLikl7z7o6f2QFvVp^&hhKB;}3s2uAJoSfj6-;e3Di;)CyQxrP{N`JN~qSNB0 zH#~(%zG|3PVNL}m|GVjsB4|3@x8=Gj$`N$PR!v z1%cqWx%zQ)_5YPtziqr*eYdi_cCtb^72cH#Iat}1P?nAf5NhgL$y+RTQeQb?yd-LR zR-0rukr;KQe|cLv*h+CwlPOH}VYmFe>@R;)nhwGjMq#e7PG!kiL2iJ`%dtAWDI+gF z1D8onV6TfwFODyRb$+9>fs_}S|Ng2^I{zPLBY)WZf8~v*>lN7lJu6pWE4WdqQ2xKl z#$x~X5YJ-&x7hzJ_J4od{a#qOAxsl>fB%4^c41&Lr7}#0?QC(^1Nq|J{L3G1Cz41D4CX_I+8;L@r0i!l- zGzvJwf7=`lFX{GSP3gn-1R&6t*2=^O`qT(@QPo~odXu`T+w@+P4ztX~8v>A78?R9x z?%DleN(Ox50{>69l^D9)p9tOU+t40g_~I)*y@>wBQa$V12VODOH%kbDoazaEy{q93 z9RIB7-`yJJGyHH)hb!OpG{rTj>Ur9ncr<=n8g~&(i1yINESvhXdjpJg zPPR1mD!}>KqG06>{KmLlHIgY7r~$e_)&8 zw5mLHYql3RlYAr%a$H!#n!=dmRue;(w#(W?yHbVDGKFLjIp}UlRZ52QrZy<}ww6i* zScWK!ECuCWu_M95r&o==f4P=2+i;sHQ7|b`uV!2+&$(llli8H#p6mq29na~*UGH|P zqIR(JywcRLANfC!G1On-eoLbIf0-N0KsOUsUK?&L?h~L_PrM~>6W6|Uu8Eww8BU1G zkJB%OD_)>Z5g9*_N5trQ$C{=xC z8L(@xUc=t(G9Hd@f(}$!v#X6d(8ZeF%`n~il|kLVg$Ms6okL#}RFNApFyxb( zme`uT<_k3O;q;mB$nz2NUQx@ zkK^43LPz|Va~xbO=NbkJImu&mMrB6F=r{L*O78`ua z(BxNs#u5j!6?V?0OY@fFx6(8s0>0nsn9}Gx8Z9^CL}=Zd>d>W#p$QJaLWf(@&3blB z7H2T?{HO0tL7$5&e^NqrCRgXmpq8t5zV-nv? zAsGzifeu{F`JYV1aNmc2|7WKE=lc3aDdqpU{^Z%h|MNkf#X;ZVpl@-|_t!t@<0~aK z@tY@nd5LHF8(*$lRdHOvd$py|FGR3lRZ8u`Nn{`u+!RPyf5LkPOhfW@7X+3oU7f+x zZe#v*a2fbBjmHi{wiw8{80l-EO$JKPQ|=R=c&M;de7189YTLEtWC`4KO%{JcC&!NJ zcfawKLEiyPgY{EjL?ahw7#kQn^r|F~?^5nJ2QvMCsQ(TQd`?FUc)iWe*z>liw|W;87gy)XD+>aBCnO2 zDAFNraaIU4_cZ(}%wT6oT#Ug zO6MS-)46Ukf8WqSg`9ITRG-nYRL|%Le%=n)2zuG96sY1gMmqQQtS)Q~E-uFy8v*;E zq^rzEf5EAvWKdHtH=8TvU$bHwaDP(C;_+oa{$NrHo3I2PeW^hi8J=Rj!Ww^o?}KiY z^FN?>p^g|}eZi|zo{j_{qfAg-3k1SI0Nv=<=)ISw3X~MTk~gAQ5nXmmER`n2Axw8S zo!&fWdb+doM+qmTsys%t2Qn9$E-u*6Gu-L4& zg1ll|SH7`3sgH6Ip=mKTb`fZho(y~zD<%jZ>zvp(eoDSK zO9DBk?;UkSJcZ5oX(}C1fohzCp1(%pf)*}Q`6B3ql zf7JZg4JbuZDN*b#KgKPg_-EJ#|AkT>#a7WC2F9c&zWvstI5F%G8ptBjz~5(ws=Pd) z2o<+$E_}ySV5e@$H0r)sbu+c3;)uvHfa$!c0e1(i0Fi!6(iy8r9;Gt>sQ@+DTBg14 zM7b0e2g73e!}mb3P|O|6#2`XA2z5URf~7q0ct*$w-+faCaajr?+E9< zmva0^&u{`cFj2@U!iHiOYu6`gq{dC@5PST~kc*RPOv;L#tyLX(W#bkB+CTCLxkJsL@xm=z_#-Z14Z{@1u}G;JKugR^W`6e^FCm_#D1}!lNkft9IN$>GtC2 z)xq}vtBdl}^=~#93%ur-e`-7u{2N5#B?jfhc3y4o)R)l$gX^&ywgzuKU{hxw$)^^fB(cdrO%P7M81!$ z=4cM`N!rj|Hc6Tc{g}i|zRqo^mq)a-j}xeN_L1p?S0YufWo3#o9Xm@$nvwzjY(Tf@ z0-#`OFufFoB*8i674QrXsdfEK-*eHMie@SS!%enccr}SB)N{I?GotbS^Ir|(M{BSoKr2DVR z)b7%O^JbFM0ghQQ3xE5-U`iLHK~pV?tewDwi(8ZOJ_?n|SBhEAN1g7Z3 ztV4v;e{x|eHT$l;;C=layWw0^zH>jUqD{&mpR-(%udpq4%+fiuoSFVU3(_pXWLb;QT(o8Xw09mYx$mH3py?{H+==Ry0#9V7 zlxPHBD^NT*;Z?GML91i6+4-v5>Ek6o_V0YHe-HT7Zv^1zcCE|aIKlsU7?pF_7lo~Y z_|5x@tu(Uk&R{UI>&Bu^*-xr~UCu*ZXrSfnSfO{K-mTP*^Qc2#Gv{S=%T9aw$TK** zs5Si?0W62hIx+*_##@#F8fdLt=EQPPg;j$+|87$S^x;Hy6bGC;<>7!*(5BIF+#1n% zf7(^z>6cq8jH5^{o5Lh_JEon%QpdkkC6NVQV0At6GKKbf*3lsyv!#h^V#L6|eDcOE z=jM$Z$(~Y!5{~DrsoSAGe=I8E$)A#TUw8EZsuR)EoR{Y09+a)No1-QX-^M6!@DNb9 zPe0PFLt`*ZpdF@6zi;W_CvEv{T;52|e>YLcT-oNv8I++;otRu!G$F?zD}!M;!5n=9 zk&d006Us{pP&fPr8)3}?fZ@mbu;i$EWWW(CIAf+!H{xoZ(bU6doC}sn~7#9o3up&*(4}%C*)`?Wk=>f4F0Z zX^WBFFJ*&%5tERUCTCR!qy-tx_^VD?y$(jlO(7E%c8Ubt0 z-V5db*vb3{Ok&zX4>v%AhTjYiMlau~ZVGnmuFmVS8oJS%j zgM{Y<7L#sMCK|~0tI$fifNG+qHm2I51i-U$=rXRTl`Z`ylde;U7NksZ>cGE_tE-ih zl|ooZ?aI~XGRA9@OjJe?90E+Nnh5MvQ9AuH_Q{0Dv!YZL0Rh94xK&RLi?AYyj#)$K z10u2Xo0Ak))BG1D{j@TDw~j2MmN;)UNgXULRtw-T@Jq(lI~AxQ4ZcjpwDg| zX27M$c&Y!A8jL!TKjh}S{mZIlLIG@KE>-wI4gr{Mlh9Xk z0g{tLSWAEZ(H+7!hM{m<$vn8&QvMN-k^j8VU-a(3jT!M@H=e9N%f$b#JX^^Bhj@Zz zo~F0m>xtX!^#p<6%U)01*IrND%U(~+x!235z-{+>;`8@<;Ag_;r2rCI9KwuUj#(Y~t1Q zLvXSBBKCFe!$C)7=EJfFm|+kd0=mu9UTjyOYw5)!VW&B3U-4hC1P z5tNF6Ze(J87NDe;w6Qa7q&xa&jxh$sm^{ux(p!Gnjkj*n0qj#lCe8KTvG!9g8{6Q9xL(?URT0HKeuVJkwu4vq- z_)1yA;I!kGSoP`a=2dk86z4#n`cp{+2b{VESmq44ADU4lk=+wP?{+y?eaH)rr#D7B2?A!*kN=?@sQQLp*H>L>n z^i<3dn^v7PMP;QaaRYs_ThfqtqI(eoL*qexO~_Hix0sd$_SO8wR2Z7FIasQwoO#{O_oMyfNYcYVi9N zz3tFjUPJKpHU3Ns_QHgQr2c;h8u1}1tyNL@B!en-!PUos5n82#1lK33_K@Obk`q&Xy z$pqyot6nh`eY0RC1LVTuH+z3Dm8i@CRa23cHg6O4X|=G?e59K@ep7ClFsvJl{_mpBsS`2X zHSEpcJ8RTpuhx@+ZO2JFL5!LW-ixS(`f! z?*q(@7YD@uQnmk!wf(Q`gAklePEc$j@x3U8&-G#kqO08IhWdYW2~w*W8C8X=vsWRl ziv>i^qC$do#$kL#1w+c?*$icY0on>B^}beS9DWr_Tcu{C!paY933Hq#`sS>Q{rk1<{p@~~g)aPNsC4gt#Hp*6C8(TOP*c;PMQ{NlC@gl+BQ1+f9B*A__IMF7+=c>c z9$RHuB^G4yp?X2_meuU$;gEX~0-$Tq!|*ws5~YV*UzKz>AgvQUKWTQ# zSt+6QymSPk{0QavuVT;&9Vo)uK&AOwdw6E(P|%ru2)kBlJ9GyOZ{7BUKDcDW9;=;{ zK{sCr&1jK0N!3n&jnY^uR_XMbBam6J(V*gzQJ766lK_8c(-}iIDxz(PcGM!&+-+Pm zFGr zsb*EiJkv>k@L4;IQ2ZjuYCOS+LgroCZd?ur7{3lp7y&syh{7)xCUV4sWje`Velv>> z&(~Zo`<%yW(BdF!76VmS?`l){Oi5f@6?ODwSVDPl<;rSm38f9k;4$dOtNMGh$C|vv zNpY!C&Mb8sA8S@iNzv`&B@u)oj_g|66xXCz@LNoONq$DdEc2z;Ps#H_ty>A3l)61S z7YveL3TPOT(GtRpE~ZFw0lH3i4x$*%IHP^ugJR5;xXQ5}N39;KrpyM##&5FS)|4eR zd8(G|fIBL(YD=oSmYSJSjq#bJ9=kgs;TE&jh``p3Em~k(*3u+|aK=emKYufos`*W7 zh5h4wezWvKo+ML+2Vp>_EeFN7qH*m7aXBTJg3c8vu8Q~lrDhxM1dL~CoS z0%^ERT|kavHvz;A1$b+4aS6o|cuV23QgV-wwXG(~PASE<&=x}dTXini4oQX*1)EoL zy18>&$%(d4GFB>3r{n~4X3A=+Rw%nq9N3ZRGe>$YksaN?lV`)UsCI&4u>Sj zxlw?g@JrSnmo?sHmsB*unb2UeklOxf)xKs=BxfsF1KQ|vYWtqrBs8rxPJEe%ClyG2 z8eU5U5HpT;*U12Fw#=rE^r|kDn$;yWZI*o;!-|+Hp3g?*U4Q9O;d!>9TvKXDw3g6+ z6XjFN!fH#XJoywD>&XPkgcBuSEZN*=%O%%BYm24qq{}hr8i|q%p0(;uE08wrrsPMq zfF*E@G1!t-*%D+CMlrKPUUWA?-la^mtWlXtEWZ*jbI5NfDL0u$KjgE11@PQ@myt2L z1-`pc2%qcCiV+}^B@@Y#Dj>|x=I#%FHDt0Fgv(OGo}+w!&}bcT>wF*{A05>9ZJ==? zU7aMrQeuB)_rjZk!A}1nKN*i1tU_((VC#(zEedhovzn-T2 ze=F-x7xzCOEO?y-$o@*hS!egA(E|LK7q8gjK;MKhIptl%t9H&FFK)y>&gWgwJ} zmIqNOZG1y8%>+$=1~3EjM^of~@AWwIzZhR!jvhMyN1ps&Uw=|w%>RdYc>IfJuy;S} z4~FrVXk*s+Z){}N|7RPE``-`pj4yE?Urf%uRJ;douhqQh>06=Ri)L~ze*ti@-|hd} zY_#LcME%_xoO$xXVBF?+9te6JSF-5-Y+!)NrgzbNA4`qH!&|7^`)^-=eOqe4{(a5< zjTtBS1r+OiTPk8X>vtpWkAQ{a#B)MfIsqu$PgW2L`mhXtwCJzlxKIC%nrF#hel_Cx zPlNl#+PJ;`Uw*p2(ElIgvBqCb?t5=zM*gqTddB{RO({@y{^P^e67n6a1_bboidz$-udxy2hfoQeG<3L?tD?I+~#pc25#=+jv{#N}{ zAzUjKg?KJ5KeWZ_TY-Uy<@vPWGoZ%hO~5IwW%M!e_%~Dkr*t49XyBg(@-$A@GscLN zvMOz1E_g@yx~hz}#>g(@wfDx$?fv@J;oknw8fM(rP@aB?w;I)dql>`b+lTcx8t5z@ z%?3)Q015Hq=FU+aJ+AqVlT4F7XJPqN`ItzSrQ=UQDVmZ|n?1M;F|Oj_>3|%=?9QvV zL~29nVa(ZHjR9N|yxS4S$71!P9=uoEJM~ZE1hX1w6FiRy2O9u>iCd!qYy&y3_ozzF zAHF+EJ|8;BY)p86cdXO(baRiyYWt22a@x!8X)m6?-CRm^y2AvImd?iLD4C%~IfaqU zt2T=0dRY~(uri@4Q>T(Wvn0Lq3izURPONYeAQRys8(@=tZ~A)lT;FazyEG%;4&%pAw_6DnOnW& zZ+1~4A9VhjvV|G$u06(YR#!yfK;A-kXF*{uQswo^%)enPucw}tc!R6wdu z!9hPMWab?NI&5}^!A5uO@o(iQ`jj4+G$UJ;z=SD0u1qXY((*|!ZM1AW{-^l*YYpUJ zm_rg+LuQkIB$w3)Jz_Lrx(gMqu1+H6tf~!ZaIw4{X_9$JGdH{B z@yjH+nTD-6RC>IgFGZn~I2&@>(IQ-mxOKc9n=S=IN%YSV4)&b-3LTaVt*8=7rdBhF zaS>7;YXx9O?Rl7-cRR}G%uGjCu=wrs=NyBqz>zS2CKgkjOcy(wUhHf_F(sX5G|8i$ zSAh|5)2gu5yc`VVQle|fE@Ju3PAKQ$Wey-742ybgJm+@`mr@j4`2gmg17XE!gGW~KGUrhvA zEgPVJ%4DbtLYXdp^DC|&h3v(9t z#p+K`L(s}u4X{?I^f?N+-vzob`N`V5;@QWwHD81U6nc+=S|Svt4NLS}lD;jL*EBhMeqa0j_cQ;Nw6GX_3KBlWjbT41dkgkX z7oGfABy%?~V)fj=)3}jU1{ zlb7b4jnPbXcXf4jb#--h6&1HCBrQ>%XS0oo&R&KnEof&bPbQ!^3<@Yp$k5DB{r+GK z(gp2+auKFU;Yd7@EAg6CfqXG}^An&_+rzt|QUlZcA!h;Op$mk@e_}z_HJb63Ue6q_ zs7=E~HKZquTt?$wPpw~AouJ+BKwNd>4=I^QwHOUAs9(2Y5?57qw@NSBqa^Nil+96% z0pKQ`Qes}xH779f*-X%PNFK2eb0m=JO;$trpD|s>*Tb2rtQdOQZbG0JY*ZkdoLo#a zyHb;8cF<!KT?)9^MTf49T@*==P6QUn7K0 zhf4fe*s;_kp2kf|?jpB7T~kkYA&oumAbBlS+D|3Keoh<+@5qiSgmk-rnSsF^aVqYW_ zOKlKv@ni2$x^XKn3|ssf(IU*Wry9}}x0dMi;5g$zdLOU9^Nqn|`g2e2Fb1tj+|}(P z30P8CTUJs}<-$w@#7lqb9BM+BQAHu+S+fVYfAm?NNi9Ym+_H6`L*~OiDxxSUVb_+i zb|@%u&2_jd2f7TUZ{flCRILuDOns@jI0s}MBUIQR#<idUO5p6596ez*4>x^J?TJ{0)zE!q}d>+r#`ptQS02Kz9*Q*3*JK`W85lr&87u5 ze|EibLK~B2k_=j1We== zXN7nT1Am1?N8Qd#E@K+;Sn0A+ra$&{p(8$AHKaKXPxI(-P+NMmPHPtnaM#Y(LRmA= z=#(}f9*$FJX2M1D7t#POfTKw}4Y-GhfAM=@^@r zw`6-)g_|QA=fx%LnJl*wtCEzp$RY-*3>!veKqg`{5F2YEybaq^>Z`4^II4uljEc+~ zUtgjbm$pxGrB~A2(p2y;lOmg7Og2wPwa~|dIn7UQ9mOXeE6KY}cvR#@c*I47d>Wl& z&m6QoJq;CoQG=#4AuU_kVnxJIf2Zs;y0}0n1f<-%xX>LM=NpX}%^Vsf+})rk zRtUg$ut_&YMQ7Y&!P4tC`z;>2Cp>g&cW3W4ks~ihsVx{^SyyM%#5vO2f@H1kKI+88 z;dq33h8uh~+PWvX(x3+te8Rw>HE5KiPd?c51~7c?&5^QYYzZ6iw%s_ddWJzP{M`}a%tSGiSysncq1*WJz z7r-?DHtoNR+h=6SV;#lXobr*g2Z|^zII#li$njLC2WYMl0UtJBe{`jDp**gJ={k;+ zF!C%eBwd*3NQ{8I6G-=a`KiXSN?uv=CQ8%Z6iWf~p*V494iqOY4s&5?)?+juVH za)G8#Y*(+0lgqNlg>-+y;qar@OfHmYys+C6Sd-kD? z<*SE&;$(ccipiBfe=~@vc`L@8F!$uCf7UUnsYX{j&yX`ZR>e-DVmP>gUBb;Oc@$Wa z+fox$D>m866&Ojfp$paR?MAW-sqrLtGyGT+hpdZ{tl03ApkPe^741kp)?`YulYM3(&u$ja zPq!V5+vRvj5-i8$1|u_;>ofi0S#LR?B*v*iUTL_I#xt_kDL*}Fs$;uBcXT7qf;_Ti zGvsr(@$;q%e-74jFjQxJ(vgO4OAlp@Bk6@{_Seo3v(6uB^QuQ7Em4y25`W3g8H)Qa z$smse6XFexV?4kRnA#)9qX6E6F`t;LX7o<{10LWH=>!s;`!XoSZBKDKi7p-U8m5Yr z=Yu}myAu+ecd|0p;~JXfBHNCZCHKUFkD`?y&|E3Rek9Z1X zh_848oW|MJidWTSlo8Lk%6(H5I@GIcrC5_buPK2=SL&7T1RfqJ*HGFPQOHNRH$_%4 z%zt`ge~z{6T{??sqm5)7iBKrg#w&5~$nFA2pf}rXwmQh*1!pmWU!K$Pxzk0<;{}#A zK8W*J4(qN&?3mdcxka7p0Bp?ZlMZkJI|0uSf+fc|kqyLcToL@Pivf-5w;Y0Wf1)2cQcAgA4CAXV9o_Pfqf4`lu%38w z>?b&+vkHJpEY2p1Ln#ihZ+0CtcaSe(f$ySh2i%j(?vR|;m60jIc`Hls^$5fe)K2tU zz$m0Kuvm{IJbN2a6WV{04>^Dl$pMmdYZW9O2!qyDv^L@p!WfUC(-WASVIpeFM4&Y8g}f1R2+jSh&Nu&}&5c+!I&wRf|TmYShn1Wfc( zOU%une5$!g^YuAh;22!QILQ)^mIG~KOtinVyrh9^7|~sYSOb=C8(h#~{A|$d(d?$V zH@wmT*GMY>kuzpzUMO#D0Er5T=IRc(b!LU*VxYI|caX7 zdUOB#dW3NMb%e0%LLXVH0)X11-}V0-)^`uZ+xq^S?ZZQ;?Zr=G^X*%xeDlRlUF>ZB z2n4PFXRH49Q2hA1zU%E_^*?R{e?A9?n^<6bSNyoYeYm~*JynQ~xcl4RzdjVN_jX>^ z_sLs#4O*vy;_c@C;dcGN13Z4%e(83quz3Jz7sQX-hp+dJ4mI-Fxy{|5#J{(9Uq+(7 zO%>Ju^LD>}0R8u%?(H{#aUDKx?{4iJy(CBA7f{3Q-XYKldIoqN?h$Def2^t-|pe&i|w6lXc9e#Uu_@mLKEa)yvdkv9qnvFCyw^t?j6+8f`cT4N`T<|+Xw#^ zn+KjG?0+3?>WYB6P{*6i-7OlZ)Ief)#ZP-jxNtzfcU~fZrvQ*pb@8(Ps=jr&{R0dy zKteMIM{nwq-Uo+7pq(ADe_P)Id^h)h5(oADAGWuU4&HwK?dCR+AAO|v@oN0`-Y$!m zN)ZPSxTO9A^1#vV4)%7x{$EGXpBzrWIyS!tZbM>P>q4UOXnr3XKvBJjZs{!hS0 zd*aRJPwbfelVlG-Q+sZ^TmejBxO4Nx9@5|i;ImC=0U}5c9HN(-e{VLwuOCF7W&&zj zI+I7@;B9?t8~=dsz{N~!d%*z99)ksEQa zReuAsED~G0`v=}v1Wp@h>!OpRr99WSFdbVv>*?ka8&w1^bG=gYE<_s#^2E__siNsB zow@J97v5DPJLc4mY6)Ct?l7zA7bj4_J~Ng(#&dK(;=^T~83A|sopCRsI&kl$ln@k_ zN)dUkZ;Hq>f6bT!1fpxBay^AT0alULCxE(hs1pY&CbxOjO_T z3?SjCAnviB?Q}YQ1o0S;>XHYphM3QB?+x3bIn{L)djRXYd-ws>GtKj@_@a5yq<1@8 zZ~sfIitYV_%{N={2Tud|aMbS-Qvi~0o8z81XyW~jf0#L`T>d5!7$O;|Cw7~|(?P!< z^9n@(>*dnZiZ}!+4p3#^irewE*suT+#^GPxVbZ*4+1b!MPx>$@rqsW!%+H=zeEWKD z_ophlW;8Lc4qCGMSmcKPY7SfHX#Ms)2~l;*|D)9w$*?89{#rZ^-faH6j%l8#WYzn} zDu;Pme{G4v@v&I#h*XHOlM^gAybzBczy0wg1u$DK5}}F3rh6G>X!V7-O_aMJV}VE_3j^MD6S-dR#(}@sfKII>-y$P@f}Oq;^RPOTn;e- zn)i>3_wDXbO5o=L2&n$VlB?HO9Z{5Fq%%bUfAjngRP|%A`rD-loPzy~eTp)eLpyrsVnbm)EiW$Pep(Je*&u4OH@Ong1F7f06(B zAs&1Dzfk(;yX1c^uRmMp{}1u-_`}+@IvNam$rq6UcbNarN{jsO5AvkPU%J#b=vOg0 zf4`45W{rQP^dvR@PvNh{{C|kY4&mwT?YzYJsx?%3JWg=UXKY68Kk$$6a{W>xG^LB=e@NtYyLkeJx$I3C*{&&fBrwnlatZNlPQD-iMPMEcPMJ`7bO}h!d8`X z>oq7AZ=(^e_-iO5ifg{diLGmxTelxzxfNg98vMu~`k{F4QBocNp==j;rAcP#flu_R z)f*%+{k*bM^>q6q%G8q_mri819>3;?$7TJi=!aqW9ConBl@qa26J<}qV?rajfBCH~ zwTtxs@A`$M(fG0#2Up>Av_JSEV@8H0#+LpYItc%nquZwEzme?s*T$^*zy9=DYW{CL zE0-4Y{~?~K^FK;%5^)GR)> zXO;3o{y)TH$^W>2CDLmEX0$Zwpp%et@_JCf#ULk7rL5?(+j`&QGgk;LA95(S@()L~*K|JPYe*(v~$D`vb zffoQdLu7lP5@^6@N(l}xyB$$jy(*AHtXzSrGNO$IjoHRI41$D#RqbMM6$e;0^thg$ zwTgwJ2Kp)2#0yzaNN)P0=5h`{hhrZb`o%t4`0XdnAaiGQMcT3kxt%y$H)yt#fR>eZtQQtq5C}9$E%UUrx7A9H5Pcq_#-P`h z8JpYTO4)pXmlgY~;6lFfyMBPF3_@oFK|-J)X|`P#Ep zh;Eh_7mN4eQ4g>G$*}bYv;S;7UD$sf;xXf|z4Fe6gYjijMCZKDy|gjI|EE&g$ejN@ zD=*If9^`p+e;5D%N4N3+e?;K-;{X5XzWo0m-HZSKqdEQm^C@s!|Nlpy@Bjbkv;F@c z-PZq~`+i^k|Bvp`|Nqfv`u}s!(*FOCCi(wAn&$uiXqNx~qgnp{k7oG)zo>t|z1ui= zUEkS(y<6U%Pn@WY7%u=`efK37SR9xAbsw|-%goOMe{==D*W;gA`rp&iv$X!V@nmCT zvHm~AGr|6|xE8p$7Pz<;_&2x~$SeLZX2UDm4jX)%Pq@keedfO#7+w~6IZ-gn{JGN@ z-CUZtqXvxa5J=al(4t})l5O)c8DocIvc-BroC6BVVn<oTQ*{-M&1;78o!7eaSD4N3}hG!oJ`U6v-#{Z^20#;Z#d}bF;bP(+|FHYM{aa|RD;IAOw z*WrpE`b42HrznERUuK94J}^=twCG0mYJ{;41hO^ZU&qze%E?M0ELdc0Tr{sOh%z3b ze;a;^;Qy9=-5L&PBLN1f(VrF)_)`(VJ{R{f^+2-)D~fNAfmM-#SPqs$U!#VH=)z|} zoS=SH&Cp{xWdr;eo;VCFxCj6f^W}WPX60x6GYtYG4PTLaQy*xY;S>Fv{)n`LZ<30i zEW+>z)P%!=Br$Mm`Z(LrJ76iGdcy?%e}cxt1PTBJNYX6@h6?bZpkWL6H$lT3^~F-q zwr4Zdo#fVC2{!&6JZ1n^9f9&m)vNQA&>+1zlG8Mc`md!=gmVX(t5D>akAbQp+XHhJ<5=>~ zn~AaEckwnuSXJdp%Bvhx28yanklus}p-ZO1VVqzr&l*;%Ji`h9e-To-P9?9Dd$*A4!8`CL$9gd-2)lhMlq5nU?v(Wz+`u{@z|Lg1jFYB*1k9H0lhnR}#u!_l} zOi=h@am|k79$%xbZ$5X2mz{4*MFfGD=0{aL4uDJBt>&;Tf0p^eP>7XrJ!{KAg14`} zEs?|68e52qgPfO*4!p*oGTUbvjuW-wWT4&YF^iigS-}yAgT@c8wft7omX}{ z44vN=k@@Sde?{w3Aq8^PtHL_#1nAJWs}Fj-i!ZR z4h1m=NV%Qu7hz6&X^eT;a>jQ8%5s?h0YsUXC1e-dSNY#@zBGW%TJLE}45r|(c+AW4 zZf*}A2XB7@>A#EgC2xH`ufN|8qR*_U`fa=PdnyW4)A( z|GNHU5&!E!p2hvo#r@C4{m;Mt{ZCKu4N#fhbYC1(lJBz^I{9|{r8x1v&Hz~c zP_^Wh+Kha^==%|tj{bw?Vdh?#B9W|5(Wl1W<%-1Vf)B*D! ze>NnFO(xF~o9c2PbYIDLXVCB6Si?c=E(_tIM1UI=iks!{1NbU}voE-BsKoUaLB1BV ze44JDX=V>Bb~h-=v#`(L2cD9tVlXptGU~U=R50JzTO;l{9xDPZB#wY` zP>szF)3{*|YDj36 z0)rta`fF>h97Fh8*%Kb|1R@iZt7W<#MIrtbGY~I)Y&Azgx>Cswk!r0oNb$%VEJCFs zJZ!D`l)V}gF#A!HCUVW+uW!C&ra^2=9v_`%5&mEy{Q0e7#_4*dSxt=mS@#AIe-ety zh#it$UDHFhiZ5UhjoUOIHRI;<>M$m5ZH)VT3=PF{Id{RWx!igm12mh@SSaN%+Ff}6 zXm=tX!cSDYYW~3?OoumqbU6U6lK?i~zJO{CDHhTd?2fumTOm z*~ji>kRvFgO!N0ELA5NC8o)$UegqUDrLL(p z`UBqG)$l5HR$I%tvlxIbf}M_F-#1I6M*RnQ%B^9t;uev(A~)(#a|pJFj0M14Pnc*p zKsI#P36OFtoxpZI9i9_)Lj8jW5?Ul>37C)Doj&-ccy{o0n_o*05@$Wdf5oHrEmAR0 z;a&1=QOx z%a2(8i*k#GyF0f86}3705_ zvFp~fm;wu13<*D9<)lL1R_eO8hzL)f2e7$mp7vr1E-%HaZY#&e0N~TzZSz9x!7Ct^8jpKm^NYXNBE)=CDL5VQg2Svy= zmylBtB9~6;eYbxmoj3dWm^pZ5QOKv@dMVhhl%oHHNJujP<*J%Rn1w`iYvo8zLe&ui z+YPZtH1)cn)32#Le|y;lJwBm$-ct!~cWV~G?f$}Flq6IVU(Tdh1abzc$sA6h4%vJp ze7R~(e<2<{-h1;FPcSxjcIrFg<(_!Ezx~7JVO@p6mSi(BMmMAG$c4_*pvoD%xe1V} zb~9XethysB3(X3f-u&duZQu46_k`Y+-A*lXMk%EYS;j99f0byXTu)W4ZtU$`cy zQTMcRP0*#XE7ugjyp?M@cxvUEs?gnK<(duGy_25k9QDjx;(kx9(orbQYC2P|y!*mS zik|;r=Gr^KL~WMCX;2xF?@0UU#)4U5^lnm-5!GT5@BvPWM4ogM!hlttRDpwlx|>_C zH}`@6<`Ebz zYYTS!(;pJz3-qHHQAQ79eJj)+-z`d8#g^QFZlWr5BsZ9{9Jmc%!rw4^{VG>`JUYP? z$)BW5Lq%caq+ZjjLLs#8y}4?`y|g{TY$pXd0SdW|nF;c_Et*M3!3vS!ILkYEfzJYr zTNp__e@9ZGHRxZln*qkkyb20#5qa0k+6O{$6=QM*)}s|xRGj;0b^tHSOjl4h$K;(f znbJs=qM(Yr!umPL`_Vh2r`yWnN)ARV8Euj7pJiieTH!LCE-)}rL~4H;ZN3WUpnlm* zIB8ERfSSI#hK3nAF1ZFfdtgZ2tg5L@RMBcle;%#!l#n}&t2h=eA&W#w8G+9LQq(<> zLvsn4N4b2401h?_lT3sxS7d)_2}?(zllVB7!h@tJmn^qt>sR?C^z2!YtNuGfkl6#s z0hvAzR+LsYFZr``=KGJ`OH7!l4@7J`Hy*&$&~TzOl}rk1WN3^AD^pRcJ)t&M)NsWK ze^icX^&Pl39*%6IMok(u7(mSlwIQclmUb?Co%AboOHcru=ob|Jc>JR);9#caa;QY0 zi|zg*-`ZU)UJfpUQaJe)GaVv@)Q)6cdyBLV%jju2jFa=`WlXH*gohQkkyCl>5#X`OXOUNoj0uGmaUZ90*kh-auxtqtl2`Y2R+or`$krY zbl4_W0%Y1`fhAFfT8_IXsm43KadNIZ%WAipv>+fTT9Hc&ms#f!4JhzfI(#tFf5AeN z8!g8D7M|gTQyQC7oSNy8!()ZX%v>;WPca1?ZplXj>FZipNi{;d3Vg%54adrMT>Dqg zV!SXSbG^>cG(}+PN_W@0%Aj{y%M#QTdR91a6T6|{$F1`Lrdj+BO_XW)dBgJiJWR>Oqps$Yn|Vd;y&4KVA%VIXWUVuI$PflHV0IzD*w0TV% z*Sv*g?T?d^J;i_i=?c>+Xl?fyk^I9%9y6-WMeT6!XzO(@cHW#8Tj`cDmlH(JatpG$4dDCL?p9Or)PR67mnUIHLU#*UB6+k-KR%u5g_-GpwcJLUKg96Ax` zPRwWDi0FTSV485O&A*iH4zjCg?&_I2WY3f4bVUo+8#PRFGUh|A@3kTw6m$zHI>LM=7{ z%*}0)cpssQ2{exuP0=gE|0+2=c+a<#AB?wo3m|{Vg7?k+z>l!Q_-`H-sJ3iG{|Tdd zWusVr5^a`4%E*_ymyq?stoZzCp&WJf?1;>)47D=ydq<&JJipgt;y+orU+*~q#Ekf_ zPfAb9>HH7tPZ#l@9^_f%|5}8FU4(`G+lGY&092}E1~8fV8&x0gtJU1cI<}7}HH7k~ zIzE3PUjpqC1Ef0^z6l2FuXK%<$RH`gtQ%pl7z5&ml(pJ+d`oZFxiR#n3$7z=lA(I9 z$%(=CR7?WOtF66iFrzcMUagi-(B0Jcl^+IsM>Q{@$#x(D-;ac;oK!#CZ9{r4I*uS# zB6W|`V`G-(PoBzUjRE|9vqn{VIOZLJEf3|wgDibItk@d4FiA0 zWjoD;ILGvMZr19TOnb z)U}egSnQ;}a>95?)by-2$!;Ps>Pmm}wsf$S;-Dr|nCQc9`FYu2{-!h?gfEQ3Tw$Hc zlCy%`0F{?xb$U}qUVH{FlbXO@7n5EbUk2;^MrQ*lFEaoARiAYJKg>q{u=)SW8&965 z^M7o>%fcVK((S{V(uaTT2|%DPt(A!n^r;c*qN=^F^d@yvx9Pno9cGz}Hv}NF zHeRDX+_U?`lnnU91^%CID=~DpKM}gyx1l}0@WoerdJ+ALrFz!254>WmZWcXZYcq4p;u!(-haBs^`7qu2k}!%}|AQL+xs=`mcXLoR6k)(Os$0 zz1$w{x?t0){Ye!^aQ~Ylb*UOw6o+N#^)bE1YXk(Xt^l{rGgq-CFLCYjoFFZYdE3YQAabz-%HArgAj;LK}L81e>w zW8AKqN`5MMQ<%4{=F%L!Jcbe{MOjghck9Z4VIWVnJQa7a&2U;(p1Kd)iDK#JB)c=X=>Py{O`%k z>926VB~ks%U1Xq}2^gDRp#FHon5j33C? zVRSumVmkQw=KlE}_dYuB8&OP9N2@?Q!dIKrv%uOuhQNfNOTv4{(fI|m$ZgKQ@5Whb z%e&F`%l8X+26+pIHX%8m!l_>$;4Gqnn@u zRo3ikqYi&`v1WHOOt(I{<-CR`P-hxlT#Dp=S}CvzOiMGE(j1SPE`{!F?tWjx%T}@Y zPAnzz7AhrC!+0)qZT0cdL4Du;3>&hcXKu9W_wwE<-YYd{T>1|}PF_JZMA1ac-U!Ov zcE8Wd?K7e_s5Wdp;1MbUd2MA-_iy2wKS}4%7XW`%Ooj{$d7Gvswq~#SLP&f#edasz zd`gIeylzhO(RX{-v9HQk+IUM|-|KgHz;<(;!~%1T;~fXmYX8>bc=v(Ou{`D+2N%n^ zhQUHk@)(^ynb9%&&Ap(Ky&-WA{BDVUDj_+CJ=iU-k&H6CvKi`rp4yS&Q1&~lPUg7U zB#wV`X*bPNlj~;3NwfK92T1cf6|q7g#tmBxppS3!Mn83K>+Ul&`IQH;#KCNGofGHM zyyf_~Bo*iw)8O%J-=zCMp=i-W# zke$gE(?%V?QQRHbujB5C9+IqJ-oU6S!7qP0Zb^>lMo-_E#5Yq&hB^5|9i^J{KbeZ* zz7PNY&rJW%_4SQX>ilp0$+Lz3=Yu?pgTBQ<-{PR}uYb_TS4wK)S5Nrz63_BCzFgg^ z;<$kKYD=MCh+tW(l-h-p$UrK%DUh(x_Y9bZ!-ko zMlQ@SHZXSRRY@SzXOQi{M2-Dq7r#H`;p6=}YLBdI? zDi0eif;#zG$@e=sN2@rURA!p1iFbwnZo#5dEUu|{zljzsHmhyn*L;7m+7Xri1|V*M z1K_$-dRiaLm2d1$>H}XyXj+VoT?87WCj+0@iV4EUI!*SCH5Nq*k5ZZcRDc?6Ez{mVMY$9f2g73e!*`Rg zN*Pj3YCe{?7bz?ztC-5~2RUM0E;}!whKkx|TCXS_zidlS8s{wxo1k-Eh50e{9Bod&kj$EnFI}IGc)_6#1 z9m%J?lTk|?0;m6zZ%Zlye0-CeODY(CQki0Mkf6AwCQ2hkly0B9nxONF=xXtq^y*oc6j9JUBMZ`l}{RR|G*=<-4WC`Q6ACFuqm zQx@Q|$k|7K{)ur)pCeU?d>>oQ(H!KHw4u9fk~A6mF^QRco!d|^k7#EfCs6I|Bhv}5 zM5JebopPY zluPOOe@~v27xMo>o<;nJgyUHC5{Cb zCS+>1cZF}UE;$SaN=2N@u`Qz&gAFEZ%kV_HiJF+QyVhX7V+FBl4BYB$Lx_f-8mv0U z5R$4gZT7|Ow_|gqjEzl|_cWPAY?C2f*WEzJ@}VU3G@HJH)2-ml;`n{KGIs>5Ugagl zcKaBA`LY2&%HS5xJX=AdU#3`~i%;*FHvj1w)-s*-via+=Q2+t{lF)9KbMsA4>9ah1A;M{YxiFQQeb-*_zW$EgaIQ1oxgS>2zT5Ug=7Rf- z;mBqToYar$=-+J|Ed1{}5INcOZrg*;S+2-e*cLlx=^R?lOn;vRX_jEJtVL)p+OmJz zJCBy!chE7=bd^}{MDV3sl8d-N|Fc{f&V^OEy=#Y-t(!@29WZ+*udE=II^G1$jPpLr($8*-y?NFaT78UX2Pf5G4yZQjtiRfw0 zOLKA$%2wOWQIm*oW0W^|2&mhqAL-ViF&HM$4pXMzw{-B6w){3OZzSh`n^EAcux0_kAZ2}6a#TGsEQuAuG1I6U zaW&8AY=WJs&}M0?Z`v4>L&&T+v}ievHVv~Vx-@bJAkT11A11G{wT z>dpLTbeIa|T5G3v)V3pk+_A&7#mMfLvQhAIl#6%Lmq77Oo`s32m#^Jq1Aqo5qGwLW zS1iM(6W=q-rp@8-)~uSf7LkcAQBjsT)DC?NZDSEMWT2%%kG=7AbZLZD(^~;8*F^hX zr%0}OYC8X9&4j<}-1$?DfHi0Dh4R1eWd0o{F>N98=CLss!NAr=ZZm@!0XFt9Q_LjE zlzux#3>TGY#*6gommA}7noK9YM(p!KWzN}NCd%3E8k}kmNH^$&;!9OAFVgvSJQ&OU zv4WW`o?DY5Q(+H^P%v=^3Y={sC(nfEgddZVQzjZ<_p8uK&46m6rZ%S9q6EORa_BOy zsFf}KDwEPvh!!MPaq7Uoj;pJcla)ePNbSni=Q2ihlW6#)U(liXEL4W6(fh>lr9=mR3L^sAFNR@4H?V3Q74ED)5{tty+gRz^3}@m@2) zcG{ClR~iA{lVw*m0ww8_oL4*?pRO`18jL!TKjh}S{mZIlLIG@K##Q)04gr{ylk`_| z0l1TASWAC@=nmlDSwa0$bVkwFM9Xi#*Fx{8&B4sW#WHVo-O46Lp;GU zPt)7(^~7!VdV;|3Wv?ghYp*BnWv?gZ-0S62;I?}`@%ei_@!5MlaofEf_x-;1dU{)M z4|_fFnR`9%S$eN0Chhgaw7s5~wbv7~_IhIaUJrj3WG`5L{JOsRlK=GT*R7aXHt}lu zA-Gt55&Js#;h>{3^I_Qo%rJ-!0o~?lFSaYtwe;eVuu~@vVXxW2gpc$klgb7^7fe#N z0yZPO*KzOCN;jBkNFt0iw$9_$d%Ana4SM7q`pBT5qqYv4U7%iI`c}X{1^sEFlmUAs zG3tL(T)hlh#sP6X3_CFr7W%JLxP#W9kIC`~uAov$6$B+4I=D$FE`kg{tILC4L~Wcm zWjtKY1EiV({dqzwk5Xh*4&|Pm0ZWy);?|}S`PaWPRjWqjp$od*@vfhS&{O#GC0++> zs~Z8n`MFR$`&f{p#7P@872QF5?&3`uxiWvl_6o$x80Is1z5iSQxq!uQ!Q_GY4GgXv*(hYFvA+H^Crx#p1fqxK*1?1)cL;(AybmhzF=QWXDS`1bYUrZ2ZO8D z2uejjH!`t43sBNa+Sr*k(jEOX#~6cROde+;=`Fu_5|4}K^%V$M>^*?NV&6K4A1HrT z;pcDS_(ZIJCwBQ15Pml4_rU-fZ_=CdcD0JqUB3=?0D)p>&}%n(afccJAb~Jy{#;Hfr&dKd+@+eROH_^TMepDg_FGv$2<8tCI!(qg3FXu(2(BS(2dqDFKT>QRDK zOSA`#4};-*%!)Y1izq6e86sIi?C^gB{p#W`8V9O4{veCUq3M!DEgpB#*RWO-S2S)^ ze5EX5aN2Q8tornI^QyW4igTb({i!5^15VunEOQ3j56vi&$nJ@tce|d!_&9w#H={AN zhv#?i8P=cf7|tYI7Yw`<>=+n}VQ~k$-v}RUvT#TauD>xV z_~I45uy_W~&jslvhJnaE+(O8Ke!7u@-o|%D4Q+rsy+L!70;YG39AN(K0te6~5nNa0 z{TS@fwWV-Tzti>Sl9VRRkEk=#tTEGu);dW8XT|G6y;B#&N~w)YV%LAI28eUpYIZX9 zFx?!$&dho?isdIU*3_|TlH+HCCbMdyl|Hd5VKO^Vr*l;jOkmYhNqi3eAO}u%ee8&< zWP4pU> zc`O%}zFDx60disSn>~M+N>t{6s;Njzo41Mjv|89`KGMw{zbUs&7}gC&|2I+R)QOnx z8un)Joi%a&g#h78;1mrR3>$On<57TqYREvfmN+T^@e5=IUte7Ovz&)MjB4B`Wkasf*bP{x0b&ZB_5WEeDC%-Kdsv}R zF(`$)fz|J1XXhT|I}EcLXgwlCN>Dkmpr)oni{JuAP+07sM_Lw}INrLy&C;j{sj1%iEjCS$#Z5hUT%+jG3M!2 zRSm^+s-unnVqt3W6Ywr(^~K2=EUVeg!y)$~1VGoIhv9QNB}xyszAEW%Kw2kye$woe zvr4AzEC^#MY5mTYzPrrf}#ia`IK6g)H zk7g?whp*xoV62Yv5GZWs>~X4Rv|%zhP@5<0YQ zwq5j@gi`aFuz8nK%;=e#Tkg7BPH*F!dh9)*Ue=O)1Z2axZP`mT-pS(Tge)x-w&d~D z7*Mex<`$<)6;FT1yaBp29w*VZj~L)u{1djUS~~zZX92WT1^$4X<#yWO~kKgL5qW^SqxNRy{k>(GbM3tRn*a!VF~5Il`E^MC6qQCgU6sBuj=p39&7Rv zC&i^oIkVJle5_e5B}KQ7mqZYXII?SLQ(Ti?!EZ5tCHWZ*v&@%XKPAr#wQePBQtI~T zTrfy}E}&sZMoS1Yx|kx#1?W26If!C3dhG6mgj>v7BLZ7DwrGKESxb`;!Wk!N{ruHbs^&MT zA?7uI>LWFK7TVuybzK&V#|dkk1T1D+BFjVkM;j-AJ$*;60NPR z3Z&sObpbhw-2@Of6yUAF#U&I=;4OvAO36J!*0!1`JEaucLR$#+Z`HY6J0uxO6l`9} z>E_O9B`4ZG$yljCostvGnJKHOTA}Qc`L@%4iH1-sQgOa1uKBs9xX)ZEe@?BFIvkQ9 z=SBf~!p~WIT-JD(T~g5qXF`L?LTdY`Rr{Jfk({ky4QQjwsqK4elhCx*IPqm3o>U<9 zX?QIaK+HJWT_*#y*)p3t(yO{qYF3xjv|09X3@c))cs?7Icm1VDh3DCZa!sir(ON=( zPn1t73#%=m^5j!stS1vB6Hb(Tv1D_fEtgyitu2rtw7qeo01>d z0+zrr#$ZcUWlNAn7{$yEdC}bnd6zQLvPNYpvHVKB%pt#_q}*g0{gBW46~J@rT}H;} z7WnQ)A$+bkD@K4wmP{l|s(>&%o4enC*O19#5H3pzdyew`L8EoVt@D9+d~{IXw}Hlq zbaj#dONsrJ-3xCD20Q(S{A4_4unM)AgRM6@v?#>YzyCyovb`10oHHKv(R&Hq#aLRS zhQoUsYN!hH|7T6_koi`a>@OO-YRz)xAvdeT&F!7#KfxUn_WzZd_7`en#{Ca}`1Lg9 z|65sqy14)OAkPo={e$hj-CCtsDpvmZ?7DdF`QiD`5r5adP#ZJuf8&#$|CI{N|0iDv zALsd-&wpq9`3eaCxW_hT$$uE_^!@)u{HF(cXvo!W70p!Yv4XQa-9Xg`RX1l}m4Q$? zS{_8DwDAqWG!rxd8o&(9?@f_^zt`i;|6+V`IeO^)A9?bBef>#!G5;Up;qfn?!QTC> zKN!YeqK#SOzp;^7|DSCv?teeXGrq)qd@(uqQt=+Vy;k$0r*DONFPh1@`~|?pez*Ti zv(b((6ZLm*aOTMigK?YRc_8R@T*;#Qvw;C7o8Cq9eJnK&4{xDv@4tP2^=+vE`}Z~b zH)fpR7f`J8ZK;Umtly2eKLQqx6VC}{=>(u~KUqO2=)*Gn(W1YG<39a6YMv#3`PGQ$ zKMn2|YvcC%fBEV9LjQk|#~Ob%x$nJ=8Tr3T>lypc`g&<0{~zS}>Ji2MIt2!x&_!(g zOwQw8Puo$+&W~pOUQ7mm-mg55?`iJu?H$%02cp#$j{|jqt?>BQ7n=vK8wYzw`&;!- zg>bD{6ymwK{LmJwZv_S-mgm!g&wv`2Hvy-#meI$=<6lkvpVEPdpn-oC$kRAo&ln?8 z%Br-5x!@h)>#8!^8Y8=q*WMd1xA*H?hkN@!X_#?eLwWio-fC2Tk1hg#Zy(m*XrQxr zG#e$B!^tk3bPBKmUoQ366t$8E!pelIOi?C-i}oRu?@CkfOJY#3+LIBi+zP=1s%7Psi?JjgX^3vW zGoZ7^U#+$um$80~hpzjZQ@O*p^HpD+qgurgvc?JHPEtvK{Pvrnfy<=WhZLdtWN!76 zzu85Je9-x8$`)q0yY?8rSzQr@19=PGodt!tNR`(sGp|z^IjtUH`3db(-4@a_Pywkr z1qc14kePQ7=&;!t1{>YA$G?`N=u>)N(u{0X0u!e2xH7RoNy{g_w9&Hh_+R4duQiZ^ zVGc=P4Vg`Ul3Z3J^oY@fjbATGb-XYU9ap|i>Mm5cx;lxNv#K_v!Nu}+q)Fx>&D`vg z$1juQW*WBQQ0eh{z7&N{;%vxiM~iSN;@0tcY`PQ-CDA`eIM{RQD|A>gw4zERnOe;x z#zjbZtQCMAwdY}S-t8!#Gcz4o!Q!{ipK}bd0!PAsm{?48GF|L!da<(!#gufK(Ik(0 zUIj+LO{>CI^KvkdONp)_yNKmCJE5GbSGgsZ)3AE=B^cn6q}lRF>&>kVctC6!4IQB5 zFD2l615hSKYdpmEw)Wn<-LJph`Kd;0A-t`@T*kMJANTfO9vsu3Tln`0$@I%%d^Hhd zwQPWYDwClq2xaC>KTjlOB(yDhh#bVv07H#^Di|M9pvG^&yuSfU86Q)tqp(B4EzDWm z7pp%)4M8hsHNaY-(&s4PeiP`z@C Date: Fri, 7 Aug 2020 16:47:36 -0500 Subject: [PATCH 254/256] cleaning --- external/EZFIO.2.0.2.tar.gz | Bin 26766 -> 0 bytes src/tools/print_energy.irp.f | 23 ++++++++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) delete mode 100644 external/EZFIO.2.0.2.tar.gz diff --git a/external/EZFIO.2.0.2.tar.gz b/external/EZFIO.2.0.2.tar.gz deleted file mode 100644 index bae3035fb2300a4cd105b9409e3be21e3961b8ed..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 26766 zcmV)0K+eA(iwFP!000001MFLSZ`(Mw@8A3soOFTOGm2s-O*_rDbCIUWY%ba+NYW{0 ziz22a+U7)-3{gtz;(qvh9;6Ne7D#9>#s-sooBmG``g>ko;`ik>-V1TK7S;4zb#vQm9|j1l#j0TwMlPjch~#> z(Cd)&pP1n{w1J1~zrVY^`$PZVglYQe~U3t!KBxF>wo*%?)D?u`xeYBUO)5? z`k$&R9Y$F?GUIPB#$Ec~=`ZSkr?~ zALJ^9z#xv#PLE#n=!wZ^qZd7Ka3JY|C*vp*M~&N2mKV@ZZjR;VXq0QcnV1y*(doFD zY^GVN;rZ$DfqV>qvzbn(Gw6TxcK`Qt>`(8+{#iv(PQJJjbd~0*Bgycd@Zo0q_xH!)T(TD``em zGpWBATi8(UOOAfj5=J0w$M{}V4*WSoWe{*Y;qle@a8yU=!g$x^{}2WOw>O$+6MAwVxozEEs#F& zeyHFXjTL2iuI(&KW0H#^#zGXE1XWE<#GE3_)E-7wVwT|Gh5k~|Ll)KuyX3i=ujnDi zU(IX=ldSrHNY255Kp|s!gR;5SxkaUJhrNIWC7o8S6ZDQ`?uB@h-K0sTVzxgr!3!KN zOOoscDb7@MrN+<`Rgr29I@lB9XE|_~^yQ=|W_w#(j7!6EW;ct(>Ts0*Hn_xgPPM+> z&CN~7h%p3(xi-JQ{~&Pz#I3ArHcm@yvt_eUaRbBC8VPzx?D9{r&vx^#@FYxiK`me! zCF)HjjhP*Tq*3Aei$Wg&jcSlsl1MgRRhc-5Yn-cTrSa*kME8QnGYx_UX=Ed`rYzA> z={%>pLp8jG$lN8rTV&@g6A7P<4`NH?dCZsaVN z_y(y$rx+d61)xwaP-i;JG@PyE8PVnB>b!6`(9T4y3{<%vOHdHz7wqO0RPn%w=`ap%qtMdv>q0lxe+yR zn_p(5OW&0{bauL8g+B}io(4z+5G1n*)tCZA>4 zzJ_yrWOA9RDKsvq!BCG)ic%+!5}+Q5t5p|QDg5~X<2sC2JfN?kW2p$HNwFVBQKHBV z%%_kY94aX0GabZcs#6S$-2kMjBMfBJxR8lfwvf0k27d=DA-{wdVu?Yv%@m#X*yS-# zmiSLy*rq^@%yWjK31^MO7eULR7Nz9?F&Mn8X7ti?TXPq+gkX;p0UYQge4;{2XgP~{!=me(# zB94@0{={M%lof{GLId3qXc46d_B@{svqW}4IvCA>6R_V(CSt)ZE0((}hO7VrB9+Z7 zP3AC{lN3};F>)CQ`L^>w=4DD_UwMb1Es12z&OrXRyVj(&;sY}2JNUqEIa^Ro=(1+iI`KqY% z8fMX87~`K~m!pPBNzBLr+yf7ZO2;MQ6jZ|p>vgb*W^YZX$4tD!J~ci-JT0HFdeB0i zP{THE6m5(b0^O*+CxMd4Dt+} z#LDm@FLf9=7jn30UES?a8?Wyz%?^#%@AAwEYe~6rfE93xx|jKOWd64 zqRgFfU8|(50$|m!!3_+;tgj-DbH#x>_z#BCuB6;}f;2E{GjAMIK`E)3l?i0~7-Ku2 zX9$Q6$uvk?4S}t|tjZXV{NDR>gT^X`#*QK6r86Rq7AD*b__gHRP?)kxSSq9i@ZTPa zqPb6ef!t}WwJ7-#j)A5x!R~(Z>%``8b@Xm6SL%R|9ws=)tm^L!c4^WRWiM$^m!D(@ zpO^xtJ{a)trs=I%==p?JOC*rtk;2u2%-}_SW9&-vLJMe*Z6ORtBzCe=7sKeGTQl9q zY{yG<0b#;>N(D$9ZM7jeT0t-9)D6_==$ELNDO#y{X+?dT%P+=tx2un#{a(@FK0bOs zS6g?jBG7gXPeiP4jH4|hluio+uN>jQozOg2bgC`*PWBLfbUd!UovGWKwpgL258#3p z5FPsWZa(g6+~R~A-_8nBuVGhvp6gg|v~RCPI_=xF)A^SO;C$8-xLfcm`|?7*v-sd) zGk6G*wX<+U{5$|t(k2|Fy}@9u${4{sLJmEXE!%!6pn?FP9_zzB0T_Ztwj;&M&e2pDlDyqpHul|Z;_hWjkDBESYK zq9*S&35RX+0yhNx)FHo`6Xxgq6ad0G|{k`OOz)X-)LLX(+-P~OTWHR6*x+ zP$@p#?$I;!#z1}vBrG();uJ`%!1cyP|5=DBwiogN4gcQW-rjlftodBD5^_Iuf1d6< zd-~!j{M_t?zyA8-*|XkVoi^|4B#|qg%sao&2{QSNGtY9`6hY5qP1;#v3VdWc-96qw z(>Iq1U_j`De;{qlIvSP*0qv$x`%bsZdsd!)sAe;r#vR|c>t%URTO#dh(VmNNyJM)R zFQ0m!iLEclQ^oIR>OIR%T2y)KvHS$G?gbzR{^#?GQF!0Z55spjPUp*~{%6qOr)~Oo z=X3XtQLAJO!*+T&qSq?^>U9Iz@rnp4JyfqY*S)KFKBra90z`#3?9Uat+aPP)s06wn z$Lth1L+ibv)pr>^p(=IS@$>91H+A~JKg%z@6zOjzb2=iT42B#OS)meED`lb_9dnPi zMNyhAd$iLVB32N@BrB6xj?J}}{a+z%9e#mfojN%t-MV+;LW^7oQ1A|@^>|l>n1C?0 zz#kvs&`xt>!v*3j2_5&}Zj_IvvAFRo1x&AZ?5T4Q+4>o7`4I-FU_Q)6 z)v_6QNaEr6D?1GRsFX_i-9>cK+#C7mcS6`JD2}c>FR52e?%az;#MKcVQKoV86|w*+ zhtDR{*3!@)yVNeoBp~q+PGB5_X@~CiJw8V0T(C$z3j;yEVBn z!C&lQKS6{jnmZnDr*q5gz+ykz>snY2wgbjb@(lVgyeOwbmS{EGM*sV))rj6c&%GJb z=}f2!yF}SZNK^1`Pzju{c7poZGOI4QRcm+`-q!NlTHdT}wXn#dAs3<;3b@*Xc0mG3 zQv8rV2l5GRtS@bj>^;F&G2n?;{h(z~bys52U~*ta{tDpcFKEw}0qGM65L48}?$Pfx zXDbSz+y8ilNS>-)DlG~q}CTim<<=7ahZiBp|}+p?BHZxL>~wQ~_h5I~n#xQ;FSAxL$k zQ6);;4IK==(g6wQ5Ipmt#VJ7sjK?eTLYzEH<- ztGZe5kPUxaviT*S?Dbc+aAX#GdB@y&@nXTX9zHi`R4fS@ZjR)?9ZxA znO3dpj=0O@uc{0DKE617S2cnVc6TFtOCu@&*nj)sP|7`d4iQD=eA;C1+1Xuta-R{O>Z= zvj5^m9}>YqHk;>WJSk-7pbHOweG$+rd6a7{&s_zrJj%*6Cg2mu<1`8(LhWK3m0kf> zmgfbuhNN_4Mvxnh5{QC+rQhFz3qO#x7ptTX!qfKU&uqqdUGtnfbaxiXo{N% zT&HjnsLfZ7FcntZXoUBfs(*a^+@MA9lT{;e*s#hfFv7fnBYmdjx)PtdQFu=vIo}0L|wauY;7D3?_sA|;!k#* z>EvUw1VJ7JLb^71ggc^D#f`C(Zcq&+vHTTx#vN8fU@5_fP+*8DOd)(nuvxfmbj3E# zP+P|6N&$h#h`B@}DJ}DeUoZE+vkiH2S6GPX>BgBW=7Tw;V@uk(p!4GbaVhDKVw@$d z__Y$rGS?`n2#v@xc@W0X!~$#;0~88Vr{w8w5T=BTqea^*ewCqCa$Qw4ax1KGrarAv zz@u%VxO^=F5QbHJ`~`?LLz5UnWv&+AsY0yOXj75_a^%E6&0;e`^CeNVN_}06mE>$0 z;R&o0IexdI(d)z*Yg}o@6f)#UYhHCuAp`SS3GY`%21unK9DgqDWQB4?Hf1ruU}CvWry?+i|mz_riATnbPq`Uc6V zf}?4gLH`_+(A<^Hy8Kb)nvhCJ7gG!|Z@5<8LIlTAbYeLd%<%LEI82d0;i83YS`e`7 zRHpFY!5Ie`kk9HkVg@RK#aR--7(6A+F(3%Y>{CjmzKCS#QjaT;Kmrh&Y2lisEn32* zqbFE2Q5KY7*j$eAbutfVkY;$|WjiezF;GLcM_FQ>Ce7aE#u>iG@75%pidm{3P}iA> zU8!I?rs$!NwaOf_+3M4#81!t)4MT2cd@94@rEgVyf$j60IDEAObfbcE4c-p}1hjo7NMDHZaP=W0ZT< zP7yQ?b9`}p^8Q>Not(k#>7U2%e-GrFu<^Sg6AW%li*L?o6@-vx`-8hi<2UK!>^!%VSZO)Uyyh zR9=lQLYDi+Df71h09u3O0zsgqVxRItV-Co@Kds)NsSFjnGjCKmYGSG((MfG+%8fTj z1L*>*<{DH621Znv`Fg^My4ho=HpC0e9ERn#3q|uy$`Y$++_?>45aAf8mJv7u4Dd~x zu|DQj$vNh)!&FKd6aG5^1f;l82ay0jIti){?voUgMoAgF-RG=CV+TmV=oGoI{%x7#ZYVx7!jYAc^qvrQnvwE=R$UL!4AcN{{qHDy>_$4xU$Q05*ISs0>m}}IJ zqM4bf%u1W^=n!)#n1k)YlNmZXWEhwPfdt27vz4el%|#wJi6~KK%A2x2_5WR7X+1-i zKnrm2PH;EtQx*asIJWPM-~Y(jWNz`JcW2k^%znMbBQe68J1WWn#cbvx49>a2M-2dm zS@(-ynS0bsma|=3jstk^b26M&zS>}X#B`BOaAboPB_+lwv%5AF2QHbioi>psh4ywJ zbOBzjNG0cPa($tO;I}L6k}G$oTCPfNd-aS(Ip_ z^b$8}F{Sz_j2?le_rL9ZdtVzzvgrMH=To#5lbL}*NCMl59Obtd%Q1H``0z+J7ZV*J zjX<%GI2s9q6Q9q1>(S4d(F2UhCefU;F`B9FuCA`GuCA`GqT*JCq$SGpY_>7c*~<{6 z1?>#w$pjRKK>&%kS`{0egaf#dw4fgYG9f_ zGv3ncnd23;X}G9{^n{ViXx!_m^$V*LwA&qst8V-uB@?L@qu~Yh z>sCzSs;cf*=_PxV#J!HPIjS)L+@w=V%uBlF1SUS43HlDnBNk$g1X8`pY6$-`rtA26 zI8&7sLr>dH2=s!D3S^U$i-~4eYSPRO+KhT#R0ZHWImIQhG`tXfa63swSQnZ&Gx_eS zyc`HqAQ|+bHnQZRW;7%P(Wo5=oNzb>)@D_}h6^C^74E}EI1%hA$ODTC56#dB?O0^3 zHvPndVU0e`q?9}&dq*=#HH|js@kkf&Qas0p%c@!oG=Y+b_LwYT^nF8nP4Uue3dvPl z-;`?>*P%9rvXl}+o=X9?{~B`$@AFs(P`WV289|_;eH@h@+$Jususydd52@7A`;^7rnnmP#&o^J z!@J>wA-R?e-TtxaYlP70P>DYaJC>Tn)3`~=UF6oMYwGDPq_M{xB(J4P`>BMuL=8?U zLW;718>cT)$a0on??BDCGT~4Wq(n{9p+Fd*$xO~EecRKhPn#`tbVhBZJFN8ShBN;XwNv_v?%k@B8 zm`s1}$sNX^HHo{reIx-(3Tw+s>Zx3qX@Gd?Pn||rnkFvN`&S%$V*5`Lub$Rx~au&Sx`t3@8S zO+8Y0<_fJl4%U|AtPrnZ;IEMAsM~qTWlSR;D_u6q^v9kqbi{|NhBU|FX&xO8YDhGNhn|dH zgA;%Q%#n==1+UwG+$aH6$9>XUI4q57%9C1qQ_j$?ytm@G9mA$Btu0u!ql#tC019Qt zW-?-Qz|Z5`quM1y#sK7_XyOL4QcJB?l@h3~gJ?!9Qx#;mPpR9aj8bLrVN7~{;^nE8 zj+Deh3e=CsXXln|@2YTfWaGTJggukxR$^6>vKCpyAeCXms0_$NYzAUuO@y~$drEz^ zl@>>p@R(7NdE@I#G~?3tNv`xtnp>I*9%fQx6O75`>8KX^crd5=$*rUK#A79Sw+WAm z+z5}jh>%aCbL^RemZztoqAzODbS9)_D_g9H80wUrMi&t~4mRn=sOXG)ELeKoX1~Ql_k@Q|?e6ToCUWHED76LSE9>fPnm9*# zTac{P-AA36I2?~K&v1j!MqBqJR~qy{f=?J2v<8im^vMT%-r$C}sWxRpI-@)9o_0rU zsP8pD=)-%tPt5j*>w&dpfJf7(H+(Ke)(S_zPMPilXfril@|QZ&Xf3w>j5ij5YdRiioKlj`VbRD#O2F=pLz`Ow;sd^mt_ZG^8ewWPaQs ztJ$a|ny1c@9or6H<4Q~ zV^a5p-fODZN-O|~uYnZjbih^g+?gaDR9H!ZjV=6_0t%QJC=Zk@X-xe{ZOEP##de3+ zb+V?w6xHVfxCX$c{nv5(j4XMqqgb0$K63Uz5yb^3RzMv&p6c`f%{3z6!{&>wbS{*~ z)i7PhaS}$J#f78`6CH^Wkaq&<{(_xitU&Q2g#>oXs$nCkL$yq!qaRF@kyP|`6R9~8 z@nIX!Wn3=M^oi~2m2q-e_PCJlPgvZx=nteao}kkXuvgN(824bB#(Y%7#}}}MoJqCP zNPW*fw6T2k&`+Fg_0KvcHPz^9=NWQF$Ew&#R1608YB1@wcvNRo&471H4onE|j; z=_Xr+tpiss29%8WyBrTmg5{XpU}VN}eWqVL>n-P##5h&RD-Ac&ct+Mb<)Woi1($H<`p{#Kvy)e!G+8JWj`6F#!^(dqzN)le;FWEUm zasMS5LK6kokdAz`~ z#s_g8%VFJ>h#fPVBe$q?9e|BFebNCgU?<=iLa^i*C$fRKjVofGPo`A-R!bCvjz542 z%(3oAjQyGNmsWDSMLY~pCeRt_3gphROnb@gfGA*Rj;6;gwt zav5-%QUh#!^pG9A9Cpa`-5h5y5pMEGkUAo}(GDyFrRJ+5xHZkkChtN9`z@7+z(W6M!=Bm@~ zp7?2Ve}8lL@MmIya#6gfZ*3kO)WzZJx_G<4_rw0?8?k+$ykcL9SNrw4*n1_mUT^OI zP>&F9zm5=gUFaigRRBpMaqC ze{a>_9*Un{*LS@=tp2BMz~|s_6ANtbil6qk54U%JpbF6ucYphb*N5Wu-psiOM7 z-|p8Bp#L7!z5NC-uEWRe-L0LYm*fci0&3XZI|MpG&j8QEJtB>QRkZ^$P`~%4z7O=< zJ=}b;y|WEXqUZ3d?ZaJYg8Yj&8S|~9olWS((f-@LgF0Gpkc3bP5PX08;9p|%z>|di zucJ*}5l|QEc(b{?MFW)@NbIiodG81p4(RvJO9b!~01~P$Ue;gLw+^>|gy989Xy)MP zOO%530TMG55R3mOl#b|pSGcK9HI2!M^pqpn8E)U*l16@+5DLu zvwxQC0cdK^ZI>&6DGYaRzSu(=ya0T*2`xYb34%lPa`VmR5A}n{(@a23OK0*(9K5Y> zZQ~#C9as;>dWWe3v*^E$a1`N%tVC?WaAMbx59N^I97JB*RXhT1r{`s0+D`Ew^2N^H z0Wupja=0l7WBB()9ijK@yFf3RPMcd>NBc0f5CTg8HU~#A*|v9SP(17}&F1a>mufx{ zoyDuo?VY3j439y}dq6_0l6XxIh+?vXFd`lh+pnOht=Dq&gfnY@7O!C_Uep0>^W~4* zD0#RY59Y$bwxr3PtU=PzmTk~ODv{&D|ChhF&iB9Hz?y}Ja9^g48TsGVE2WK0{;%@W z#r^Mxc)k)UU@0D+_l1VrzH* z!2628X#;ItbaJ$m=lT|=V{2zU-CSa$ir{6gS8CpcXyZVhI2tZhG+m`L_dWQ+yJ}>| zoZ3+>f$Pj2W;Old1Pa(^#&XAaj_yZ%xU4fH;4Z&2?nP7w?!A-}g2GZMBG2_r5qYK= zbAUi}ZB(wOuqVJO()t8YcMf&pAm$`UU#W{w6ZV`mR&?DMw}gr6JDvd~92LYp_OqQ% zr;i{W<56Amz||1*Iqtn-J2a=du3`^hU3U*Zpn9fxz7=0IFPijjXY1{MiB++^f3W#x z3;y6~03VL}U1ADA@@;e669-Ma-w`t>mCN5m0z)Jt^~7#-csl6!V_u;MV7**=S`mjp z#R019TX8$S78@2o!Z`f1J4~7vEjt^U=Sd$1#gzKDmHFB8if>=;E zAB)`ZU(I3b9IfA;Cn2g%`G2(9A{n;C*I$dr!JEy0)iKQzm8^RISmiKJt1VGDJ{GGT zkqS|Ea)RZC7vk~bw?Dn40A|aDoMJLnsSe(qDkneZ7NsmNvgAcCU6Q|YL5aRt-I5=% zTbd4@Ckaut-u>eY#g!z`>MFZ9)o^WjUEh2uzGo?0d>qJ(%ONH}^Zs%1zTF*43H)3D z0o9*aa`pPEBZ@MNbfzd^p8tW0er!S6yzdxLjI%ys4XZ;5<$1aYfH`Jc<{ z&ldXsLp(hGuy(DE27_MmMP$Go=Kr(OBLDk?Jn8Y5F0~E%RZPzBqm5bPUnxCFjsH{l zYcc;H;;}<`dV4!BF}`XIRbCHtQBXaLz#41kgTeb`%|rKP(G_%>j4`%WFOoBH2|J`! z{_RnyX4Lss$%6#`724&P#!q_wTf=#8ZOoeg zPfAZy^Z!Y?w3z=7^5kSR@?;93LE`Q2?H!65{6&d|im+9s+> zaboKl=GN^8SZ>9awgx})hkhuYdz6$1Kq%V4&JjF#?k0{L^&UaO}v-1y;nyNk2#vaaqaQw_)6dfK+X`^9;gHw@R?GA!^>_* z6jrYaje z0;7_tBL!cD0y+_i&gDqs?m|+ZDG~R$FRzXPvs|0hl%&?{F)cP4c+IKND87$xKoJO$ zUe`qm^_1XAZ&1Jl!-bGq$CQn~eeyW#X9sI@TH>yB8nO$WY7#ut~+5u86oyhn#F*a6S2B7RGPHZ^Q(Rqm**6pHc3=CBYI zJ`@xrZ+Zf(K)*5?6rkN8WEu@(q(%ehQ=>ur#8YdbWc>*qv;L3!UrGa*wf>jZ%W3;h z<>_Mo_aM(={lDW9y~&e>lfz<<4>$19oqbe9>L8%B(lhhj~Dhp|K!5~F;N%fL3 zQ%S~U4N_gS`d+fRuyCX#v@BjNgt}XFEF)igwhGbB^5SCgUOejI^*n$!P3p8~h_|9|xP{{N3Y+yDR3ZTUNs1um`y zF0KXs4Xy?9ia(6m@QSv>2H)lrt};NM`R@jXmqlJq6wESz?leX>m*(xL0b@G^(se4d zs91(%+q_K1*x{ILv7Qj;fP%8vQCK1Qcgh}GC>Gar)E;RCy-Ir)WzC=rbd`1^gc)~9 zUwiE6bQX_VAKF0(HBoS@z{e%hk91dO;;cQKnHa!HmY7Qf$bJXr$B$3RhV+tJ8KPTG$2$Mj=aMYke z!5Akg=v%ih53vQti@!)3mxv$`CBR?GuF2RUG!JZbal`V9E#?! zh~e3Xf&Rc0sPVt)kAM|c4xibD6CFf*&5P4^Q(RYtANVVX_jS19hdxm#%qfZ>@|PLn zf)9*T2rasiy&7Sx1A%N!_}6iDwQ{mj2n!Y&8yC%M3!;oi=!Tyn_`hXew}u1SNPt0V z^rwXc{!~P;&&7RAJZF*aH4d&@e}Ru@toJ*-UjOxpmigv6-u8p{f?? zy3yrf0^S%=az@A`i6*Fm=*;A#@iQ}l3id&ez`BgzMD4)U-xy7#lCE4$;@ zp_-WO+u^I@A)k&`aiv~Z1pX?I+5cl`+xy-3t7pdkf4%f1?f(xt?c)CLgFK7<|6>2Y z*#G}+_y3dptvrurf6e}(U55f61Hs3jQJD7}QoGR~Uo@J%%kyTiVShb~F+A$NeQSX;{698I>uLXwjq=k){Kp4*7K+|N(OW2be|<%dRlJ(gG^SKFZA-lst|F~d26wtyZ6B+(1z9El%$E(?@gHx$@ zy8XB<4e`TxG#>UvIqSb3m~vzRQ->UAuaf35<6vJs3H3pOjeiG^8GuzspnOvG>O3Vh zNN+w+(G6l6glQ&psL9Bz?{W6mi+T(Vr=+byv-0+Rk@P#D#w(8qUsW) zH=#o4lBsYQCm74KhSe(1aKgXH{{#{u!dyS2^V-u=1cPu1f2~K9oxVS+ZHQ3UCefPK zeqy&jimylVwnH*%cl*Y4N?(U#=$Cbo5`E))&P_~w4)>4hDX>?YI|ubNSPCTd*>Ua{ z0^~sxrv&J}0b=QT@WT|mu*cjfgWwbV{WW(S(47%MRhV-nn`G;b_e}9r?mpU zS7%F|0N>`1hq3n?KAB<8Z9)Cg<=?s`Fl;TtB>XKNqyK-o81OUo|8n~N|2l?*Tj>7} z@GSKIh5o|I7NT&7+;e#v!I+I;>*yC=(RESX{H?xX0J1>zmKr;brIBQV~Jm zrTI}6j|1S+cB?sTi)Fqr6k=su&)PDO;O(n#OXM)N#unn@Am?SH1FtdYIDZNq%v8jB z9i1LCU;$@P58yxgg}!ubg2QJ{!aa|HtN1Aufj;$yqmz4HULUG5g=Dd%BDk+!I{m`V zY=K-{ZD~lcn%DK>Ag=`^h-w4=27*s%=at1{@LE+z&--IL;yQ1e|i&e?Jmi z;~^&O#UW~8Lg?+69_3k-0J3Q@;i*>9Du3B+qg~%ZVxtu1fS$t`p?MR4u_rZImJFKg z>nib%{9yZ=;y0lmA|Td{DRf`&9UShy2~;h4r8XnqFZzCjrK5jid6>Burbr~~Q}n6v zclk4v-QmYfnXbxfy*3X-}4T)lt$#cY}x*Q1ISMuE%^m{kfa1gu8LU@)a*r(~)a%uJk&`mHh* z%s2Mdhq3a{$3TV0ia-mABcL2qW3$6FZrFnw5?bXrdKN5sSe?xgvl&7ofO=5u zlqi=f8|gw+qBHR3kh0JjkARiP(xJd$2#WsNnk&Z;zE<{xM?8VZ1m$X(u18Ubf5i;M z3m;p}QIM`wvO}a=>kLvnG6#!LsR$2SYd&SK#stiM)TD`A^Y`nUFPUi&+mgper&)wQ zSO|Z9tC(@Ro@rJSBY)Pt0fdC2GGd2hSJ(8At>OzA6*VW>m-29w{KxE|42?H zBBaFXEkx=T7XQPz^cL**IjlfKarUu$8RQ7cDAWA?N>DA!qy{h%)d-F0V_>tF^_@Bu zp+TQ7*i7D)aTZ;Xx;hS3scUMD{(yIPHM~ll)z)(EEC!&9V5cM4_s!C%QU5`na%-5Z zxJ4wc$c;MG9D?m3V*xPN6DArCkPRJn0;JqZC$L>lhv!6{Q2*e8gceCz0_Nj(rw_g< zo*jJM=GW4L#92>q@u+=^RLoPjmx9g(kSl`GuYD^)RR<@iVeFsceQRGppCW&>6P6Z2 zR@c>Ruw@dtAZ26_SDtqP^)}4%6PEv?+@j&`&MiSjZO*>Lp1^9S9J;(%WM<5li7tYl z$;8m~JPKLv)B~Ri#G(~Y(2N^%$?xIUj zLw9G%+1eN)I~O2!C_w0NUU2NXH7%yV!WKiq&sRCAkhhh(t}PjW2$%y^fpmR6BsKek0au^x49Dx*!5rG!c_Gq>?EXVb<2ns)dgaNaJ{* z0g|)~nhQl~Nl+q8_CXPH%_Zbigvh0ndf)AzN$1UeK4uPHSrqaqxLyjjE2Ze)ArjII zK)I@B5oRF~-C8-4lTdZUz;;9I5ly{r==5u9&t7&xk54F`_f&%0-I_&kyT9-kB?*

~X2W&wq$fH@Ju{cM zKT@l76iTz2&eSXKzVMQw=YN>F_D(QSo8@pCR7T`G(tf(JV3ruYn^a^(wO9mvfRiGT zCmn?_V3j9T;2@yx=GN=Yec-?O1*kg~c?Qi{Ba=^FwOY(Aj%B@4BIn9=#jk$3%#c52Q9Wk5kXuao%Ndpc# zriGXzif2nUss!ZpTq2Xuo~v5u8qeMNL|{I#9(@Cl7rDoMq8x&XW5vVR=7;33k*yY zk=ma|o3Fw-s9!b{PTG?Spr)^`p}bx-8bTteniE}tQQgU!Mu6CukL*FrIpP~{_LFj;bZp_6K3iI5!=p<2QW1>oG48tlY$x<8l%C= zRMcuusErjhTyX-GV_JO&?u~~d+o(~KMhyl~b3$#%>6WFP%U&n_3f&SE04Mqtg+Ctu z=n6QPsks~~5$IyOzsk3E7mJsJ%b*lae#K0ONFlW&nb+PTt-~^US`Opnym=WDt2yCe z#ckwN9y|GwE2GRPrbUw@7Vf~A_aiQ>`Hj;X7Zv(^@gD!g?T5|qFfAvtzsRI1m8^XL z(EYRRy`uUGMT z>p>5-@xGB&A|1BLl>nJGSzt+&p_b$BNviQqZ=9U#&a&FACM^gEidN*(!e!PuL<0&u zmJT0`bglSSr&<|PrdrWj=l5heOGqsI6)a|RApD;DJ zSG8)|yrzw7-omo>pJZ9%MVYAm1o{$V1I8CB<^cDQ%6^*R?jZ%&J?bjz5_2_k2?Sev_tMt{cYQ}oa8 zc4inRtwt5S8s+={n82;~Gm*8B`4i6LKgE2zU%t(8-bwK-@3@vD(xM`lU|*c8zZ_0v z{<;%R6a0%R&ZQq$+)U$^l+V#;2tr!?rAewa7~(yzTS&xw@nFSVzJq+wUh!Jj`s)gX z&4Yvb{^5ji{$7;A%$$^ZreznF{x+}n>-GF`nl?yxR>u~jbjwltaHmmnf}ZCFW1r8Z zHfNM_%^Hq#zjdmehIB6h5F}&A$K~z87)9nKh?8zYH`SeTd z*5+SIcL&*3Gx~*Fx$(_Ia^+Xp^Zp7o=6!@uiZ&7r+SF=ix^l_B zXh1mCprxr71U`d-w1IA34w~c_F$d&a9K_}FImnv--()Y?W1$wC0OsblNW72G#RQs1 zi>Bz6;eVAJ9=zvU$`8idyakYC!TaWZ;78bD{5KB^R9iNpe}_@MvQaEQi8jk2W#r4< zOUQa*R($@nP>#BKc0^`YhFTf^RulJk)Vn+PeC#5IlbpD6+r;GSc z5ArPXe=Wko0bMAf*Dk`s{%ym;0styiG6R^*{Ee!Q_tk3dV;$Q^lo~?$Qyrg>FM)Q6 z0n!}{-vop8SGvYaWRMhL){QV&i~;dO%35tZzNNS8+!%V(1=o=_$xyx5V@A-)p3@dqwv*P)QGoj$33ov0k^4V;|dmfw%*vx|`ga8ndJ1WJFl zDWcQjrZ+r=NWN;AS7A;CCjYzXkRoV0-M8hPQpiQy01#1~gz~9|f#UL|_Gz;4Ng*ST zI}x3VX-yWS{PRIrILSqcfsQLDl+L*bJKSJcco!C;p&x~Qq(56N%6Bj~puH>=Gj$`N z$PR!v1%cqWx%zQ)_5YPtziqr*eYdi_cCtb^72cH#Iat}1P?nAf5NhgL$y+RTQeQb? zyd-LRR-0rukr;KQd0RTzN^ww=DNOWXxBR^9FMm^-4#F2kVXm-FWyx7VZh*?mu{yme zBQHJ!mq|@vuZu}9jxU3CextL2loy%*{;E$p{~u-}f7twg<&CH771;khD_3AExKXK4 z{=dq`V*mFL&tm_#*#9l|e}CKkUurWaf06oZ>!!QWaZip|6$dUi4{qCvT;kqLR1* z|CCRb%cTi%m)6R}2l~_qby3w`S9+7WsoV5kln%4Z#Tx>USsSlW zAMV-xVM+#k;sXCqx0M*W+n)&C?c2~EU-;rHKD~(k#Zo=%+6P`S);CKCf}H9JeZ8yU z4IKZh=-=HMXERix-B7!ltNtqx=c8#{bXRJ0FSkd# zF4(kce^SK}-2diCU8;r^#bFtGeN39ncr<=n8g~&(i1yINESvhX@Z;tss~O$wOvi5k!v-Sw4QN<@L0Z`wI9n+Sxd9L>H{62d?9^_EuwQj*6k z{(IQ$f-F9S&eGN|)BDzW!J$yEd2!lqit8!} zxOPl8j{Nbcv-*v%uiFx%7};_io!*S%B;>H8*Otk_V3Nf`B95(kUaQwk5-TGt{4Z|d z#W;^g1%z9_J8CreHl04Jtx>n-V9^yO`y!mm=L&BM1|sA2tiR}L$xtBwHlKR~jC4-6 zH1;aM`Prgi_ymbS~3n`y??ouGTU&QDN!&fP_JfODbKlMmy_9)=br2Y#~sh;eJb^`k5QcKsOUsUK?&L?h~L_PrM~>6W6|Uu8Eww8BU1GkJB%O zD_)>Z5g9*_N5trQC0xgy}yBIeAgl z5JeL$dv7RnC;mRKz|V;7pxUtYfJdkZqQIyCwRmgybCdbGNugGRo}AW~lplYDb1c z**md1nd54cIL@WrG=EO6o82poiGbZC&F@rP3xyarY%zd7X_2#JQ^)G;zVfOoa)e}h@lA%z(R*x(#?8yOcrM_^Zcjp zO+lZFD^fysCRgXmpq8t5zV-nv?AsGzifeu{F z`JYV1aNmc2|7WKE=lc3aDdqpU{^Z%h|MNkf#X;ZVpl@-|_t!t@<0~aK@tY@nd5LHF z8(*$lRdHOvd$py|FGR3lRZ8u`Nn{`u+!RPy!g~fxL-KVO1ePmZox#&?WBzn-8Td1e z#|}fb7|6L8>1&`(21?LV?h~JQsIXOhwsQ??+qLCn3EXr|7Jox0$BycEzwwnp-vLa6 z^;2L(BNt{E8yGwEsw9x_T5#cQs!Bx|7pym!P^%_Uy5iP3?C(027Fyap#2jsG&@Dgm z5J&t)CqDQax{tqcLJA22c;PFFG`xWN@CCMqKYIgRq4xZ>qNEs?~jb|>sdm^uunkdpCZgEx!H1{<8 zD$HPKU%l6;L8&Bz9|$;up}_Q&u^psMCSbsO@?Jj5@IDpX#hj?8l1k?wpVPT+GJoID zL4}-iGE|?@u~g6K2!7rU*a&*rtQ4r?HAXu3_N*>!4K6On7#jimprotJM!~70WKdHt zH=8TvU$bHwaDP(C;_+oa{$NrHo3I2PeW^hi8J=Rj!Ww^o?}KiY^FN?>p^g|}eZi|z zo{j_{qfAg-3k1SI0Nv=<=)ISw3X~MTk~gAQ5nXmmER`n2Axw8So!&fWdb+doM+qmT zsys%t2@7dW zEur{l*arWFQXa)t(H;iIq$a-o)}uHv><=2qBGSO$XNRi1JfH{_w`(qZ$5ddaZpk$2 zzF2iLwWQ*R$TEQGyr}_q2dn^*eoN9Bt4JQDGXJRnHP~9Fz3)W16cz`=V*11PK(SEF z9m~WZLO2L@KR2=CnYf&X9Vji2`Y8pLXA7#Va5a_N zpM!5g6=&Q@`Wif2r(*I}sCh40l)QH&$5~aA8sX13S1nzRFM=l`zPKFSq+-LVZ+h97<(-+UMhVFx%o z8&d)@Q!S1_19tumBzf?1^RQmSSJC12n|cl3g?cs%ULT&VOaI1MSZG%)KN6c;hueF* zDpPbM4h}aDj}B`7(eA%?_kP;-?TFUU05A`>9ia{wDK1e0;Mw|T;Dj7BH$Frm&`09_ zRp6s1nIB>KEV9IxX$+Z{yiA13iF!q5j&{2JE~n<0rsZRk7$V*FpRt#K3Hi1i#Z=_o zOa%SKGOoMwP@v)BC?Hl5hmFO zKDIiGn))AYs{103vH!B>Tx{Kc8#B)T%TG&B)93${jm7!@gFIh#`>o!%9gFWU9Lu11 z{=H|v!kxJLjy=GfcLkh+#q)w^7rjZ=&)^^|HL?@&ylJ`zK^Zu zXb$p8+R$A#Ntz7(n8ZxJ&TXidN3^q#6R39fk?Dk2B2}+tWr{K#J4;8Jk^%l~K)2`u zpkQh+y%dEc!8$2={c-c($bXK{(@^=I?$Hr!y8N$H%B6Jtzb8-13;F*b&m#WA!Yyp! z7WTJw3-e5zKY)G3YM1rSBMTnqNS<>MZgsXHM8i)FR-I!ANmZFP`{MT7vAI&l#-_@9noJ_L z$&jw=ZlKHfP!f8YO<%$3R&Zu<{61ZoI|5d(@{(e^eT;nBfFEUW3um6KpwTZ=EYQWL z_e`7rbPa2n&U)GW_1GwY0Dnnnx68Ttrl<5-qe_ViGM$-iR5|+`8vJlK8l?NL%GB=C zf%9gP(*cfIF$;hDz+g%jq(M_HimaW$go|6CjJVk^E%~9tX5^nDSQC{ch8$BqPEh#I zHj2R-k<6bis3 zg1m_wtU2&&GWF%(Ns{Bm(Nai9tJ^Eq2V(IkcRa{yq!REWu=1i_l!OW&gBy9xb`=pktuvDzV&&>XiadWTup81Yavq zJUHQ1vVlRXW3}1&s@v(~B|rA>e60`o)Ncgf=yt8k-Z;Vkc^H***cXMZg80q*imf!V z?#^H^vg^j8PT5bYfL+c*UTC1@>{y|9qTa34j`OHPUo+=rbjwbA`N%UkyQnq&8v!hb z%Q`Xx-^N>(0UBtnT;{}bP=!^4J^yY~1@z%Wb`%GkJLTbkQqZQ+aNHWvc-mFs>6cq8 zjH5^{o5Lh_JEon%QpdkkC6NVQV0At6GKKbf*3lsyv!#h^V#L6|eDcOE=jM$Z$(~Y! z5{~DrsoSAGe=I8E$)A#TUw8EZsuR)EoR{Y09+a)No1-QX-^M6!@DNb9Pe0PFLt`*Z zpdF@6zi;W_CvEv{T;52|H&Mu3+2+O>l%YU%SbM_6$s{&YX^~ScXj}a%YxJo5SI)Sv6}dA`@MrqAYU|9r_sB z#v*9QKud!jd*kcq(g>@jw*p$OiT1rtkzDiCbpFYj3IEW!^QRgCYtG&a<^R~p{0B^8 z+Ct>bV`DCYfvw$U1~UR|>|v&uNs=l3c8nMD4bcdf_ygPJE5n=LNx>v%O6G zvfDK{)gF*;&@4TZF~ zBnSS2_N(JcS3$7A;!_}(e$P&KP%v=^3YCZx@()& zko+YwR+(4`?xq0q`kFm}y8h}>$o8wyO1gk*qNX;c+M)!&vvTM%uBeqQ{U&_+j?vAy z*r(8efEMzA(m3$m4z#)m$BK7SDuFE^;$-PnDQf5|kDdIXx0w7EZ`9F2nch5}&BzR# zS1J6^nSIY9pEOc`_PYw8HwCe8%*z^9Asi`(;iNd+Z1P3U=x` zT=7HSB$!61lXMvbl)plgni!)F7Mv7T1mL7haq7Uoj;pJcla)ePNbSni=Q74?)@}F^ z{NJ+LVM`|<>;(MDL&rC`OzL9!qGI02tVD_&)58Tit)v1js)5x_`Vm>_=~9fp0)w&Q zH)NbX7q&vc(tw`>9_kzdOstv+>{L-Y{WA8+gvZ8w%rGB}ZNabVz>jq56lqX?2o!;E zUZlUZ8KJ2c=f8EVKKVo9<{nd) z89i6z2u&f)q!IF^B=)OHCg*&YABCcn-5DfNnEQT8XAE~~OD0MXEmc5u%)GR1p3eKY z)oTtlxZ@G2U{LzMk7#*}`{N6WqQS!4;&Q8=6(DlAK@NbFMEm-T$*1V%klt!GNJT5s2TD@vSQs*)g%>HR~BB&p9HIdfr<}AHTrI+tmdW}l2-Ldovm0r1H=~XJdddJcM zl@2oc@a+_w$t&<|U1OsBzs>qQYjvKw0O58VcQrV7G}oqk=;}4ukEl%ZckLFPx1Qku zs1*(Wo&;kpeDY_y!)mgT#vuPr*Jc(0?4R}1T`%23+VrZKIl|4ZooWNFH_2rG%ZdL? zkrM7R0Q9W?%Mq-epOtRatty+4Rz^3}@m@2)c0yVS zOkEDY7?SQ!YEcf}M4-=Z9%jI$$aty$(F@n&xtGW2e-s%J6+{$h_v!|KO5U?)PbTSq zmG#W||HiXti~JuC@+{8(7w7+r^Z&o?`9G!K9ryV>jYvpG?tZbj#y3JZL@g`_e&m1f zL!2^zOI4rqc92O61hk6xoB&efpX{60ph5K1OD>6AfrtMpQ?4>A8jL!TKjh}S{mZIl zLIG@KE>-wI4gr{M+3Vs3FS;|;ph(P(#znK+Z!{=V8ufUg!QhjQ|JvvjJKx^(!aFPe zYo)xA_WyfUezI8qAL4-}bPPKl9(!BFLA)ZO&qh)tnuokgC%=gdqRX9l|$; zp>SKtJh<3W{t=In|Gdy&^zOfn8S!5?o~%F1#Q&~5Tgd;1c!Fh~rnlYeiQDY;1cBen zUQgWDUQgW1UQf)q*UP8CZTEWO^Y?n8^tRw0_Ilzo_j=s3^j=R) z+UtpFdp$90uP0{h^~ChO9xTXSu>AOSee)&%>D8}WF|lmo)$~JfvHBwRb?(DKM`h;2 zvIm%95FG-#&C_0NSDAk z7;9{u$F28t_l_I%$UF3rK|x1t9X7i_y}bzHeDh18c=oX%M~Ra* zXezpc_T0srGIC{x?G=cXG0bQ3djF*Wasi9q$N?&FatD}a*F~$X(%{*%XU`=)VTLtY z=S`SfJ$cEXfr3+3sPlgnLZ&30eZjt%&Qv;1>B3U-4hC1P5tNF6Ze(J87NDe;w6Qa7 zq&xa&jxh$sm^{ux(p!Gnjkj*n0qj#lCe8KTxc~&)>!IiCFz!?D8of{A|+i zg8?+&q&Mg7Y89osejV%p0>#dt*KYLU4mAKk0%6qrx#;%4aGM~(Q*8qEFbZn7jXw17 zS22J;S@_{+%KH#B(8sT&#Yn%=f`tM{j`D^?jp!=WqXes#Xb&162E+H56>*FgQB*!N zM6!g~;RpKF#a}cIRB`-47Lh~KC5c)*?xL?@ttPH$+^G0US;FA7FefIbpaIT zK%e?kNdyO+x&>I~47eYfQ6!Pw6G88GJ%jOa`gU$cV`>l2@7^=4Kix5$Nw_W?w3@x< zP%j5^b@Nb;dw6iEhm*vALeT8o2D3^{*BnvX?Kh?f_4HKC5t~+>G(}~lDRBdRvRl%S zc%pj|14H9MeND(w#J8B11oqYZ#Z(xYvO2Uyx|>d=1b!Nyb!EOcl2(k4!jW^G=!X3--c}2X;x;cQIne}WG%THpgsbke7$Ik{$ zX4OP1ePUI@WOkrV=c*)_z^bQ`_#FH}4xH@z*b!IB1m!8KVAwj({Y$n9nv~O6O5#`@ za>y?;Eaj_DQVI!S(MK|8EstFAKNk}DZxZCw4GUKCSS~DmvtT6y&6}ZkaHw8;t(%qRy!kG2J!n&EPw0;`$2#!k54)8ZsC*=GM!l zYu;}hPN+)p<|terEI#rl!O%ObyP86ZqRUyEI}Yyy%#9ZZ#Q##Y|BJQ#uk3>moJ~$p zY$EZ!D231UVg{nC+~$V*bO}933Hq#`sS>Q{rk1<{p@~~g)aPNsC4gt# zHi4p2<@m2+&a0UkJ@;kvK`!PL0x7Dpu+Anj?@|u+gC6l2MpV zB$EJtXww-(H!7lSiFVW?)ZA@cG%rchb?3W9JKA4&Q(veZ`Xbp+Z8n4mEx{lq#%RD2 zqaB878_FM~(!(22&*D;rc%Qqcut&3%jKf!P3@}zlc?c9XbM`pZGukj29H>o{8rKrsb*EiJkv?=Sv!nS{36I|Ji&-U=3UxuTn+~qzYa|p z0XaX2!Y>vka>RpWI>}&uGm8$-*IX|9oX2X=;vi}k165e>YE$@3NnBeMb@XLeLV0lI z%4%u}r47g6G3dvu`g^m-n!LnGaj8{{9s*Q8hQTTDrQ zM#C)grPoi%^Fpm#37eFFz2F1p2vfb8{B{g}fmh6B#Dza)zs=Jn&nNf}LnWP@OJ0al~v(|{f){QM% zU|ZJGB!qCrNm@UDGnK0OO=^gFjrvHaB&I65_n7DvQl!7khQHQ%1$Z8 zw$K(r{abY|*A7XB5(S%Aa=N*5TFHsFPcl|2P^aVsb7snFs#YkwWWMcmq9N3ZRGe>$ zYksaN?lV`)UsCI&4u>Sjxlw?g@JrSnmo?sHmsB*unb2UeklOxf)xKs=BxfsF1KQ|v zYWtqrBs8rxPJEe%ClyG28eU5U5HpT;*U12Fw#=rE^r|kDn$;yWZI*o;!-|+Hp3g?* zU4Q9O;d!>9TvKXDw3g5l2(O%Q5I0 ziINMRwdzhQkT&h6lYrA)M}QJG3CzY;HV$Zseq zHjSejearN(aXi&Dd z;+b>Cqds~sp}QDMYt(RfZ$k}LVgCQ3=^ZlP3X}asV^^(Nt~}&sb-1~`v-~HxW5WKw zQq%rIZOpj;0l%K6{C_L!PZ#$;ALRM5zJIX2w_B?eOU256KD#cSdwzKSbHv}ZFVx12 z```Ga=YORF^Z&^g!pC|3=JVeff4&03Kkl)OS@Iu7JAMCu5&!9d9vX7BTSYUKdaU3q zPd8BYLDkLKS7jiSj+O^eDQ$d1FwF!_fCexF^G8$U@AWwIzZhR!jvhMyN1ps&Uw=|w z%>RdYc>IfJuy;S}4~FrVXk*s+Z){}N|7RPE``-`pj4yE?Urf%uRJ;douhqQh>06=R zi)L~ze*ti@-|hd}Y_#LcME%_xoO$xXVBF?+9te6JSF-5-Y+!)NrgzbNA4`qH!&|7^ z`)^-;TWY}mea-%j87KG!6zhCjDq=b7cO&kPfQ944b3$1<0Vv#0RuBsMund2+=&#|p zPyddZXUSiFHRAbCgZstWxV`>ge!9NU{~zSB#$QeDdv9Y#{;$${#{RRuURuci2YJ4F zM6th4fdMFV5gR{~^SIa3c2u(SqglTflY#du&*OWV`+Iwbwa0;IwZ-E=U0^Fb{_Vx) z!RyAs-qHS6{Zk=aD;9-#E-pW`#p+vufr#b#wBR$K#^p`GDXnGnG4c2}Q~#%QAR=hs zp9S(XPS-QWh?KG_ZDB5WNBFv`jJC$eF66cM#>?&f`qtsz{?8g_+}BW^eu=jl)uW5R z-`j`vHyY?H9?b?yrT_`?0!*-UX1}<61>|H$H!vzqaM6h+dK77;smoAXcIh-2nQPgeu-P7 z0c-;~ulJ}*&L6%zN>T(Wvn0Lq3izURPONYeAQRys8(@=tZ~A)lT;GF|88jDGAZ^U zMQA>mTfO9Oc2Oc9bpD#Mg&FRyJ;rZVS481J-a>b0L18XZ<@L(U>l8*#t4COVLc3JA zh4c(mK&no`K|d*E<{bn&Y<7mhMtAM;Z{;ZZlpdHgBU_cggeg3(Oe|2+@<}gkv}`>7 zr}+A74dh^$LlRg+W|JhB)d)ReG-2b{OHv&#Ohm_(uamk96|SyMBIc~B4QX((yd7zh zc}O!iyX5i9B)OS}tvFPAyq+&bp_4cpa@x@%T#C4LydIk_1w%>n&k+vxocanKmJF?^ z5=o|3Gl_8#QXXpsU`OqFn4EVz%IC~XM^>=-?epgxgRH=jFeVmLolF-yn_lc}LNO(s zW;Ds8o>zepaMP-=)w~=GQ!#Zdp^DC|&h z3v(9t#p+K`L(s}u4X{?I^f?N+-vzob`N`V5;@QWwHD81U6nc+=S|Svt4NLS}lD;jL*EBhPU;F*{Gyj&fuo!#_5K0S diff --git a/src/tools/print_energy.irp.f b/src/tools/print_energy.irp.f index 056531a0..6f770f6a 100644 --- a/src/tools/print_energy.irp.f +++ b/src/tools/print_energy.irp.f @@ -8,6 +8,7 @@ program print_energy ! psi_coef_sorted are the wave function stored in the |EZFIO| directory. read_wf = .True. touch read_wf + PROVIDE N_states if (is_complex) then call run_complex else @@ -17,18 +18,20 @@ end subroutine run implicit none - integer :: i + integer :: i,j double precision :: i_H_psi_array(N_states) double precision :: E(N_states) double precision :: norm(N_states) - E(:) = nuclear_repulsion - norm(:) = 0.d0 + E(1:N_states) = nuclear_repulsion + norm(1:N_states) = 0.d0 do i=1,N_det call i_H_psi(psi_det(1,1,i), psi_det, psi_coef, N_int, N_det, & size(psi_coef,1), N_states, i_H_psi_array) - norm(:) += psi_coef(i,:)**2 - E(:) += i_H_psi_array(:) * psi_coef(i,:) + do j=1,N_states + norm(j) += psi_coef(i,j)*psi_coef(i,j) + E(j) += i_H_psi_array(j) * psi_coef(i,j) + enddo enddo print *, 'Energy:' @@ -44,13 +47,15 @@ subroutine run_complex double precision :: e(n_states) double precision :: norm(n_states) - e(:) = nuclear_repulsion - norm(:) = 0.d0 + e(1:n_states) = nuclear_repulsion + norm(1:n_states) = 0.d0 do i=1,n_det call i_H_psi_complex(psi_det(1,1,i), psi_det, psi_coef_complex, N_int, N_det, & size(psi_coef_complex,1), N_states, i_H_psi_array) - norm(:) += cdabs(psi_coef_complex(i,:))**2 - E(:) += dble(i_h_psi_array(:) * dconjg(psi_coef_complex(i,:))) + do j=1,n_states + norm(j) += cdabs(psi_coef_complex(i,j))**2 + E(j) += dble(i_h_psi_array(j) * dconjg(psi_coef_complex(i,j))) + enddo enddo print *, 'Energy:' From 9f1f8c1c931f4ecd93a0f51628f1bbdfc369bc52 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 7 Aug 2020 19:12:44 -0500 Subject: [PATCH 255/256] added comments for s2 --- src/determinants/s2.irp.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f index 6f9560ca..813bd3d4 100644 --- a/src/determinants/s2.irp.f +++ b/src/determinants/s2.irp.f @@ -7,6 +7,7 @@ double precision function diag_S_mat_elem(key_i,Nint) integer(bit_kind), intent(in) :: key_i(Nint,2) BEGIN_DOC ! Returns +! returns = - S_z*(S_z-1) END_DOC integer :: nup, i integer(bit_kind) :: xorvec(N_int_max) @@ -33,7 +34,7 @@ subroutine get_s2(key_i,key_j,Nint,s2) implicit none use bitmasks BEGIN_DOC - ! Returns $\langle S^2 \rangle - S_z^2 S_z$ + ! Returns $\langle S^2 \rangle - (S_z^2-S_z)$ END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: key_i(Nint,2) From 7e16ca0f78ac89a5c9c08334c3f7b4e12c55e1d6 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 7 Aug 2020 19:18:33 -0500 Subject: [PATCH 256/256] missing type --- src/tools/print_energy.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tools/print_energy.irp.f b/src/tools/print_energy.irp.f index 6f770f6a..9e263409 100644 --- a/src/tools/print_energy.irp.f +++ b/src/tools/print_energy.irp.f @@ -42,7 +42,7 @@ end subroutine run_complex implicit none - integer :: i + integer :: i,j complex*16 :: i_h_psi_array(n_states) double precision :: e(n_states) double precision :: norm(n_states)