PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 04:13:52 +01:00
Code Releases Activity

OMP for phLR

Browse Source
This commit is contained in:
AbdAmmar 2024-12-01 11:22:29 +01:00
parent da4f8df0f8
commit 6cfe4a5dec
2 changed files with 163 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src/LR/phLR_A.f90
View File

@ -25,6 +25,9 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph)
double precision,external :: Kronecker_delta
integer :: i,j,a,b,ia,jb
integer :: nn,jb0
logical :: i_eq_j
double precision :: ct1,ct2
! Output variables
@ -39,22 +42,49 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph)
if(ispin == 1) then
ia = 0
do i=nC+1,nO
do a=nO+1,nBas-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
+ 2d0*lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
nn = nBas - nR - nO
ct1 = 2d0 * lambda
ct2 = - (1d0 - delta_dRPA) * lambda
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, i_eq_j, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nBas, nn, ct1, ct2, e, ERI, Aph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nBas-nR
ia = a - nO + (i - nC - 1) * nn
end do
end do
end do
end do
do j = nC+1, nO
i_eq_j = i == j
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nBas-nR
jb = b + jb0
Aph(ia,jb) = ct1 * ERI(i,b,a,j) + ct2 * ERI(i,b,j,a)
if(i_eq_j) then
if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i)
endif
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
!ia = 0
!do i=nC+1,nO
! do a=nO+1,nBas-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nBas-nR
! jb = jb + 1
! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
! + 2d0*lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
! end do
! end do
! end do
!end do
end if
@ -62,22 +92,48 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph)
if(ispin == 2) then
ia = 0
do i=nC+1,nO
do a=nO+1,nBas-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
- (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
nn = nBas - nR - nO
ct2 = - (1d0 - delta_dRPA) * lambda
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, i_eq_j, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nBas, nn, ct2, e, ERI, Aph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nBas-nR
ia = a - nO + (i - nC - 1) * nn
end do
end do
end do
end do
do j = nC+1, nO
i_eq_j = i == j
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nBas-nR
jb = b + jb0
Aph(ia,jb) = ct2 * ERI(i,b,j,a)
if(i_eq_j) then
if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i)
endif
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
! ia = 0
! do i=nC+1,nO
! do a=nO+1,nBas-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nBas-nR
! jb = jb + 1
! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
! - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
! end do
! end do
! end do
! end do
end if

107
src/LR/phLR_B.f90
View File

@ -17,6 +17,8 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph)
double precision :: delta_dRPA
integer :: i,j,a,b,ia,jb
integer :: nn,jb0
double precision :: ct1,ct2
! Output variables
@ -31,21 +33,44 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph)
if(ispin == 1) then
ia = 0
do i=nC+1,nO
do a=nO+1,nBas-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
Bph(ia,jb) = 2d0*lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
end do
end do
end do
end do
nn = nBas - nR - nO
ct1 = 2d0 * lambda
ct2 = - (1d0 - delta_dRPA) * lambda
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nBas, nn, ct1, ct2, ERI, Bph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nBas-nR
ia = a - nO + (i - nC - 1) * nn
do j = nC+1, nO
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nBas-nR
jb = b + jb0
Bph(ia,jb) = ct1 * ERI(i,j,a,b) + ct2 * ERI(i,j,b,a)
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
!ia = 0
!do i=nC+1,nO
! do a=nO+1,nBas-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nBas-nR
! jb = jb + 1
! Bph(ia,jb) = 2d0*lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
! end do
! end do
! end do
!end do
end if
@ -53,21 +78,43 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph)
if(ispin == 2) then
ia = 0
do i=nC+1,nO
do a=nO+1,nBas-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
Bph(ia,jb) = - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
end do
end do
end do
end do
nn = nBas - nR - nO
ct2 = - (1d0 - delta_dRPA) * lambda
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nBas, nn, ct2, ERI, Bph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nBas-nR
ia = a - nO + (i - nC - 1) * nn
do j = nC+1, nO
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nBas-nR
jb = b + jb0
Bph(ia,jb) = ct2 * ERI(i,j,b,a)
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
! ia = 0
! do i=nC+1,nO
! do a=nO+1,nBas-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nBas-nR
! jb = jb + 1
! Bph(ia,jb) = - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
! end do
! end do
! end do
! end do
end if