mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 21:03:49 +01:00
working on complex MO 2e ints
This commit is contained in:
parent
f35c8f4f4c
commit
b1e14142c6
@ -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)
|
||||
|
@ -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
|
||||
|
247
src/mo_two_e_ints/four_idx_novvvv_complex.irp.f
Normal file
247
src/mo_two_e_ints/four_idx_novvvv_complex.irp.f
Normal file
@ -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) )
|
||||
|
||||
! <aa|vv>
|
||||
!$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) = <pq|rs>
|
||||
! f2(p,q,r) = <pr|qs>
|
||||
|
||||
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) = <ij|rs>
|
||||
! T2(i,j,p,q) = <ir|js>
|
||||
|
||||
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*, '<ix|ix>'
|
||||
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*, '<ii|vv>'
|
||||
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
|
@ -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
|
||||
|
@ -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)
|
||||
@ -984,10 +984,91 @@ end
|
||||
|
||||
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
|
||||
|
1163
src/mo_two_e_ints/mo_bi_integrals_complex.irp.f
Normal file
1163
src/mo_two_e_ints/mo_bi_integrals_complex.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user