mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-06-02 11:25:23 +02:00
157 lines
3.3 KiB
Fortran
157 lines
3.3 KiB
Fortran
subroutine ccsd_energy_space_chol(nO,nV,tau,t1,energy)
|
|
|
|
implicit none
|
|
|
|
integer, intent(in) :: nO, nV
|
|
double precision, intent(in) :: tau(nO,nO,nV,nV)
|
|
double precision, intent(in) :: t1(nO,nV)
|
|
double precision, intent(out) :: energy
|
|
|
|
! internal
|
|
integer :: i,j,a,b
|
|
double precision :: e
|
|
|
|
energy = 0d0
|
|
!$omp parallel &
|
|
!$omp shared(nO,nV,energy,tau,t1,&
|
|
!$omp cc_space_f_vo,cc_space_w_oovv) &
|
|
!$omp private(i,j,a,b,e) &
|
|
!$omp default(none)
|
|
e = 0d0
|
|
!$omp do
|
|
do a = 1, nV
|
|
do i = 1, nO
|
|
e = e + 2d0 * cc_space_f_vo(a,i) * t1(i,a)
|
|
enddo
|
|
enddo
|
|
!$omp end do nowait
|
|
!$omp do
|
|
do b = 1, nV
|
|
do a = 1, nV
|
|
do j = 1, nO
|
|
do i = 1, nO
|
|
e = e + tau(i,j,a,b) * cc_space_w_oovv(i,j,a,b)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$omp end do nowait
|
|
!$omp critical
|
|
energy = energy + e
|
|
!$omp end critical
|
|
!$omp end parallel
|
|
|
|
end
|
|
|
|
! Tau
|
|
|
|
subroutine update_tau_space_chol(nO,nV,t1,t2,tau)
|
|
|
|
implicit none
|
|
|
|
! in
|
|
integer, intent(in) :: nO, nV
|
|
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV)
|
|
|
|
! out
|
|
double precision, intent(out) :: tau(nO,nO,nV,nV)
|
|
|
|
! internal
|
|
integer :: i,j,a,b
|
|
|
|
!$OMP PARALLEL &
|
|
!$OMP SHARED(nO,nV,tau,t2,t1) &
|
|
!$OMP PRIVATE(i,j,a,b) &
|
|
!$OMP DEFAULT(NONE)
|
|
!$OMP DO
|
|
do b = 1, nV
|
|
do a = 1, nV
|
|
do j = 1, nO
|
|
do i = 1, nO
|
|
tau(i,j,a,b) = t2(i,j,a,b) + t1(i,a) * t1(j,b)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
end
|
|
|
|
! R1
|
|
|
|
subroutine compute_r1_space_chol(gpu_data, nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
|
|
use gpu_module
|
|
implicit none
|
|
|
|
! in
|
|
type(c_ptr), intent(in) :: gpu_data
|
|
integer, intent(in) :: nO, nV
|
|
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV), tau(nO,nO,nV,nV)
|
|
double precision, intent(in) :: H_oo(nO,nO), H_vv(nV,nV), H_vo(nV,nO)
|
|
|
|
! out
|
|
double precision, intent(out) :: r1(nO,nV), max_r1
|
|
|
|
! internal
|
|
integer :: u,i,j,beta,a,b
|
|
|
|
|
|
call compute_r1_space_chol_gpu(gpu_data, nO, nV, t1, r1, max_r1)
|
|
|
|
double precision, allocatable :: X_ovov(:,:,:,:)
|
|
|
|
integer :: iblock, block_size, nVmax
|
|
double precision, allocatable :: W_vvov(:,:,:,:), W_vvov_tmp(:,:,:,:), T_vvoo(:,:,:,:)
|
|
|
|
double precision, allocatable :: W_oovo(:,:,:,:)
|
|
allocate(W_oovo(nO,nO,nV,nO))
|
|
|
|
! !$omp parallel &
|
|
! !$omp shared(nO,nV,cc_space_v_oovo,W_oovo) &
|
|
! !$omp private(u,a,i,j) &
|
|
! !$omp default(none)
|
|
! do u = 1, nO
|
|
! !$omp do
|
|
! do a = 1, nV
|
|
! do j = 1, nO
|
|
! do i = 1, nO
|
|
! W_oovo(i,j,a,u) = 2d0 * cc_space_v_oovo(i,j,a,u) - cc_space_v_oovo(j,i,a,u)
|
|
! enddo
|
|
! enddo
|
|
! enddo
|
|
! !$omp end do nowait
|
|
! enddo
|
|
! !$omp end parallel
|
|
|
|
! call dgemm('T','N', nO, nV, nO*nO*nV, &
|
|
! -1d0, W_oovo, nO * nO * nV, &
|
|
! tau , nO * nO * nV, &
|
|
! 1d0, r1 , nO)
|
|
!
|
|
! deallocate(W_oovo)
|
|
|
|
max_r1 = 0d0
|
|
do a = 1, nV
|
|
do i = 1, nO
|
|
max_r1 = max(dabs(r1(i,a)), max_r1)
|
|
enddo
|
|
enddo
|
|
|
|
! Change the sign for consistency with the code in spin orbitals
|
|
!$omp parallel &
|
|
!$omp shared(nO,nV,r1) &
|
|
!$omp private(a,i) &
|
|
!$omp default(none)
|
|
!$omp do
|
|
do a = 1, nV
|
|
do i = 1, nO
|
|
r1(i,a) = -r1(i,a)
|
|
enddo
|
|
enddo
|
|
!$omp end do
|
|
!$omp end parallel
|
|
|
|
end
|
|
|