mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-09 15:03:37 +01:00
377 lines
10 KiB
Fortran
377 lines
10 KiB
Fortran
|
! v1
|
||
|
|
|
||
|
|
subroutine ccsd_par_t_spin(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,v_vvvo,energy)
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
integer, intent(in) :: nO, nV
|
||
|
|
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV)
|
||
|
|
double precision, intent(in) :: f_o(nO), f_v(nV), f_ov(nO,nV)
|
||
|
|
double precision, intent(in) :: v_ooov(nO,nO,nO,nV)
|
||
|
|
double precision, intent(in) :: v_vvoo(nV,nV,nO,nO), v_vvvo(nV,nV,nV,nO)
|
||
|
|
double precision, intent(out) :: energy
|
||
|
|
|
||
|
|
double precision, allocatable :: t3(:,:,:,:,:,:), s(:,:)
|
||
|
|
double precision :: e_t, e_st, e_dt, delta_abc, delta
|
||
|
|
integer :: i,j,k,l,m,a,b,c,d,e
|
||
|
|
|
||
|
|
allocate(t3(nO,nO,nO,nV,nV,nV), s(nO,nV))
|
||
|
|
|
||
|
|
t3 = 0d0
|
||
|
|
|
||
|
|
! T3
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
do a = 1, nV
|
||
|
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||
|
|
do e = 1, nV
|
||
|
|
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
|
||
|
|
+ t2(j,k,a,e) * v_vvvo(b,c,e,i) &
|
||
|
|
- t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
|
||
|
|
- t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
|
||
|
|
- t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
|
||
|
|
- t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
|
||
|
|
+ t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
|
||
|
|
+ t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
|
||
|
|
+ t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
|
||
|
|
+ t2(j,i,c,e) * v_vvvo(b,a,e,k) ! + P(ik) P(ac)
|
||
|
|
enddo
|
||
|
|
do m = 1, nO
|
||
|
|
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
|
||
|
|
+ t2(m,i,b,c) * v_ooov(j,k,m,a) &
|
||
|
|
- t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
|
||
|
|
- t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
|
||
|
|
- t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
|
||
|
|
- t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
|
||
|
|
+ t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
|
||
|
|
+ t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
|
||
|
|
+ t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
|
||
|
|
+ t2(m,k,b,a) * v_ooov(j,i,m,c) ! + P(ik) P(ac)
|
||
|
|
enddo
|
||
|
|
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) * (1d0 / delta)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
|
||
|
|
! E_T
|
||
|
|
e_t = 0d0
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
do a = 1, nV
|
||
|
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||
|
|
e_t = e_t + t3(i,j,k,a,b,c) * delta * t3(i,j,k,a,b,c)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
e_t = e_t / 36d0
|
||
|
|
|
||
|
|
! E_ST
|
||
|
|
s = 0d0
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3(i,j,k,a,b,c)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
e_st = 0d0
|
||
|
|
do a = 1, nV
|
||
|
|
do i = 1, nO
|
||
|
|
e_st = e_st + s(i,a) * t1(i,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
e_st = e_st * 0.25d0
|
||
|
|
|
||
|
|
! E_DT
|
||
|
|
e_dt = 0d0
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
e_dt = e_dt + t2(i,j,a,b) * f_ov(k,c) * t3(i,j,k,a,b,c)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
e_dt = e_dt * 0.25d0
|
||
|
|
|
||
|
|
! (T)
|
||
|
|
!print*,e_t,e_st,e_dt
|
||
|
|
energy = e_t + e_st + e_dt
|
||
|
|
|
||
|
|
deallocate(t3,s)
|
||
|
|
|
||
|
|
end
|
||
|
|
|
||
|
|
! v2
|
||
|
|
|
||
|
|
subroutine ccsd_par_t_spin_v2(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,energy)
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
integer, intent(in) :: nO, nV
|
||
|
|
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV)
|
||
|
|
double precision, intent(in) :: f_o(nO), f_v(nV), f_ov(nO,nV)
|
||
|
|
double precision, intent(in) :: v_ooov(nO,nO,nO,nV)
|
||
|
|
double precision, intent(in) :: v_vvoo(nV,nV,nO,nO)
|
||
|
|
double precision, intent(out) :: energy
|
||
|
|
|
||
|
|
double precision, allocatable :: t3_bc(:,:,:,:), s(:,:), e_t(:), e_dt(:)
|
||
|
|
double precision, allocatable :: A_vovv(:,:,:,:), v_vvvo(:,:,:,:)
|
||
|
|
double precision, allocatable :: T_voov(:,:,:,:), B_ooov(:,:,:,:)
|
||
|
|
double precision :: e_st, delta_abc, delta, ta, tb
|
||
|
|
integer :: i,j,k,l,m,a,b,c,d,e
|
||
|
|
|
||
|
|
allocate(t3_bc(nO,nO,nO,nV), s(nO,nV), e_t(nV), e_dt(nV))
|
||
|
|
allocate(A_vovv(nV,nO,nV,nV),v_vvvo(nV,nV,nV,nO),T_voov(nV,nO,nO,nV),B_ooov(nO,nO,nO,nV))
|
||
|
|
|
||
|
|
call gen_v_spin(cc_nV_m,cc_nV_m,cc_nV_m,cc_nO_m, &
|
||
|
|
cc_nV_S,cc_nV_S,cc_nV_S,cc_nO_S, &
|
||
|
|
cc_list_vir_spin,cc_list_vir_spin,cc_list_vir_spin,cc_list_occ_spin, &
|
||
|
|
nV,nV,nV,nO, v_vvvo)
|
||
|
|
|
||
|
|
! Init
|
||
|
|
s = 0d0
|
||
|
|
e_t = 0d0
|
||
|
|
e_st = 0d0
|
||
|
|
e_dt = 0d0
|
||
|
|
|
||
|
|
call wall_time(ta)
|
||
|
|
!$OMP PARALLEL &
|
||
|
|
!$OMP PRIVATE(i,j,k,m,a,b,c,e) &
|
||
|
|
!$OMP SHARED(A_vovv,ta,tb,t3_bc,s,e_t,e_st,e_dt,t2,v_vvvo,v_ooov, &
|
||
|
|
!$OMP v_vvoo,f_o,f_v,f_ov,delta,delta_abc,nO,nV,T_voov,B_ooov) &
|
||
|
|
!$OMP DEFAULT(NONE)
|
||
|
|
|
||
|
|
!$OMP DO collapse(3)
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
do i = 1, nO
|
||
|
|
do e = 1, nV
|
||
|
|
A_vovv(e,i,b,c) = v_vvvo(b,c,e,i)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO nowait
|
||
|
|
|
||
|
|
!$omp do collapse(3)
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do e = 1, nV
|
||
|
|
T_voov(e,j,k,a) = t2(j,k,a,e)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$omp end do nowait
|
||
|
|
|
||
|
|
!$omp do collapse(3)
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do m = 1, nO
|
||
|
|
B_ooov(m,j,k,a) = v_ooov(j,k,m,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$omp end do
|
||
|
|
|
||
|
|
do c = 1, nV
|
||
|
|
do b = 1, nV
|
||
|
|
|
||
|
|
! T3(:,:,:,:,b,c)
|
||
|
|
! Init
|
||
|
|
!$OMP DO collapse(3)
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
t3_bc(i,j,k,a) = 0d0
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO
|
||
|
|
|
||
|
|
!$OMP DO collapse(3)
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
do e = 1, nV
|
||
|
|
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
|
||
|
|
!+ t2(j,k,a,e) * v_vvvo(b,c,e,i) &
|
||
|
|
!- t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
|
||
|
|
!- t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
|
||
|
|
!- t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
|
||
|
|
!- t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
|
||
|
|
!+ t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
|
||
|
|
!+ t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
|
||
|
|
!+ t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
|
||
|
|
!+ t2(j,i,c,e) * v_vvvo(b,a,e,k) ! + P(ik) P(ac)
|
||
|
|
+ T_voov(e,j,k,a) * A_vovv(e,i,b,c) &
|
||
|
|
- T_voov(e,i,k,a) * A_vovv(e,j,b,c) & ! - P(ij)
|
||
|
|
- T_voov(e,j,i,a) * A_vovv(e,k,b,c) & ! - P(ik)
|
||
|
|
- T_voov(e,j,k,b) * A_vovv(e,i,a,c) & ! - P(ab)
|
||
|
|
- T_voov(e,j,k,c) * A_vovv(e,i,b,a) & ! - P(ac)
|
||
|
|
+ T_voov(e,i,k,b) * A_vovv(e,j,a,c) & ! + P(ij) P(ab)
|
||
|
|
+ T_voov(e,i,k,c) * A_vovv(e,j,b,a) & ! + P(ij) P(ac)
|
||
|
|
+ T_voov(e,j,i,b) * A_vovv(e,k,a,c) & ! + P(ik) P(ab)
|
||
|
|
+ T_voov(e,j,i,c) * A_vovv(e,k,b,a) ! + P(ik) P(ac)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO
|
||
|
|
|
||
|
|
!$OMP DO collapse(3)
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
do m = 1, nO
|
||
|
|
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
|
||
|
|
!+ t2(m,i,b,c) * v_ooov(j,k,m,a) &
|
||
|
|
!- t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
|
||
|
|
!- t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
|
||
|
|
!- t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
|
||
|
|
!- t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
|
||
|
|
!+ t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
|
||
|
|
!+ t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
|
||
|
|
!+ t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
|
||
|
|
!+ t2(m,k,b,a) * v_ooov(j,i,m,c) ! + P(ik) P(ac)
|
||
|
|
+ t2(m,i,b,c) * B_ooov(m,j,k,a) &
|
||
|
|
- t2(m,j,b,c) * B_ooov(m,i,k,a) & ! - P(ij)
|
||
|
|
- t2(m,k,b,c) * B_ooov(m,j,i,a) & ! - P(ik)
|
||
|
|
- t2(m,i,a,c) * B_ooov(m,j,k,b) & ! - P(ab)
|
||
|
|
- t2(m,i,b,a) * B_ooov(m,j,k,c) & ! - P(ac)
|
||
|
|
+ t2(m,j,a,c) * B_ooov(m,i,k,b) & ! + P(ij) P(ab)
|
||
|
|
+ t2(m,j,b,a) * B_ooov(m,i,k,c) & ! + P(ij) P(ac)
|
||
|
|
+ t2(m,k,a,c) * B_ooov(m,j,i,b) & ! + P(ik) P(ab)
|
||
|
|
+ t2(m,k,b,a) * B_ooov(m,j,i,c) ! + P(ik) P(ac)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO
|
||
|
|
|
||
|
|
!$OMP DO
|
||
|
|
do a = 1, nV
|
||
|
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||
|
|
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) * (1d0 / delta)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO
|
||
|
|
|
||
|
|
! E_T
|
||
|
|
!$OMP DO
|
||
|
|
do a = 1, nV
|
||
|
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||
|
|
e_t(a) = e_t(a) + t3_bc(i,j,k,a) * delta * t3_bc(i,j,k,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO nowait
|
||
|
|
|
||
|
|
! E_ST
|
||
|
|
!$OMP DO
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3_bc(i,j,k,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO nowait
|
||
|
|
|
||
|
|
! E_DT
|
||
|
|
!$OMP DO
|
||
|
|
do a = 1, nV
|
||
|
|
do k = 1, nO
|
||
|
|
do j = 1, nO
|
||
|
|
do i = 1, nO
|
||
|
|
e_dt(a) = e_dt(a) + t2(i,j,a,b) * f_ov(k,c) * t3_bc(i,j,k,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
!$OMP END DO
|
||
|
|
enddo
|
||
|
|
!$OMP MASTER
|
||
|
|
call wall_time(tb)
|
||
|
|
write(*,'(A1,F6.2,A5,F10.2,A2)') ' ', dble(c)/dble(nV)*100d0, '% in ', tb-ta, ' s'
|
||
|
|
!$OMP END MASTER
|
||
|
|
enddo
|
||
|
|
!$OMP END PARALLEL
|
||
|
|
|
||
|
|
do a = 2, nV
|
||
|
|
e_t(1) = e_t(1) + e_t(a)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
do a = 2, nV
|
||
|
|
e_dt(1) = e_dt(1) + e_dt(a)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
e_t = e_t / 36d0
|
||
|
|
|
||
|
|
do a = 1, nV
|
||
|
|
do i = 1, nO
|
||
|
|
e_st = e_st + s(i,a) * t1(i,a)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
e_st = e_st * 0.25d0
|
||
|
|
|
||
|
|
e_dt = e_dt * 0.25d0
|
||
|
|
|
||
|
|
! (T)
|
||
|
|
!print*,e_t(1),e_st,e_dt(1)
|
||
|
|
energy = e_t(1) + e_st + e_dt(1)
|
||
|
|
|
||
|
|
deallocate(t3_bc,s)
|
||
|
|
|
||
|
|
end
|