1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-12-23 12:54:35 +01:00
qp_plugins_scemama/devel/cc/amplitudes.irp.f

113 lines
2.4 KiB
FortranFixed
Raw Normal View History

2019-09-14 14:20:55 +02:00
BEGIN_PROVIDER [ double precision, t1_cc, (spin_occ_num,spin_vir_num) ]
2019-09-09 16:51:15 +02:00
implicit none
BEGIN_DOC
2019-09-14 14:20:55 +02:00
! Amplitudes for single excitations
2019-09-09 16:51:15 +02:00
END_DOC
2019-09-14 14:20:55 +02:00
t1_cc(:,:) = 0d0
2019-09-09 17:48:01 +02:00
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
2019-09-14 14:20:55 +02:00
t1_cc(i,a) = amplitude
2019-09-09 17:48:01 +02:00
enddo
10 continue
do
read(iunit,*,end=20) i, a, amplitude
i = 2*i
a = 2*a - spin_occ_num
2019-09-14 14:20:55 +02:00
t1_cc(i,a) = amplitude
2019-09-09 17:48:01 +02:00
enddo
20 continue
close(iunit)
endif
2019-09-09 16:51:15 +02:00
END_PROVIDER
2019-09-14 14:20:55 +02:00
BEGIN_PROVIDER [ double precision, t2_cc, (spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num) ]
2019-09-09 16:51:15 +02:00
implicit none
BEGIN_DOC
2019-09-14 14:20:55 +02:00
! Amplitudes for double excitations
2019-09-09 16:51:15 +02:00
END_DOC
2019-09-14 14:20:55 +02:00
if (cc_guess == 0) then
t2_cc(:,:,:,:) = OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
2019-09-09 16:51:15 +02:00
2019-09-14 14:20:55 +02:00
else if (cc_guess == 1) then
t2_cc(:,:,:,:) = 0.d0
2019-09-09 17:48:01 +02:00
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
2019-09-14 14:20:55 +02:00
t2_cc(i,j,a,b) = amplitude
2019-09-09 17:48:01 +02:00
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
2019-09-14 14:20:55 +02:00
t2_cc(i,j,a,b) = amplitude
2019-09-09 17:48:01 +02:00
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
2019-09-14 14:20:55 +02:00
t2_cc(i,j,a,b) = amplitude
t2_cc(i,j,b,a) = -amplitude
2019-09-10 13:35:20 +02:00
i = i+1
j = j-1
a = a+1
b = b-1
2019-09-14 14:20:55 +02:00
t2_cc(i,j,a,b) = amplitude
t2_cc(i,j,b,a) = -amplitude
2019-09-09 17:48:01 +02:00
enddo
30 continue
close(iunit)
endif
2019-09-09 16:51:15 +02:00
END_PROVIDER
2019-09-18 18:40:08 +02:00
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