LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-07 05:53:37 +01:00
Code Releases Activity
ba73d91fd3
qp2/src/ccsd/ccsd_t_spin_orb.irp.f
ydamour fadbddc869 add ccsd
2023-03-13 14:08:32 +01:00

377 lines
10 KiB
Fortran
Raw Blame History

! 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
View Git Blame Copy Permalink