scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-11-07 14:43:41 +01:00
Code Issues Releases Wiki Activity

Working on CC

Browse Source
This commit is contained in:
Anthony Scemama 2019-09-09 17:48:01 +02:00
parent c69525722a
commit aee13ced42
3 changed files with 89 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
devel/cc/EZFIO.cfg
View File

@ -3,6 +3,12 @@ type: Threshold
doc: Energy CC
interface: ezfio
[cc_guess]
type: integer
doc: 0: MP2 amplitudes, 1: read from files
interface: ezfio,provider,ocaml
default: 0
[cc_mode]
type: character*(32)
doc: mode CCD CCSD CCSD(T).

65
devel/cc/amplitude_guess.irp.f
View File

@ -5,6 +5,32 @@ BEGIN_PROVIDER [ double precision, t1_guess, (spin_occ_num,spin_vir_num) ]
END_DOC
t1_guess(:,:) = 0d0
if (cc_guess == 1) then
integer :: iunit
integer, external :: getunitandopen
character :: check
integer :: i, a
double precision :: amplitude
iunit = getunitandopen('t1','r')
read(iunit,*)
do
read(iunit,*,err=10) i, a, amplitude
i = 2*i-1
a = 2*a-1 - spin_occ_num
t1_guess(i,a) = amplitude
enddo
10 continue
do
read(iunit,*,end=20) i, a, amplitude
i = 2*i
a = 2*a - spin_occ_num
t1_guess(i,a) = amplitude
enddo
20 continue
close(iunit)
endif
END_PROVIDER
@ -16,4 +42,43 @@ BEGIN_PROVIDER [ double precision, t2_guess, (spin_occ_num,spin_occ_num,spin_vir
t2_guess(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
if (cc_guess == 1) then
integer :: iunit
integer, external :: getunitandopen
character :: check
integer :: i, j, a, b
double precision :: amplitude
iunit = getunitandopen('t2','r')
read(iunit,*)
do
read(iunit,*,err=10) i, j, a, b, amplitude
i = 2*i-1
j = 2*j-1
a = 2*a-1 - spin_occ_num
b = 2*b-1 - spin_occ_num
t2_guess(i,j,a,b) = amplitude
enddo
10 continue
do
read(iunit,*,err=20) i, j, a, b, amplitude
i = 2*i
j = 2*j
a = 2*a - spin_occ_num
b = 2*b - spin_occ_num
t2_guess(i,j,a,b) = amplitude
enddo
20 continue
do
read(iunit,*,end=30) i, j, a, b, amplitude
i = 2*i-1
j = 2*j
a = 2*a-1 - spin_occ_num
b = 2*b - spin_occ_num
t2_guess(i,j,a,b) = amplitude
enddo
30 continue
close(iunit)
endif
END_PROVIDER

60
stable/utilities/extract_amplitudes.irp.f
View File

@ -17,7 +17,6 @@ subroutine run
double precision, allocatable :: t1_a(:,:), t1_b(:,:)
double precision, allocatable :: t2_aa(:,:,:,:)
double precision, allocatable :: t2_ab(:,:,:,:)
double precision, allocatable :: t2_ba(:,:,:,:)
double precision, allocatable :: t2_bb(:,:,:,:)
double precision :: phase, norm
integer :: exc(0:2,2,2), degree
@ -31,14 +30,12 @@ subroutine run
t1_b(elec_alpha_num,mo_num), &
t2_aa(elec_alpha_num,elec_alpha_num,mo_num,mo_num), &
t2_ab(elec_alpha_num,elec_alpha_num,mo_num,mo_num), &
t2_ba(elec_alpha_num,elec_alpha_num,mo_num,mo_num), &
t2_bb(elec_alpha_num,elec_alpha_num,mo_num,mo_num) )
t1_a = 0.d0
t1_b = 0.d0
t2_aa = 0.d0
t2_ab = 0.d0
t2_ba = 0.d0
t2_bb = 0.d0
norm = 1.d0 / psi_coef_sorted(1,istate)
@ -91,7 +88,7 @@ subroutine run
else if ( (s1 == 1).and.(s2 == 2) ) then
t2_ab(h1,h2,p1,p2) += phase * psi_coef(k,istate) * norm
else if ( (s1 == 2).and.(s2 == 1) ) then
t2_ba(h1,h2,p1,p2) += phase * psi_coef(k,istate) * norm
t2_ab(h2,h1,p2,p1) += phase * psi_coef(k,istate) * norm
else if ( (s1 == 2).and.(s2 == 2) ) then
t2_bb(h1,h2,p1,p2) += phase * psi_coef(k,istate) * norm
else
@ -108,13 +105,7 @@ subroutine run
do i=1,elec_alpha_num
t2_aa(i,j,a,b) -= t1_a(i,a)*t1_a(j,b)
t2_bb(i,j,a,b) -= t1_b(i,a)*t1_b(j,b)
! t2_aa(i,j,a,b) += t1_a(i,b)*t1_a(j,a)
! t2_bb(i,j,a,b) += t1_b(i,b)*t1_b(j,a)
t2_ab(i,j,a,b) -= t1_a(i,a)*t1_b(j,b)
t2_ba(i,j,a,b) -= t1_b(i,a)*t1_a(j,b)
enddo
enddo
enddo
@ -160,34 +151,6 @@ subroutine run
enddo
write(iunit,*) '# T2_ab'
do i=1,elec_alpha_num
do j=1,elec_alpha_num
do a=elec_alpha_num+1, mo_num
do b=elec_alpha_num+1, mo_num
if (t2_ab(i,j,a,b) /= 0.d0) then
write(iunit,'(4(I4,X),E20.10)') i, j, a, b, t2_ab(i,j,a,b)
endif
enddo
enddo
enddo
enddo
write(iunit,*) '# T2_ba'
do i=1,elec_alpha_num
do j=1,elec_alpha_num
do a=elec_alpha_num+1, mo_num
do b=elec_alpha_num+1, mo_num
if (t2_ba(i,j,a,b) /= 0.d0) then
write(iunit,'(4(I4,X),E20.10)') i, j, a, b, t2_ba(i,j,a,b)
endif
enddo
enddo
enddo
enddo
write(iunit,*) '# T2_bb'
do i=1,elec_alpha_num
do j=1,elec_alpha_num
@ -202,6 +165,20 @@ subroutine run
enddo
write(iunit,*) '# T2_ab'
do i=1,elec_alpha_num
do j=1,elec_alpha_num
do a=elec_alpha_num+1, mo_num
do b=elec_alpha_num+1, mo_num
if (t2_ab(i,j,a,b) /= 0.d0) then
write(iunit,'(4(I4,X),E20.10)') i, j, a, b, t2_ab(i,j,a,b)
endif
enddo
enddo
enddo
enddo
double precision :: e_cor
double precision, external :: get_two_e_integral
@ -218,9 +195,8 @@ subroutine run
get_two_e_integral(i,j,a,b,mo_integrals_map) - &
get_two_e_integral(i,j,b,a,mo_integrals_map) )
e_cor = e_cor + ( &
t2_ab(i,j,a,b) + t2_ba(i,j,a,b) + &
t1_a(i,a) * t1_b(j,b) + &
t1_b(i,a) * t1_a(j,b) ) * &
t2_ab(i,j,a,b) + &
t1_a(i,a) * t1_b(j,b) ) * &
get_two_e_integral(i,j,a,b,mo_integrals_map)
enddo
enddo
@ -231,6 +207,6 @@ subroutine run
print '(A,F15.10)', 'corr energy: ', e_cor
print '(A,F15.10)', 'total energy: ', hf_energy + e_cor
deallocate(t1_a,t1_b,t2_aa,t2_ab,t2_ba,t2_bb)
deallocate(t1_a,t1_b,t2_aa,t2_ab,t2_bb)
end