qp_plugins_scemama/deprecated/cc/amplitudes.irp.f

113 lines
2.4 KiB
Fortran

BEGIN_PROVIDER [ double precision, t1_cc, (spin_occ_num,spin_vir_num) ]
implicit none
BEGIN_DOC
! Amplitudes for single excitations
END_DOC
t1_cc(:,:) = 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_cc(i,a) = amplitude
enddo
10 continue
do
read(iunit,*,end=20) i, a, amplitude
i = 2*i
a = 2*a - spin_occ_num
t1_cc(i,a) = amplitude
enddo
20 continue
close(iunit)
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, t2_cc, (spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num) ]
implicit none
BEGIN_DOC
! Amplitudes for double excitations
END_DOC
if (cc_guess == 0) then
t2_cc(:,:,:,:) = OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
else if (cc_guess == 1) then
t2_cc(:,:,:,:) = 0.d0
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_cc(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_cc(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_cc(i,j,a,b) = amplitude
t2_cc(i,j,b,a) = -amplitude
i = i+1
j = j-1
a = a+1
b = b-1
t2_cc(i,j,a,b) = amplitude
t2_cc(i,j,b,a) = -amplitude
enddo
30 continue
close(iunit)
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, t2_cc2, (spin_occ_num,spin_vir_num,spin_occ_num,spin_vir_num) ]
implicit none
BEGIN_DOC
! Amplitudes with swapped indices
END_DOC
integer :: i,j,a,b
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
t2_cc2(i,a,j,b) = t2_cc(i,j,a,b)
enddo
enddo
enddo
enddo
END_PROVIDER