From a37cfb496edf25e7c81ca78c0c7f9d9794dc47c3 Mon Sep 17 00:00:00 2001 From: pfloos Date: Wed, 22 Nov 2023 17:02:46 +0100 Subject: [PATCH] clean up AOtoMO transform --- src/AOtoMO/AOtoMO_ERI_GHF.f90 | 8 ++-- src/AOtoMO/AOtoMO_ERI_RHF.f90 | 38 +++++++++++++++++++ .../{AOtoMO_ERI.f90 => AOtoMO_ERI_UHF.f90} | 5 ++- src/GF/qsRGF2.f90 | 2 +- src/GF/qsUGF2.f90 | 6 +-- src/GT/qsRGTeh.f90 | 2 +- src/GT/qsRGTpp.f90 | 2 +- src/GT/qsUGTpp.f90 | 6 +-- src/GW/SRG_qsGW.f90 | 2 +- src/GW/qsGGW.f90 | 8 ++-- src/GW/qsRGW.f90 | 2 +- src/GW/qsUGW.f90 | 6 +-- src/HF/GHF_search.f90 | 8 ++-- src/HF/RHF_search.f90 | 2 +- src/HF/UHF_search.f90 | 6 +-- src/QuAcK/GQuAcK.f90 | 8 ++-- src/QuAcK/RQuAcK.f90 | 2 +- src/QuAcK/UQuAcK.f90 | 6 +-- 18 files changed, 78 insertions(+), 41 deletions(-) create mode 100644 src/AOtoMO/AOtoMO_ERI_RHF.f90 rename src/AOtoMO/{AOtoMO_ERI.f90 => AOtoMO_ERI_UHF.f90} (86%) diff --git a/src/AOtoMO/AOtoMO_ERI_GHF.f90 b/src/AOtoMO/AOtoMO_ERI_GHF.f90 index b0e027a..7c7a31c 100644 --- a/src/AOtoMO/AOtoMO_ERI_GHF.f90 +++ b/src/AOtoMO/AOtoMO_ERI_GHF.f90 @@ -1,4 +1,4 @@ -subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,c3,c4,ERI_AO_basis,ERI_MO_basis) +subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,ERI_AO_basis,ERI_MO_basis) ! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm ! bra and ket are the spin of (bra1 bra2|ket1 ket2) @@ -13,8 +13,6 @@ subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,c3,c4,ERI_AO_basis,ERI_MO_basis) double precision,intent(in) :: ERI_AO_basis(nBas,nBas,nBas,nBas) double precision,intent(in) :: c1(nBas,nBas2) double precision,intent(in) :: c2(nBas,nBas2) - double precision,intent(in) :: c3(nBas,nBas2) - double precision,intent(in) :: c4(nBas,nBas2) ! Local variables @@ -38,7 +36,7 @@ subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,c3,c4,ERI_AO_basis,ERI_MO_basis) do la=1,nBas do nu=1,nBas do mu=1,nBas - scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO_basis(mu,nu,la,si)*c4(si,l) + scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO_basis(mu,nu,la,si)*c2(si,l) enddo enddo enddo @@ -66,7 +64,7 @@ subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,c3,c4,ERI_AO_basis,ERI_MO_basis) do la=1,nBas do nu=1,nBas do i=1,nBas2 - scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO_basis(i,nu,la,l)*c3(la,k) + scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO_basis(i,nu,la,l)*c1(la,k) enddo enddo enddo diff --git a/src/AOtoMO/AOtoMO_ERI_RHF.f90 b/src/AOtoMO/AOtoMO_ERI_RHF.f90 new file mode 100644 index 0000000..294ebbf --- /dev/null +++ b/src/AOtoMO/AOtoMO_ERI_RHF.f90 @@ -0,0 +1,38 @@ +subroutine AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) + +! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: c(nBas,nBas) + +! Local variables + + double precision,allocatable :: scr(:,:,:,:) + integer :: mu,nu,la,si + integer :: i,j,k,l + +! Output variables + + double precision,intent(out) :: ERI_MO(nBas,nBas,nBas,nBas) + +! Memory allocation + + allocate(scr(nBas,nBas,nBas,nBas)) + +! Four-index transform via semi-direct O(N^5) algorithm + + call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3) + + call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3) + + call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3) + + call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3) + +end subroutine diff --git a/src/AOtoMO/AOtoMO_ERI.f90 b/src/AOtoMO/AOtoMO_ERI_UHF.f90 similarity index 86% rename from src/AOtoMO/AOtoMO_ERI.f90 rename to src/AOtoMO/AOtoMO_ERI_UHF.f90 index 7c5ceab..c86d83d 100644 --- a/src/AOtoMO/AOtoMO_ERI.f90 +++ b/src/AOtoMO/AOtoMO_ERI_UHF.f90 @@ -1,4 +1,4 @@ -subroutine AOtoMO_ERI(bra,ket,nBas,c,ERI_AO,ERI_MO) +subroutine AOtoMO_ERI_UHF(bra,ket,nBas,c,ERI_AO,ERI_MO) ! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm ! bra and ket are the spin of (bra|ket) = (bra bra|ket ket) = @@ -11,7 +11,8 @@ subroutine AOtoMO_ERI(bra,ket,nBas,c,ERI_AO,ERI_MO) integer,intent(in) :: bra integer,intent(in) :: ket integer,intent(in) :: nBas - double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas),c(nBas,nBas,nspin) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: c(nBas,nBas,nspin) ! Local variables diff --git a/src/GF/qsRGF2.f90 b/src/GF/qsRGF2.f90 index 6858c8c..545ba10 100644 --- a/src/GF/qsRGF2.f90 +++ b/src/GF/qsRGF2.f90 @@ -143,7 +143,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si ! AO to MO transformation of two-electron integrals - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) ! Compute self-energy and renormalization factor diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index f4988ed..7c8a066 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -166,15 +166,15 @@ subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved ! 4-index transform for (aa|aa) block - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_aaaa) + call AOtoMO_ERI_UHF(1,1,nBas,c,ERI_AO,ERI_aaaa) ! 4-index transform for (aa|bb) block - call AOtoMO_ERI(1,2,nBas,c,ERI_AO,ERI_aabb) + call AOtoMO_ERI_UHF(1,2,nBas,c,ERI_AO,ERI_aabb) ! 4-index transform for (bb|bb) block - call AOtoMO_ERI(2,2,nBas,c,ERI_AO,ERI_bbbb) + call AOtoMO_ERI_UHF(2,2,nBas,c,ERI_AO,ERI_bbbb) !------------------------------------------------! ! Compute self-energy and renormalization factor ! diff --git a/src/GT/qsRGTeh.f90 b/src/GT/qsRGTeh.f90 index d41ad1d..dce484f 100644 --- a/src/GT/qsRGTeh.f90 +++ b/src/GT/qsRGTeh.f90 @@ -169,7 +169,7 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d ! AO to MO transformation of two-electron integrals - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) ! Compute linear response diff --git a/src/GT/qsRGTpp.f90 b/src/GT/qsRGTpp.f90 index 941fa63..8211468 100644 --- a/src/GT/qsRGTpp.f90 +++ b/src/GT/qsRGTpp.f90 @@ -182,7 +182,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d ! AO to MO transformation of two-electron integrals - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) ! Compute linear response diff --git a/src/GT/qsUGTpp.f90 b/src/GT/qsUGTpp.f90 index ee8fe11..752e755 100644 --- a/src/GT/qsUGTpp.f90 +++ b/src/GT/qsUGTpp.f90 @@ -190,15 +190,15 @@ subroutine qsUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B ! 4-index transform for (aa|aa) block - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_aaaa) + call AOtoMO_ERI_UHF(1,1,nBas,c,ERI_AO,ERI_aaaa) ! 4-index transform for (aa|bb) block - call AOtoMO_ERI(1,2,nBas,c,ERI_AO,ERI_aabb) + call AOtoMO_ERI_UHF(1,2,nBas,c,ERI_AO,ERI_aabb) ! 4-index transform for (bb|bb) block - call AOtoMO_ERI(2,2,nBas,c,ERI_AO,ERI_bbbb) + call AOtoMO_ERI_UHF(2,2,nBas,c,ERI_AO,ERI_bbbb) !---------------------------------------------- ! alpha-beta block diff --git a/src/GW/SRG_qsGW.f90 b/src/GW/SRG_qsGW.f90 index a4ab5d3..274f928 100644 --- a/src/GW/SRG_qsGW.f90 +++ b/src/GW/SRG_qsGW.f90 @@ -176,7 +176,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, call AOtoMO(nBas,cHF,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz)) end do - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) call wall_time(tao2) diff --git a/src/GW/qsGGW.f90 b/src/GW/qsGGW.f90 index 5678676..dc5d084 100644 --- a/src/GW/qsGGW.f90 +++ b/src/GW/qsGGW.f90 @@ -237,16 +237,16 @@ subroutine qsGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop call AOtoMO_GHF(nBas,nBas2,Ca,Cb,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz)) end do - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,Ca,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,Ca,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,Cb,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,Cb,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) deallocate(ERI_tmp) diff --git a/src/GW/qsRGW.f90 b/src/GW/qsRGW.f90 index 59084d0..b6a74fe 100644 --- a/src/GW/qsRGW.f90 +++ b/src/GW/qsRGW.f90 @@ -172,7 +172,7 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop call AOtoMO(nBas,c,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz)) end do - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) ! Compute linear response diff --git a/src/GW/qsUGW.f90 b/src/GW/qsUGW.f90 index 80f11c3..524322a 100644 --- a/src/GW/qsUGW.f90 +++ b/src/GW/qsUGW.f90 @@ -191,15 +191,15 @@ subroutine qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE ! 4-index transform for (aa|aa) block - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_aaaa) + call AOtoMO_ERI_UHF(1,1,nBas,c,ERI_AO,ERI_aaaa) ! 4-index transform for (aa|bb) block - call AOtoMO_ERI(1,2,nBas,c,ERI_AO,ERI_aabb) + call AOtoMO_ERI_UHF(1,2,nBas,c,ERI_AO,ERI_aabb) ! 4-index transform for (bb|bb) block - call AOtoMO_ERI(2,2,nBas,c,ERI_AO,ERI_bbbb) + call AOtoMO_ERI_UHF(2,2,nBas,c,ERI_AO,ERI_bbbb) ! Compute linear response diff --git a/src/HF/GHF_search.f90 b/src/HF/GHF_search.f90 index 992d6e8..796202a 100644 --- a/src/HF/GHF_search.f90 +++ b/src/HF/GHF_search.f90 @@ -122,16 +122,16 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu ! 4-index transform - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,Ca,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,Ca,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,Cb,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,Cb,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) deallocate(Ca,Cb,ERI_tmp) diff --git a/src/HF/RHF_search.f90 b/src/HF/RHF_search.f90 index 159852b..a60f347 100644 --- a/src/HF/RHF_search.f90 +++ b/src/HF/RHF_search.f90 @@ -107,7 +107,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN write(*,*) write(*,*) 'AO to MO transformation... Please be patient' write(*,*) - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO) call wall_time(end_AOtoMO) t_AOtoMO = end_AOtoMO - start_AOtoMO diff --git a/src/HF/UHF_search.f90 b/src/HF/UHF_search.f90 index 97eae91..708db73 100644 --- a/src/HF/UHF_search.f90 +++ b/src/HF/UHF_search.f90 @@ -120,13 +120,13 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu write(*,*) ! 4-index transform for (aa|aa) block - call AOtoMO_ERI(1,1,nBas,c,ERI_AO,ERI_aaaa) + call AOtoMO_ERI_UHF(1,1,nBas,c,ERI_AO,ERI_aaaa) ! 4-index transform for (aa|bb) block - call AOtoMO_ERI(1,2,nBas,c,ERI_AO,ERI_aabb) + call AOtoMO_ERI_UHF(1,2,nBas,c,ERI_AO,ERI_aabb) ! 4-index transform for (bb|bb) block - call AOtoMO_ERI(2,2,nBas,c,ERI_AO,ERI_bbbb) + call AOtoMO_ERI_UHF(2,2,nBas,c,ERI_AO,ERI_bbbb) call wall_time(end_AOtoMO) diff --git a/src/QuAcK/GQuAcK.f90 b/src/QuAcK/GQuAcK.f90 index 418d902..aaadb3a 100644 --- a/src/QuAcK/GQuAcK.f90 +++ b/src/QuAcK/GQuAcK.f90 @@ -144,16 +144,16 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do ! 4-index transform - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,Ca,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,Ca,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Ca,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,Cb,Ca,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Ca,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) - call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,Cb,Cb,ERI_AO,ERI_tmp) + call AOtoMO_ERI_GHF(nBas,nBas2,Cb,Cb,ERI_AO,ERI_tmp) ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:) deallocate(Ca,Cb,ERI_tmp) diff --git a/src/QuAcK/RQuAcK.f90 b/src/QuAcK/RQuAcK.f90 index 0a2bb6a..dc44b33 100644 --- a/src/QuAcK/RQuAcK.f90 +++ b/src/QuAcK/RQuAcK.f90 @@ -158,7 +158,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d ! 4-index transform - call AOtoMO_ERI(1,1,nBas,cHF,ERI_AO,ERI_MO) + call AOtoMO_ERI_RHF(nBas,cHF,ERI_AO,ERI_MO) call wall_time(end_AOtoMO) diff --git a/src/QuAcK/UQuAcK.f90 b/src/QuAcK/UQuAcK.f90 index 99c0681..228da29 100644 --- a/src/QuAcK/UQuAcK.f90 +++ b/src/QuAcK/UQuAcK.f90 @@ -167,15 +167,15 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do ! 4-index transform for (aa|aa) block - call AOtoMO_ERI(1,1,nBas,cHF,ERI_AO,ERI_aaaa) + call AOtoMO_ERI_UHF(1,1,nBas,cHF,ERI_AO,ERI_aaaa) ! 4-index transform for (aa|bb) block - call AOtoMO_ERI(1,2,nBas,cHF,ERI_AO,ERI_aabb) + call AOtoMO_ERI_UHF(1,2,nBas,cHF,ERI_AO,ERI_aabb) ! 4-index transform for (bb|bb) block - call AOtoMO_ERI(2,2,nBas,cHF,ERI_AO,ERI_bbbb) + call AOtoMO_ERI_UHF(2,2,nBas,cHF,ERI_AO,ERI_bbbb) call wall_time(end_AOtoMO)