From 203ce9541cd05b80740028555af5728c0faf3c83 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 17 Dec 2021 11:41:40 +0100 Subject: [PATCH 01/12] regularized GW --- input/methods | 2 +- input/options | 14 +- mol/h2.xyz | 2 +- src/GF/G0F2.f90 | 4 +- src/GF/UG0F2.f90 | 3 +- src/GF/evGF2.f90 | 4 +- src/GF/evUGF2.f90 | 3 +- src/GF/qsGF2.f90 | 3 +- src/GF/qsUGF2.f90 | 3 +- src/{MBPT => GT}/Bethe_Salpeter_Tmatrix.f90 | 0 ..._Salpeter_Tmatrix_dynamic_perturbation.f90 | 0 src/{MBPT => GT}/G0T0.f90 | 3 +- src/{MBPT => GT}/dynamic_Tmatrix_A.f90 | 0 src/{MBPT => GT}/evGT.f90 | 3 +- .../excitation_density_Tmatrix.f90 | 0 src/{MBPT => GT}/print_G0T0.f90 | 0 src/{MBPT => GT}/print_evGT.f90 | 0 src/{MBPT => GT}/print_qsGT.f90 | 0 src/{MBPT => GT}/qsGT.f90 | 3 +- .../renormalization_factor_Tmatrix.f90 | 0 src/{MBPT => GT}/self_energy_Tmatrix.f90 | 0 src/{MBPT => GT}/self_energy_Tmatrix_diag.f90 | 0 src/{MBPT => GT}/static_Tmatrix_TA.f90 | 2 +- src/{MBPT => GT}/static_Tmatrix_TB.f90 | 2 +- src/{MBPT => GW}/Bethe_Salpeter.f90 | 0 .../Bethe_Salpeter_AB_matrix_dynamic.f90 | 0 src/{MBPT => GW}/Bethe_Salpeter_A_matrix.f90 | 0 .../Bethe_Salpeter_A_matrix_dynamic.f90 | 0 src/{MBPT => GW}/Bethe_Salpeter_B_matrix.f90 | 0 .../Bethe_Salpeter_ZAB_matrix_dynamic.f90 | 0 .../Bethe_Salpeter_ZA_matrix_dynamic.f90 | 0 .../Bethe_Salpeter_dynamic_perturbation.f90 | 0 ...alpeter_dynamic_perturbation_iterative.f90 | 0 src/{MBPT => GW}/G0W0.f90 | 18 ++- src/{MBPT => GW}/G0W0_SOSEX.f90 | 0 src/{MBPT => GW}/QP_graph.f90 | 0 src/{MBPT => GW}/QP_roots.f90 | 0 .../Sangalli_dynamic_perturbation.f90 | 0 src/{MBPT => GW}/SigmaC.f90 | 0 src/{MBPT => GW}/UG0W0.f90 | 3 +- src/{MBPT => GW}/USigmaC.f90 | 0 src/{MBPT => GW}/dSigmaC.f90 | 0 src/{MBPT => GW}/dUSigmaC.f90 | 0 src/{MBPT => GW}/evGW.f90 | 46 ++++-- src/{MBPT => GW}/evUGW.f90 | 3 +- src/{MBPT => GW}/exchange_matrix_MO_basis.f90 | 0 src/{MBPT => GW}/excitation_density.f90 | 0 src/{MBPT => GW}/excitation_density_SOSEX.f90 | 0 src/{MBPT => GW}/plot_GW.f90 | 0 src/{MBPT => GW}/print_G0W0.f90 | 0 src/{MBPT => GW}/print_SOSEX.f90 | 0 src/{MBPT => GW}/print_UG0W0.f90 | 0 src/{MBPT => GW}/print_evGW.f90 | 0 src/{MBPT => GW}/print_evUGW.f90 | 0 src/{MBPT => GW}/print_qsGW.f90 | 0 src/{MBPT => GW}/print_qsUGW.f90 | 0 src/{MBPT => GW}/qsGW.f90 | 31 +++- src/{MBPT => GW}/qsGW_PT.f90 | 0 src/{MBPT => GW}/qsUGW.f90 | 3 +- src/GW/regularized_renormalization_factor.f90 | 87 ++++++++++++ .../regularized_self_energy_correlation.f90 | 7 +- ...gularized_self_energy_correlation_diag.f90 | 7 +- src/{MBPT => GW}/renormalization_factor.f90 | 33 ++--- .../renormalization_factor_SOSEX.f90 | 0 src/{MBPT => GW}/self_energy_correlation.f90 | 7 +- .../self_energy_correlation_SOSEX_diag.f90 | 0 .../self_energy_correlation_diag.f90 | 1 - src/{MBPT => GW}/self_energy_exchange.f90 | 0 .../self_energy_exchange_diag.f90 | 0 src/{MBPT => GW}/static_screening_WA.f90 | 0 src/{MBPT => GW}/static_screening_WB.f90 | 0 src/{MBPT => GW}/ufBSE.f90 | 3 +- src/{MBPT => GW}/ufG0W0.f90 | 3 +- src/{MBPT => GW}/ufGW.f90 | 3 +- .../unrestricted_Bethe_Salpeter.f90 | 0 .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 0 ...ricted_Bethe_Salpeter_A_matrix_dynamic.f90 | 0 .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 0 ...icted_Bethe_Salpeter_ZA_matrix_dynamic.f90 | 0 ...ed_Bethe_Salpeter_dynamic_perturbation.f90 | 0 src/{MBPT => GW}/unrestricted_QP_graph.f90 | 0 .../unrestricted_excitation_density.f90 | 0 ...ted_regularized_renormalization_factor.f90 | 111 +++++++++++++++ ...ed_regularized_self_energy_correlation.f90 | 133 ++++++++++++++++++ ...gularized_self_energy_correlation_diag.f90 | 126 +++++++++++++++++ .../unrestricted_renormalization_factor.f90 | 2 +- .../unrestricted_self_energy_correlation.f90 | 2 +- ...estricted_self_energy_correlation_diag.f90 | 2 +- src/MBPT/Makefile | 10 -- src/MBPT/Sangalli_A_matrix_dynamic.f90.x | 78 ---------- src/MBPT/excitation_density_RI.f90 | 65 --------- src/MBPT/excitation_density_SOSEX_RI.f90 | 65 --------- src/QuAcK/QuAcK.f90 | 66 +++++---- src/QuAcK/read_options.f90 | 49 ++++++- 94 files changed, 679 insertions(+), 336 deletions(-) rename src/{MBPT => GT}/Bethe_Salpeter_Tmatrix.f90 (100%) rename src/{MBPT => GT}/Bethe_Salpeter_Tmatrix_dynamic_perturbation.f90 (100%) rename src/{MBPT => GT}/G0T0.f90 (98%) rename src/{MBPT => GT}/dynamic_Tmatrix_A.f90 (100%) rename src/{MBPT => GT}/evGT.f90 (99%) rename src/{MBPT => GT}/excitation_density_Tmatrix.f90 (100%) rename src/{MBPT => GT}/print_G0T0.f90 (100%) rename src/{MBPT => GT}/print_evGT.f90 (100%) rename src/{MBPT => GT}/print_qsGT.f90 (100%) rename src/{MBPT => GT}/qsGT.f90 (98%) rename src/{MBPT => GT}/renormalization_factor_Tmatrix.f90 (100%) rename src/{MBPT => GT}/self_energy_Tmatrix.f90 (100%) rename src/{MBPT => GT}/self_energy_Tmatrix_diag.f90 (100%) rename src/{MBPT => GT}/static_Tmatrix_TA.f90 (96%) rename src/{MBPT => GT}/static_Tmatrix_TB.f90 (96%) rename src/{MBPT => GW}/Bethe_Salpeter.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_AB_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_A_matrix.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_A_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_B_matrix.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_ZAB_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_ZA_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_dynamic_perturbation.f90 (100%) rename src/{MBPT => GW}/Bethe_Salpeter_dynamic_perturbation_iterative.f90 (100%) rename src/{MBPT => GW}/G0W0.f90 (92%) rename src/{MBPT => GW}/G0W0_SOSEX.f90 (100%) rename src/{MBPT => GW}/QP_graph.f90 (100%) rename src/{MBPT => GW}/QP_roots.f90 (100%) rename src/{MBPT => GW}/Sangalli_dynamic_perturbation.f90 (100%) rename src/{MBPT => GW}/SigmaC.f90 (100%) rename src/{MBPT => GW}/UG0W0.f90 (98%) rename src/{MBPT => GW}/USigmaC.f90 (100%) rename src/{MBPT => GW}/dSigmaC.f90 (100%) rename src/{MBPT => GW}/dUSigmaC.f90 (100%) rename src/{MBPT => GW}/evGW.f90 (87%) rename src/{MBPT => GW}/evUGW.f90 (99%) rename src/{MBPT => GW}/exchange_matrix_MO_basis.f90 (100%) rename src/{MBPT => GW}/excitation_density.f90 (100%) rename src/{MBPT => GW}/excitation_density_SOSEX.f90 (100%) rename src/{MBPT => GW}/plot_GW.f90 (100%) rename src/{MBPT => GW}/print_G0W0.f90 (100%) rename src/{MBPT => GW}/print_SOSEX.f90 (100%) rename src/{MBPT => GW}/print_UG0W0.f90 (100%) rename src/{MBPT => GW}/print_evGW.f90 (100%) rename src/{MBPT => GW}/print_evUGW.f90 (100%) rename src/{MBPT => GW}/print_qsGW.f90 (100%) rename src/{MBPT => GW}/print_qsUGW.f90 (100%) rename src/{MBPT => GW}/qsGW.f90 (91%) rename src/{MBPT => GW}/qsGW_PT.f90 (100%) rename src/{MBPT => GW}/qsUGW.f90 (99%) create mode 100644 src/GW/regularized_renormalization_factor.f90 rename src/{MBPT => GW}/regularized_self_energy_correlation.f90 (92%) rename src/{MBPT => GW}/regularized_self_energy_correlation_diag.f90 (93%) rename src/{MBPT => GW}/renormalization_factor.f90 (63%) rename src/{MBPT => GW}/renormalization_factor_SOSEX.f90 (100%) rename src/{MBPT => GW}/self_energy_correlation.f90 (91%) rename src/{MBPT => GW}/self_energy_correlation_SOSEX_diag.f90 (100%) rename src/{MBPT => GW}/self_energy_correlation_diag.f90 (98%) rename src/{MBPT => GW}/self_energy_exchange.f90 (100%) rename src/{MBPT => GW}/self_energy_exchange_diag.f90 (100%) rename src/{MBPT => GW}/static_screening_WA.f90 (100%) rename src/{MBPT => GW}/static_screening_WB.f90 (100%) rename src/{MBPT => GW}/ufBSE.f90 (97%) rename src/{MBPT => GW}/ufG0W0.f90 (97%) rename src/{MBPT => GW}/ufGW.f90 (97%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter.f90 (100%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter_A_matrix.f90 (100%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter_A_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter_B_matrix.f90 (100%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter_ZA_matrix_dynamic.f90 (100%) rename src/{MBPT => GW}/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 (100%) rename src/{MBPT => GW}/unrestricted_QP_graph.f90 (100%) rename src/{MBPT => GW}/unrestricted_excitation_density.f90 (100%) create mode 100644 src/GW/unrestricted_regularized_renormalization_factor.f90 create mode 100644 src/GW/unrestricted_regularized_self_energy_correlation.f90 create mode 100644 src/GW/unrestricted_regularized_self_energy_correlation_diag.f90 rename src/{MBPT => GW}/unrestricted_renormalization_factor.f90 (97%) rename src/{MBPT => GW}/unrestricted_self_energy_correlation.f90 (98%) rename src/{MBPT => GW}/unrestricted_self_energy_correlation_diag.f90 (98%) delete mode 100644 src/MBPT/Makefile delete mode 100644 src/MBPT/Sangalli_A_matrix_dynamic.f90.x delete mode 100644 src/MBPT/excitation_density_RI.f90 delete mode 100644 src/MBPT/excitation_density_SOSEX_RI.f90 diff --git a/input/methods b/input/methods index 02ac24b..df2ad59 100644 --- a/input/methods +++ b/input/methods @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - F F T F F + F T F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index f8f9987..e8d2643 100644 --- a/input/options +++ b/input/options @@ -1,15 +1,17 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 T 5 1 1 T F + 1024 0.00001 T 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T -# GF: maxSCF thresh DIIS n_diis lin eta renorm - 256 0.00001 T 5 T 0.00367493 3 -# GW/GT: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 - 256 0.00001 T 5 T 0.0 F F F F F + F T T T T +# GF: maxSCF thresh DIIS n_diis lin eta renorm reg + 256 0.00001 T 5 T 0.0 3 F +# GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg + 256 0.00001 T 5 T 0.0 F F F F F T +# GT: maxSCF thresh DIIS n_diis lin eta TDA_T reg + 256 0.00001 T 5 T 0.0 F F # ACFDT: AC Kx XBS F F F # BSE: BSE dBSE dTDA evDyn diff --git a/mol/h2.xyz b/mol/h2.xyz index 21fde66..d955cc4 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0. 0. 0. -H 0. 0. 0.5 +H 0. 0. 0.7 diff --git a/src/GF/G0F2.f90 b/src/GF/G0F2.f90 index cfc7750..2e98066 100644 --- a/src/GF/G0F2.f90 +++ b/src/GF/G0F2.f90 @@ -1,4 +1,5 @@ -subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) +subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,regularize, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform a one-shot second-order Green function calculation @@ -16,6 +17,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nO integer,intent(in) :: nC diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 index 0389f93..be7d4c1 100644 --- a/src/GF/UG0F2.f90 +++ b/src/GF/UG0F2.f90 @@ -1,4 +1,4 @@ -subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & +subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF) ! Perform unrestricted G0W0 calculation @@ -18,6 +18,7 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta, logical,intent(in) :: spin_flip logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) diff --git a/src/GF/evGF2.f90 b/src/GF/evGF2.f90 index 2203533..f55ae32 100644 --- a/src/GF/evGF2.f90 +++ b/src/GF/evGF2.f90 @@ -1,5 +1,5 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) + linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform eigenvalue self-consistent second-order Green function calculation @@ -20,6 +20,8 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize + integer,intent(in) :: nBas integer,intent(in) :: nO integer,intent(in) :: nC diff --git a/src/GF/evUGF2.f90 b/src/GF/evUGF2.f90 index 5f4d0f3..07749af 100644 --- a/src/GF/evUGF2.f90 +++ b/src/GF/evUGF2.f90 @@ -1,5 +1,5 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & - eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, & + eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, & dipole_int_aa,dipole_int_bb,cHF,eHF) ! Perform self-consistent eigenvalue-only GW calculation @@ -22,6 +22,7 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, logical,intent(in) :: spin_conserved logical,intent(in) :: spin_flip double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index db8e50d..3019091 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -1,5 +1,5 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & + eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) ! Perform a quasiparticle self-consistent GF2 calculation @@ -20,6 +20,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, logical,intent(in) :: singlet logical,intent(in) :: triplet double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nNuc double precision,intent(in) :: ZNuc(nNuc) diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 3295f6f..71d3c97 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -1,4 +1,4 @@ -subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & +subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,regularize, & nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, & ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF) @@ -20,6 +20,7 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, logical,intent(in) :: spin_conserved logical,intent(in) :: spin_flip double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nNuc double precision,intent(in) :: ZNuc(nNuc) diff --git a/src/MBPT/Bethe_Salpeter_Tmatrix.f90 b/src/GT/Bethe_Salpeter_Tmatrix.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_Tmatrix.f90 rename to src/GT/Bethe_Salpeter_Tmatrix.f90 diff --git a/src/MBPT/Bethe_Salpeter_Tmatrix_dynamic_perturbation.f90 b/src/GT/Bethe_Salpeter_Tmatrix_dynamic_perturbation.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_Tmatrix_dynamic_perturbation.f90 rename to src/GT/Bethe_Salpeter_Tmatrix_dynamic_perturbation.f90 diff --git a/src/MBPT/G0T0.f90 b/src/GT/G0T0.f90 similarity index 98% rename from src/MBPT/G0T0.f90 rename to src/GT/G0T0.f90 index 3054daa..8d058e7 100644 --- a/src/MBPT/G0T0.f90 +++ b/src/GT/G0T0.f90 @@ -1,5 +1,5 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0) + linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0) ! Perform one-shot calculation with a T-matrix self-energy (G0T0) @@ -21,6 +21,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC diff --git a/src/MBPT/dynamic_Tmatrix_A.f90 b/src/GT/dynamic_Tmatrix_A.f90 similarity index 100% rename from src/MBPT/dynamic_Tmatrix_A.f90 rename to src/GT/dynamic_Tmatrix_A.f90 diff --git a/src/MBPT/evGT.f90 b/src/GT/evGT.f90 similarity index 99% rename from src/MBPT/evGT.f90 rename to src/GT/evGT.f90 index 12bf2a5..65dcfa4 100644 --- a/src/MBPT/evGT.f90 +++ b/src/GT/evGT.f90 @@ -1,5 +1,5 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas, & + BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,regularize,nBas, & nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0) ! Perform eigenvalue self-consistent calculation with a T-matrix self-energy (evGT) @@ -24,6 +24,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & logical,intent(in) :: singlet logical,intent(in) :: triplet double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC diff --git a/src/MBPT/excitation_density_Tmatrix.f90 b/src/GT/excitation_density_Tmatrix.f90 similarity index 100% rename from src/MBPT/excitation_density_Tmatrix.f90 rename to src/GT/excitation_density_Tmatrix.f90 diff --git a/src/MBPT/print_G0T0.f90 b/src/GT/print_G0T0.f90 similarity index 100% rename from src/MBPT/print_G0T0.f90 rename to src/GT/print_G0T0.f90 diff --git a/src/MBPT/print_evGT.f90 b/src/GT/print_evGT.f90 similarity index 100% rename from src/MBPT/print_evGT.f90 rename to src/GT/print_evGT.f90 diff --git a/src/MBPT/print_qsGT.f90 b/src/GT/print_qsGT.f90 similarity index 100% rename from src/MBPT/print_qsGT.f90 rename to src/GT/print_qsGT.f90 diff --git a/src/MBPT/qsGT.f90 b/src/GT/qsGT.f90 similarity index 98% rename from src/MBPT/qsGT.f90 rename to src/GT/qsGT.f90 index 1d8e32e..6a5aa5a 100644 --- a/src/MBPT/qsGT.f90 +++ b/src/GT/qsGT.f90 @@ -1,5 +1,5 @@ subroutine qsGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA, & - dBSE,dTDA,evDyn,singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & + dBSE,dTDA,evDyn,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) ! Perform a quasiparticle self-consistent GT calculation @@ -24,6 +24,7 @@ subroutine qsGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T,T logical,intent(in) :: singlet logical,intent(in) :: triplet double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nNuc double precision,intent(in) :: ZNuc(nNuc) diff --git a/src/MBPT/renormalization_factor_Tmatrix.f90 b/src/GT/renormalization_factor_Tmatrix.f90 similarity index 100% rename from src/MBPT/renormalization_factor_Tmatrix.f90 rename to src/GT/renormalization_factor_Tmatrix.f90 diff --git a/src/MBPT/self_energy_Tmatrix.f90 b/src/GT/self_energy_Tmatrix.f90 similarity index 100% rename from src/MBPT/self_energy_Tmatrix.f90 rename to src/GT/self_energy_Tmatrix.f90 diff --git a/src/MBPT/self_energy_Tmatrix_diag.f90 b/src/GT/self_energy_Tmatrix_diag.f90 similarity index 100% rename from src/MBPT/self_energy_Tmatrix_diag.f90 rename to src/GT/self_energy_Tmatrix_diag.f90 diff --git a/src/MBPT/static_Tmatrix_TA.f90 b/src/GT/static_Tmatrix_TA.f90 similarity index 96% rename from src/MBPT/static_Tmatrix_TA.f90 rename to src/GT/static_Tmatrix_TA.f90 index 1c78e0d..9935919 100644 --- a/src/MBPT/static_Tmatrix_TA.f90 +++ b/src/GT/static_Tmatrix_TA.f90 @@ -50,7 +50,7 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r do kl=1,nOO ! chi = chi + lambda*rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) + chi = chi - rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) enddo TA(ia,jb) = TA(ia,jb) - 1d0*lambda*chi diff --git a/src/MBPT/static_Tmatrix_TB.f90 b/src/GT/static_Tmatrix_TB.f90 similarity index 96% rename from src/MBPT/static_Tmatrix_TB.f90 rename to src/GT/static_Tmatrix_TB.f90 index d1f993c..d4707c8 100644 --- a/src/MBPT/static_Tmatrix_TB.f90 +++ b/src/GT/static_Tmatrix_TB.f90 @@ -50,7 +50,7 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r do kl=1,nOO ! chi = chi + lambda*rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 - chi = chi + rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 + chi = chi - rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 enddo TB(ia,jb) = TB(ia,jb) - 1d0*lambda*chi diff --git a/src/MBPT/Bethe_Salpeter.f90 b/src/GW/Bethe_Salpeter.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter.f90 rename to src/GW/Bethe_Salpeter.f90 diff --git a/src/MBPT/Bethe_Salpeter_AB_matrix_dynamic.f90 b/src/GW/Bethe_Salpeter_AB_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_AB_matrix_dynamic.f90 rename to src/GW/Bethe_Salpeter_AB_matrix_dynamic.f90 diff --git a/src/MBPT/Bethe_Salpeter_A_matrix.f90 b/src/GW/Bethe_Salpeter_A_matrix.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_A_matrix.f90 rename to src/GW/Bethe_Salpeter_A_matrix.f90 diff --git a/src/MBPT/Bethe_Salpeter_A_matrix_dynamic.f90 b/src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_A_matrix_dynamic.f90 rename to src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 diff --git a/src/MBPT/Bethe_Salpeter_B_matrix.f90 b/src/GW/Bethe_Salpeter_B_matrix.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_B_matrix.f90 rename to src/GW/Bethe_Salpeter_B_matrix.f90 diff --git a/src/MBPT/Bethe_Salpeter_ZAB_matrix_dynamic.f90 b/src/GW/Bethe_Salpeter_ZAB_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_ZAB_matrix_dynamic.f90 rename to src/GW/Bethe_Salpeter_ZAB_matrix_dynamic.f90 diff --git a/src/MBPT/Bethe_Salpeter_ZA_matrix_dynamic.f90 b/src/GW/Bethe_Salpeter_ZA_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_ZA_matrix_dynamic.f90 rename to src/GW/Bethe_Salpeter_ZA_matrix_dynamic.f90 diff --git a/src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 b/src/GW/Bethe_Salpeter_dynamic_perturbation.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 rename to src/GW/Bethe_Salpeter_dynamic_perturbation.f90 diff --git a/src/MBPT/Bethe_Salpeter_dynamic_perturbation_iterative.f90 b/src/GW/Bethe_Salpeter_dynamic_perturbation_iterative.f90 similarity index 100% rename from src/MBPT/Bethe_Salpeter_dynamic_perturbation_iterative.f90 rename to src/GW/Bethe_Salpeter_dynamic_perturbation_iterative.f90 diff --git a/src/MBPT/G0W0.f90 b/src/GW/G0W0.f90 similarity index 92% rename from src/MBPT/G0W0.f90 rename to src/GW/G0W0.f90 index 9065661..aa35dd4 100644 --- a/src/MBPT/G0W0.f90 +++ b/src/GW/G0W0.f90 @@ -1,5 +1,5 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet,triplet,linearize,eta, & + dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,regularize, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) ! Perform G0W0 calculation @@ -24,6 +24,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC @@ -124,13 +125,18 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & !------------------------! call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) - call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) -!--------------------------------! -! Compute renormalization factor ! -!--------------------------------! + if(regularize) then - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + call regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + else + + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + end if !-----------------------------------! ! Solve the quasi-particle equation ! diff --git a/src/MBPT/G0W0_SOSEX.f90 b/src/GW/G0W0_SOSEX.f90 similarity index 100% rename from src/MBPT/G0W0_SOSEX.f90 rename to src/GW/G0W0_SOSEX.f90 diff --git a/src/MBPT/QP_graph.f90 b/src/GW/QP_graph.f90 similarity index 100% rename from src/MBPT/QP_graph.f90 rename to src/GW/QP_graph.f90 diff --git a/src/MBPT/QP_roots.f90 b/src/GW/QP_roots.f90 similarity index 100% rename from src/MBPT/QP_roots.f90 rename to src/GW/QP_roots.f90 diff --git a/src/MBPT/Sangalli_dynamic_perturbation.f90 b/src/GW/Sangalli_dynamic_perturbation.f90 similarity index 100% rename from src/MBPT/Sangalli_dynamic_perturbation.f90 rename to src/GW/Sangalli_dynamic_perturbation.f90 diff --git a/src/MBPT/SigmaC.f90 b/src/GW/SigmaC.f90 similarity index 100% rename from src/MBPT/SigmaC.f90 rename to src/GW/SigmaC.f90 diff --git a/src/MBPT/UG0W0.f90 b/src/GW/UG0W0.f90 similarity index 98% rename from src/MBPT/UG0W0.f90 rename to src/GW/UG0W0.f90 index 90d4ab1..9c7364d 100644 --- a/src/MBPT/UG0W0.f90 +++ b/src/GW/UG0W0.f90 @@ -1,5 +1,5 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb, & + linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb, & dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eGW) ! Perform unrestricted G0W0 calculation @@ -24,6 +24,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev logical,intent(in) :: spin_flip logical,intent(in) :: linearize double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) diff --git a/src/MBPT/USigmaC.f90 b/src/GW/USigmaC.f90 similarity index 100% rename from src/MBPT/USigmaC.f90 rename to src/GW/USigmaC.f90 diff --git a/src/MBPT/dSigmaC.f90 b/src/GW/dSigmaC.f90 similarity index 100% rename from src/MBPT/dSigmaC.f90 rename to src/GW/dSigmaC.f90 diff --git a/src/MBPT/dUSigmaC.f90 b/src/GW/dUSigmaC.f90 similarity index 100% rename from src/MBPT/dUSigmaC.f90 rename to src/GW/dUSigmaC.f90 diff --git a/src/MBPT/evGW.f90 b/src/GW/evGW.f90 similarity index 87% rename from src/MBPT/evGW.f90 rename to src/GW/evGW.f90 index c25f9ab..4790cf4 100644 --- a/src/MBPT/evGW.f90 +++ b/src/GW/evGW.f90 @@ -1,5 +1,5 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -29,6 +29,8 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, logical,intent(in) :: singlet logical,intent(in) :: triplet double precision,intent(in) :: eta + logical,intent(in) :: regularize + integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO @@ -151,7 +153,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,OmRPA, & rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - endif + end if ! Compute spectral weights @@ -161,17 +163,33 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, if(G0W) then -! call regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) - call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + if(regularize) then + + call regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + else + + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + end if else -! call regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) - call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + if(regularize) then - endif + call regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + + else + + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + + end if + + end if ! Solve the quasi-particle equation @@ -198,9 +216,9 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, call DIIS_extrapolation(rcond,nBas,nBas,n_diis,error_diis,e_diis,eGW-eOld,eGW) else n_diis = 0 - endif + end if - endif + end if ! Save quasiparticles energy for next cycle @@ -210,7 +228,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, nSCF = nSCF + 1 - enddo + end do !------------------------------------------------------------------------ ! End main loop !------------------------------------------------------------------------ @@ -231,7 +249,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, stop - endif + end if ! Deallocate memory @@ -288,6 +306,6 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, end if - endif + end if end subroutine evGW diff --git a/src/MBPT/evUGW.f90 b/src/GW/evUGW.f90 similarity index 99% rename from src/MBPT/evUGW.f90 rename to src/GW/evUGW.f90 index ece48d8..3e5faec 100644 --- a/src/MBPT/evUGW.f90 +++ b/src/GW/evUGW.f90 @@ -1,5 +1,5 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc, & EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -29,6 +29,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE logical,intent(in) :: spin_conserved logical,intent(in) :: spin_flip double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) diff --git a/src/MBPT/exchange_matrix_MO_basis.f90 b/src/GW/exchange_matrix_MO_basis.f90 similarity index 100% rename from src/MBPT/exchange_matrix_MO_basis.f90 rename to src/GW/exchange_matrix_MO_basis.f90 diff --git a/src/MBPT/excitation_density.f90 b/src/GW/excitation_density.f90 similarity index 100% rename from src/MBPT/excitation_density.f90 rename to src/GW/excitation_density.f90 diff --git a/src/MBPT/excitation_density_SOSEX.f90 b/src/GW/excitation_density_SOSEX.f90 similarity index 100% rename from src/MBPT/excitation_density_SOSEX.f90 rename to src/GW/excitation_density_SOSEX.f90 diff --git a/src/MBPT/plot_GW.f90 b/src/GW/plot_GW.f90 similarity index 100% rename from src/MBPT/plot_GW.f90 rename to src/GW/plot_GW.f90 diff --git a/src/MBPT/print_G0W0.f90 b/src/GW/print_G0W0.f90 similarity index 100% rename from src/MBPT/print_G0W0.f90 rename to src/GW/print_G0W0.f90 diff --git a/src/MBPT/print_SOSEX.f90 b/src/GW/print_SOSEX.f90 similarity index 100% rename from src/MBPT/print_SOSEX.f90 rename to src/GW/print_SOSEX.f90 diff --git a/src/MBPT/print_UG0W0.f90 b/src/GW/print_UG0W0.f90 similarity index 100% rename from src/MBPT/print_UG0W0.f90 rename to src/GW/print_UG0W0.f90 diff --git a/src/MBPT/print_evGW.f90 b/src/GW/print_evGW.f90 similarity index 100% rename from src/MBPT/print_evGW.f90 rename to src/GW/print_evGW.f90 diff --git a/src/MBPT/print_evUGW.f90 b/src/GW/print_evUGW.f90 similarity index 100% rename from src/MBPT/print_evUGW.f90 rename to src/GW/print_evUGW.f90 diff --git a/src/MBPT/print_qsGW.f90 b/src/GW/print_qsGW.f90 similarity index 100% rename from src/MBPT/print_qsGW.f90 rename to src/GW/print_qsGW.f90 diff --git a/src/MBPT/print_qsUGW.f90 b/src/GW/print_qsUGW.f90 similarity index 100% rename from src/MBPT/print_qsUGW.f90 rename to src/GW/print_qsUGW.f90 diff --git a/src/MBPT/qsGW.f90 b/src/GW/qsGW.f90 similarity index 91% rename from src/MBPT/qsGW.f90 rename to src/GW/qsGW.f90 index 2b7b289..9a418aa 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/GW/qsGW.f90 @@ -1,5 +1,5 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) ! Perform a quasiparticle self-consistent GW calculation @@ -27,6 +27,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, logical,intent(in) :: singlet logical,intent(in) :: triplet double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nNuc double precision,intent(in) :: ZNuc(nNuc) @@ -192,15 +193,31 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE, if(G0W) then -! call regularized_self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) - call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + if(regularize) then + + call regularized_self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + else + + call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + + end if else -! call regularized_self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) - call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + if(regularize) then + + call regularized_self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + + else + + call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) + + endif endif diff --git a/src/MBPT/qsGW_PT.f90 b/src/GW/qsGW_PT.f90 similarity index 100% rename from src/MBPT/qsGW_PT.f90 rename to src/GW/qsGW_PT.f90 diff --git a/src/MBPT/qsUGW.f90 b/src/GW/qsUGW.f90 similarity index 99% rename from src/MBPT/qsUGW.f90 rename to src/GW/qsUGW.f90 index b9d055d..22745fe 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/GW/qsUGW.f90 @@ -1,5 +1,5 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO, & nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa, & dipole_int_bb,PHF,cHF,eHF) @@ -28,6 +28,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE logical,intent(in) :: spin_conserved logical,intent(in) :: spin_flip double precision,intent(in) :: eta + logical,intent(in) :: regularize integer,intent(in) :: nNuc double precision,intent(in) :: ZNuc(nNuc) diff --git a/src/GW/regularized_renormalization_factor.f90 b/src/GW/regularized_renormalization_factor.f90 new file mode 100644 index 0000000..98f3084 --- /dev/null +++ b/src/GW/regularized_renormalization_factor.f90 @@ -0,0 +1,87 @@ +subroutine regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Z) + +! Compute the regularized version of the GW renormalization factor + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: COHSEX + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nS + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS) + +! Local variables + + integer :: i,a,p,jb + double precision :: eps + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: Z(nBas) + +! Initialize + + Z(:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +! static COHSEX approximation + + if(COHSEX) then + + Z(:) = 1d0 + return + + else + + ! Occupied part of the correlation self-energy + + do p=nC+1,nBas-nR + do i=nC+1,nO + do jb=1,nS + eps = e(p) - e(i) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p) = Z(p) - 2d0*rho(p,i,jb)**2*dfk + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC+1,nBas-nR + do a=nO+1,nBas-nR + do jb=1,nS + eps = e(p) - e(a) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p) = Z(p) - 2d0*rho(p,a,jb)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + + end if + +! Compute renormalization factor from derivative of SigC + + Z(:) = 1d0/(1d0 - Z(:)) + +end subroutine regularized_renormalization_factor diff --git a/src/MBPT/regularized_self_energy_correlation.f90 b/src/GW/regularized_self_energy_correlation.f90 similarity index 92% rename from src/MBPT/regularized_self_energy_correlation.f90 rename to src/GW/regularized_self_energy_correlation.f90 index 1a56dcd..dcb6ffc 100644 --- a/src/MBPT/regularized_self_energy_correlation.f90 +++ b/src/GW/regularized_self_energy_correlation.f90 @@ -9,7 +9,12 @@ subroutine regularized_self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e, logical,intent(in) :: COHSEX double precision,intent(in) :: eta - integer,intent(in) :: nBas,nC,nO,nV,nR,nS + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) diff --git a/src/MBPT/regularized_self_energy_correlation_diag.f90 b/src/GW/regularized_self_energy_correlation_diag.f90 similarity index 93% rename from src/MBPT/regularized_self_energy_correlation_diag.f90 rename to src/GW/regularized_self_energy_correlation_diag.f90 index ec7bb5f..2856e84 100644 --- a/src/MBPT/regularized_self_energy_correlation_diag.f90 +++ b/src/GW/regularized_self_energy_correlation_diag.f90 @@ -23,7 +23,6 @@ subroutine regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR, integer :: i,a,p,q,jb double precision :: eps - double precision,external :: SigC_dcgw double precision :: kappa double precision :: fk @@ -37,9 +36,9 @@ subroutine regularized_self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR, SigC(:) = 0d0 -!---------------------------------------------! -! Parameters for regularized MP2 calculations ! -!---------------------------------------------! +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! kappa = 1.1d0 diff --git a/src/MBPT/renormalization_factor.f90 b/src/GW/renormalization_factor.f90 similarity index 63% rename from src/MBPT/renormalization_factor.f90 rename to src/GW/renormalization_factor.f90 index 10f2849..eb699bf 100644 --- a/src/MBPT/renormalization_factor.f90 +++ b/src/GW/renormalization_factor.f90 @@ -9,14 +9,19 @@ subroutine renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Z) logical,intent(in) :: COHSEX double precision,intent(in) :: eta - integer,intent(in) :: nBas,nC,nO,nV,nR,nS + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables - integer :: i,j,a,b,x,jb + integer :: p,i,a,jb double precision :: eps ! Output variables @@ -38,30 +43,22 @@ subroutine renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Z) ! Occupied part of the correlation self-energy - do x=nC+1,nBas-nR + do p=nC+1,nBas-nR do i=nC+1,nO - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(i) + Omega(jb) - Z(x) = Z(x) - 2d0*rho(x,i,jb)**2*(eps/(eps**2 + eta**2))**2 - end do + do jb=1,nS + eps = e(p) - e(i) + Omega(jb) + Z(p) = Z(p) - 2d0*rho(p,i,jb)**2*(eps/(eps**2 + eta**2))**2 end do end do end do ! Virtual part of the correlation self-energy - do x=nC+1,nBas-nR + do p=nC+1,nBas-nR do a=nO+1,nBas-nR - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(a) - Omega(jb) - Z(x) = Z(x) - 2d0*rho(x,a,jb)**2*(eps/(eps**2 + eta**2))**2 - end do + do jb=1,nS + eps = e(p) - e(a) - Omega(jb) + Z(p) = Z(p) - 2d0*rho(p,a,jb)**2*(eps/(eps**2 + eta**2))**2 end do end do end do diff --git a/src/MBPT/renormalization_factor_SOSEX.f90 b/src/GW/renormalization_factor_SOSEX.f90 similarity index 100% rename from src/MBPT/renormalization_factor_SOSEX.f90 rename to src/GW/renormalization_factor_SOSEX.f90 diff --git a/src/MBPT/self_energy_correlation.f90 b/src/GW/self_energy_correlation.f90 similarity index 91% rename from src/MBPT/self_energy_correlation.f90 rename to src/GW/self_energy_correlation.f90 index 369ee32..4d62b43 100644 --- a/src/MBPT/self_energy_correlation.f90 +++ b/src/GW/self_energy_correlation.f90 @@ -9,7 +9,12 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec logical,intent(in) :: COHSEX double precision,intent(in) :: eta - integer,intent(in) :: nBas,nC,nO,nV,nR,nS + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) diff --git a/src/MBPT/self_energy_correlation_SOSEX_diag.f90 b/src/GW/self_energy_correlation_SOSEX_diag.f90 similarity index 100% rename from src/MBPT/self_energy_correlation_SOSEX_diag.f90 rename to src/GW/self_energy_correlation_SOSEX_diag.f90 diff --git a/src/MBPT/self_energy_correlation_diag.f90 b/src/GW/self_energy_correlation_diag.f90 similarity index 98% rename from src/MBPT/self_energy_correlation_diag.f90 rename to src/GW/self_energy_correlation_diag.f90 index 59aab3d..9adc747 100644 --- a/src/MBPT/self_energy_correlation_diag.f90 +++ b/src/GW/self_energy_correlation_diag.f90 @@ -23,7 +23,6 @@ subroutine self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,r integer :: i,a,p,q,jb double precision :: eps - double precision,external :: SigC_dcgw ! Output variables diff --git a/src/MBPT/self_energy_exchange.f90 b/src/GW/self_energy_exchange.f90 similarity index 100% rename from src/MBPT/self_energy_exchange.f90 rename to src/GW/self_energy_exchange.f90 diff --git a/src/MBPT/self_energy_exchange_diag.f90 b/src/GW/self_energy_exchange_diag.f90 similarity index 100% rename from src/MBPT/self_energy_exchange_diag.f90 rename to src/GW/self_energy_exchange_diag.f90 diff --git a/src/MBPT/static_screening_WA.f90 b/src/GW/static_screening_WA.f90 similarity index 100% rename from src/MBPT/static_screening_WA.f90 rename to src/GW/static_screening_WA.f90 diff --git a/src/MBPT/static_screening_WB.f90 b/src/GW/static_screening_WB.f90 similarity index 100% rename from src/MBPT/static_screening_WB.f90 rename to src/GW/static_screening_WB.f90 diff --git a/src/MBPT/ufBSE.f90 b/src/GW/ufBSE.f90 similarity index 97% rename from src/MBPT/ufBSE.f90 rename to src/GW/ufBSE.f90 index 9ee38c6..426b4bc 100644 --- a/src/MBPT/ufBSE.f90 +++ b/src/GW/ufBSE.f90 @@ -1,4 +1,4 @@ -subroutine ufBSE(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW) +subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW) ! Unfold BSE@GW equations @@ -7,7 +7,6 @@ subroutine ufBSE(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW) ! Input variables - double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO diff --git a/src/MBPT/ufG0W0.f90 b/src/GW/ufG0W0.f90 similarity index 97% rename from src/MBPT/ufG0W0.f90 rename to src/GW/ufG0W0.f90 index 8211821..51ac629 100644 --- a/src/MBPT/ufG0W0.f90 +++ b/src/GW/ufG0W0.f90 @@ -1,4 +1,4 @@ -subroutine ufG0W0(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine ufG0W0(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Unfold G0W0 equations @@ -7,7 +7,6 @@ subroutine ufG0W0(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Input variables - double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO diff --git a/src/MBPT/ufGW.f90 b/src/GW/ufGW.f90 similarity index 97% rename from src/MBPT/ufGW.f90 rename to src/GW/ufGW.f90 index f55d571..d64807e 100644 --- a/src/MBPT/ufGW.f90 +++ b/src/GW/ufGW.f90 @@ -1,4 +1,4 @@ -subroutine ufGW(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine ufGW(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Unfold GW equations @@ -7,7 +7,6 @@ subroutine ufGW(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Input variables - double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO diff --git a/src/MBPT/unrestricted_Bethe_Salpeter.f90 b/src/GW/unrestricted_Bethe_Salpeter.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter.f90 rename to src/GW/unrestricted_Bethe_Salpeter.f90 diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/GW/unrestricted_Bethe_Salpeter_A_matrix.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter_A_matrix.f90 rename to src/GW/unrestricted_Bethe_Salpeter_A_matrix.f90 diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_A_matrix_dynamic.f90 b/src/GW/unrestricted_Bethe_Salpeter_A_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter_A_matrix_dynamic.f90 rename to src/GW/unrestricted_Bethe_Salpeter_A_matrix_dynamic.f90 diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/GW/unrestricted_Bethe_Salpeter_B_matrix.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter_B_matrix.f90 rename to src/GW/unrestricted_Bethe_Salpeter_B_matrix.f90 diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_ZA_matrix_dynamic.f90 b/src/GW/unrestricted_Bethe_Salpeter_ZA_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter_ZA_matrix_dynamic.f90 rename to src/GW/unrestricted_Bethe_Salpeter_ZA_matrix_dynamic.f90 diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 b/src/GW/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 similarity index 100% rename from src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 rename to src/GW/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 diff --git a/src/MBPT/unrestricted_QP_graph.f90 b/src/GW/unrestricted_QP_graph.f90 similarity index 100% rename from src/MBPT/unrestricted_QP_graph.f90 rename to src/GW/unrestricted_QP_graph.f90 diff --git a/src/MBPT/unrestricted_excitation_density.f90 b/src/GW/unrestricted_excitation_density.f90 similarity index 100% rename from src/MBPT/unrestricted_excitation_density.f90 rename to src/GW/unrestricted_excitation_density.f90 diff --git a/src/GW/unrestricted_regularized_renormalization_factor.f90 b/src/GW/unrestricted_regularized_renormalization_factor.f90 new file mode 100644 index 0000000..34a8a90 --- /dev/null +++ b/src/GW/unrestricted_regularized_renormalization_factor.f90 @@ -0,0 +1,111 @@ +subroutine unrestricted_regularized_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,Z) + +! Compute the renormalization factor in the unrestricted formalism + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSt + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + integer :: i,a,p,jb + double precision :: eps + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: Z(nBas,nspin) + +! Initialize + + Z(:,:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!--------------! +! Spin-up part ! +!--------------! + + ! Occupied part of the renormalization factor + + do p=nC(1)+1,nBas-nR(1) + do i=nC(1)+1,nO(1) + do jb=1,nSt + eps = e(p,1) - e(i,1) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p,1) = Z(p,1) + rho(p,i,jb,1)**2*dfk + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(p,1) - e(a,1) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p,1) = Z(p,1) + rho(p,a,jb,1)**2*dfk + end do + end do + end do + +!----------------! +! Spin-down part ! +!----------------! + + ! Occupied part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do i=nC(2)+1,nO(2) + do jb=1,nSt + eps = e(p,2) - e(i,2) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p,2) = Z(p,2) + rho(p,i,jb,2)**2*dfk + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(p,2) - e(a,2) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + Z(p,2) = Z(p,2) + rho(p,a,jb,2)**2*dfk + end do + end do + end do + +! Final rescaling + + Z(:,:) = 1d0/(1d0 + Z(:,:)) + +end subroutine unrestricted_regularized_renormalization_factor diff --git a/src/GW/unrestricted_regularized_self_energy_correlation.f90 b/src/GW/unrestricted_regularized_self_energy_correlation.f90 new file mode 100644 index 0000000..9553e84 --- /dev/null +++ b/src/GW/unrestricted_regularized_self_energy_correlation.f90 @@ -0,0 +1,133 @@ +subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC,EcGM) + +! Compute diagonal of the correlation part of the self-energy + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSt + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + integer :: i,a,p,q,jb + double precision :: eps + + double precision :: kappa + double precision :: fk + +! Output variables + + double precision,intent(out) :: SigC(nBas,nBas,nspin) + double precision :: EcGM(nspin) + +! Initialize + + SigC(:,:,:) = 0d0 + EcGM(:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!--------------! +! Spin-up part ! +!--------------! + + ! Occupied part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do q=nC(1)+1,nBas-nR(1) + do i=nC(1)+1,nO(1) + do jb=1,nSt + eps = e(p,1) - e(i,1) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,q,1) = SigC(p,q,1) + rho(p,i,jb,1)*rho(q,i,jb,1)*eps/(eps**2 + eta**2) + end do + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do q=nC(1)+1,nBas-nR(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(p,1) - e(a,1) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,q,1) = SigC(p,q,1) + rho(p,a,jb,1)*rho(q,a,jb,1)*eps/(eps**2 + eta**2) + end do + end do + end do + end do + + ! GM correlation energy + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(a,1) - e(i,1) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + EcGM(1) = EcGM(1) - rho(a,i,jb,1)**2*eps/(eps**2 + eta**2) + end do + end do + end do + +!----------------! +! Spin-down part ! +!----------------! + + ! Occupied part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do q=nC(2)+1,nBas-nR(2) + do i=nC(2)+1,nO(2) + do jb=1,nSt + eps = e(p,2) - e(i,2) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,q,2) = SigC(p,q,2) + rho(p,i,jb,2)*rho(q,i,jb,2)*eps/(eps**2 + eta**2) + end do + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do q=nC(2)+1,nBas-nR(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(p,2) - e(a,2) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,q,2) = SigC(p,q,2) + rho(p,a,jb,2)*rho(q,a,jb,2)*eps/(eps**2 + eta**2) + end do + end do + end do + end do + + ! GM correlation energy + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(a,2) - e(i,2) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + EcGM(2) = EcGM(2) - rho(a,i,jb,2)**2*eps/(eps**2 + eta**2) + end do + end do + end do + +end subroutine unrestricted_self_energy_correlation diff --git a/src/GW/unrestricted_regularized_self_energy_correlation_diag.f90 b/src/GW/unrestricted_regularized_self_energy_correlation_diag.f90 new file mode 100644 index 0000000..02de065 --- /dev/null +++ b/src/GW/unrestricted_regularized_self_energy_correlation_diag.f90 @@ -0,0 +1,126 @@ +subroutine unrestricted_regularized_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC,EcGM) + +! Compute diagonal of the correlation part of the self-energy + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSt + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + integer :: i,a,p,q,jb + double precision :: eps + + double precision :: kappa + double precision :: fk + +! Output variables + + double precision,intent(out) :: SigC(nBas,nspin) + double precision :: EcGM(nspin) + +! Initialize + + SigC(:,:) = 0d0 + EcGM(:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!--------------! +! Spin-up part ! +!--------------! + + ! Occupied part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do i=nC(1)+1,nO(1) + do jb=1,nSt + eps = e(p,1) - e(i,1) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,1) = SigC(p,1) + rho(p,i,jb,1)**2*fk + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(p,1) - e(a,1) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,1) = SigC(p,1) + rho(p,a,jb,1)**2*fk + end do + end do + end do + + ! GM correlation energy + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(a,1) - e(i,1) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + EcGM(1) = EcGM(1) - rho(a,i,jb,1)**2*fk + end do + end do + end do + +!----------------! +! Spin-down part ! +!----------------! + + ! Occupied part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do i=nC(2)+1,nO(2) + do jb=1,nSt + eps = e(p,2) - e(i,2) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,2) = SigC(p,2) + rho(p,i,jb,2)**2*fk + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(p,2) - e(a,2) - Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + SigC(p,2) = SigC(p,2) + rho(p,a,jb,2)**2*fk + end do + end do + end do + + ! GM correlation energy + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(a,2) - e(i,2) + Omega(jb) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + EcGM(2) = EcGM(2) - rho(a,i,jb,2)**2*fk + end do + end do + end do + + +end subroutine unrestricted_regularized_self_energy_correlation_diag diff --git a/src/MBPT/unrestricted_renormalization_factor.f90 b/src/GW/unrestricted_renormalization_factor.f90 similarity index 97% rename from src/MBPT/unrestricted_renormalization_factor.f90 rename to src/GW/unrestricted_renormalization_factor.f90 index f175d93..147b483 100644 --- a/src/MBPT/unrestricted_renormalization_factor.f90 +++ b/src/GW/unrestricted_renormalization_factor.f90 @@ -20,7 +20,7 @@ subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSt,e,Omega, ! Local variables - integer :: i,j,a,b,p,q,jb + integer :: i,a,p,jb double precision :: eps ! Output variables diff --git a/src/MBPT/unrestricted_self_energy_correlation.f90 b/src/GW/unrestricted_self_energy_correlation.f90 similarity index 98% rename from src/MBPT/unrestricted_self_energy_correlation.f90 rename to src/GW/unrestricted_self_energy_correlation.f90 index d6c5f98..de1ae28 100644 --- a/src/MBPT/unrestricted_self_energy_correlation.f90 +++ b/src/GW/unrestricted_self_energy_correlation.f90 @@ -20,7 +20,7 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega ! Local variables - integer :: i,j,a,b,p,q,jb + integer :: i,a,p,q,jb double precision :: eps ! Output variables diff --git a/src/MBPT/unrestricted_self_energy_correlation_diag.f90 b/src/GW/unrestricted_self_energy_correlation_diag.f90 similarity index 98% rename from src/MBPT/unrestricted_self_energy_correlation_diag.f90 rename to src/GW/unrestricted_self_energy_correlation_diag.f90 index d683380..8290d9d 100644 --- a/src/MBPT/unrestricted_self_energy_correlation_diag.f90 +++ b/src/GW/unrestricted_self_energy_correlation_diag.f90 @@ -20,7 +20,7 @@ subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSt,e, ! Local variables - integer :: i,j,a,b,p,q,jb + integer :: i,a,p,q,jb double precision :: eps ! Output variables diff --git a/src/MBPT/Makefile b/src/MBPT/Makefile deleted file mode 100644 index 6ca514e..0000000 --- a/src/MBPT/Makefile +++ /dev/null @@ -1,10 +0,0 @@ -default: - ninja - make -C .. - -clean: - ninja -t clean - -debug: - ninja -t clean - make -C .. debug diff --git a/src/MBPT/Sangalli_A_matrix_dynamic.f90.x b/src/MBPT/Sangalli_A_matrix_dynamic.f90.x deleted file mode 100644 index 75f8ffd..0000000 --- a/src/MBPT/Sangalli_A_matrix_dynamic.f90.x +++ /dev/null @@ -1,78 +0,0 @@ -subroutine Sangalli_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho,A_dyn) - -! Compute the dynamic part of the Bethe-Salpeter equation matrices - - implicit none - include 'parameters.h' - -! Input variables - - integer,intent(in) :: nBas,nC,nO,nV,nR,nS - double precision,intent(in) :: eta - double precision,intent(in) :: lambda - double precision,intent(in) :: eGW(nBas) - double precision,intent(in) :: OmRPA(nS) - double precision,intent(in) :: OmBSE - double precision,intent(in) :: rho(nBas,nBas,nS) - -! Local variables - - integer :: maxS - double precision :: chi - double precision :: eps - integer :: i,j,a,b,ia,jb,kc - -! Output variables - - double precision,intent(out) :: A_dyn(nS,nS) - -! Initialization - - A_dyn(:,:) = 0d0 - -! Number of poles taken into account - - maxS = nS - -! Build dynamic A matrix - - do - - - (ERI(i,k,j,c)*KroneckerDelta(a,b) + ERI(k,a,c,b)*KroneckerDelta(i,j))*(X) - - 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 - - chi = 0d0 - do kc=1,maxS - - chi = chi + rho(i,j,kc)*rho(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) - - enddo - - A_dyn(ia,jb) = A_dyn(ia,jb) - 4d0*lambda*chi - - chi = 0d0 - do kc=1,maxS - do ld=1,maxS - - eps = OmBSE - (OmRPA(kc) + OmRPA(ld)) - chi = chi + cRPA(ia,kc,ld)*cRPA(jb,kc,ld)*eps/(eps**2 + (2d0*eta)**2) - - enddo - - A_dyn(ia,jb) = A_dyn(ia,jb) - 2d0*lambda*chi - - enddo - enddo - enddo - enddo - -end subroutine Sangalli_A_matrix_dynamic diff --git a/src/MBPT/excitation_density_RI.f90 b/src/MBPT/excitation_density_RI.f90 deleted file mode 100644 index 967f0bb..0000000 --- a/src/MBPT/excitation_density_RI.f90 +++ /dev/null @@ -1,65 +0,0 @@ -subroutine excitation_density_RI(nBas,nC,nO,nR,nS,c,G,XpY,rho) - -! Compute excitation densities in the RI approximation - - implicit none - -! Input variables - - integer,intent(in) :: nBas,nC,nO,nR,nS - double precision,intent(in) :: c(nBas,nBas),G(nBas,nBas,nBas,nBas),XpY(nS,nS) - -! Local variables - - double precision,allocatable :: scr(:,:,:) - integer :: mu,nu,la,si,ia,jb,x,y,j,b - -! Output variables - - double precision,intent(out) :: rho(nBas,nBas,nS) - -! Memory allocation - allocate(scr(nBas,nBas,nS)) - - rho(:,:,:) = 0d0 - do nu=1,nBas - do si=1,nBas - do ia=1,nS - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - rho(nu,si,ia) = rho(nu,si,ia) + c(nu,j)*XpY(ia,jb)*c(si,b) - enddo - enddo - enddo - enddo - enddo - - scr(:,:,:) = 0d0 - do mu=1,nBas - do la=1,nBas - do ia=1,nS - do nu=1,nBas - do si=1,nBas - scr(mu,la,ia) = scr(mu,la,ia) + G(mu,nu,la,si)*rho(nu,si,ia) - enddo - enddo - enddo - enddo - enddo - - rho(:,:,:) = 0d0 - do ia=1,nS - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR - do mu=1,nBas - do la=1,nBas - rho(x,y,ia) = rho(x,y,ia) + c(mu,x)*scr(mu,la,ia)*c(la,y) - enddo - enddo - enddo - enddo - enddo - -end subroutine excitation_density_RI diff --git a/src/MBPT/excitation_density_SOSEX_RI.f90 b/src/MBPT/excitation_density_SOSEX_RI.f90 deleted file mode 100644 index 8f3f6b5..0000000 --- a/src/MBPT/excitation_density_SOSEX_RI.f90 +++ /dev/null @@ -1,65 +0,0 @@ -subroutine excitation_density_SOSEX_RI(nBas,nC,nO,nR,nS,c,G,XpY,rho) - -! Compute excitation densities - - implicit none - -! Input variables - - integer,intent(in) :: nBas,nC,nO,nR,nS - double precision,intent(in) :: c(nBas,nBas),G(nBas,nBas,nBas,nBas),XpY(nS,nS) - -! Local variables - - double precision,allocatable :: scr(:,:,:) - integer :: mu,nu,la,si,ia,jb,x,y,j,b - -! Output variables - - double precision,intent(out) :: rho(nBas,nBas,nS) - -! Memory allocation - allocate(scr(nBas,nBas,nS)) - - rho(:,:,:) = 0d0 - do nu=1,nBas - do si=1,nBas - do ia=1,nS - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - rho(nu,si,ia) = rho(nu,si,ia) + c(nu,j)*XpY(ia,jb)*c(si,b) - enddo - enddo - enddo - enddo - enddo - - scr(:,:,:) = 0d0 - do mu=1,nBas - do la=1,nBas - do ia=1,nS - do nu=1,nBas - do si=1,nBas - scr(mu,la,ia) = scr(mu,la,ia) + G(mu,nu,la,si)*rho(nu,si,ia) - enddo - enddo - enddo - enddo - enddo - - rho(:,:,:) = 0d0 - do ia=1,nS - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR - do mu=1,nBas - do la=1,nBas - rho(x,y,ia) = rho(x,y,ia) + c(mu,x)*scr(mu,la,ia)*c(la,y) - enddo - enddo - enddo - enddo - enddo - -end subroutine excitation_density_SOSEX_RI diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index c6b0444..4adadbd 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -124,14 +124,19 @@ program QuAcK integer :: maxSCF_GF,n_diis_GF,renormGF double precision :: thresh_GF - logical :: DIIS_GF,linGF + logical :: DIIS_GF,linGF,regGF double precision :: eta_GF integer :: maxSCF_GW,n_diis_GW double precision :: thresh_GW - logical :: DIIS_GW,COHSEX,SOSEX,TDA_W,G0W,GW0,linGW + logical :: DIIS_GW,COHSEX,SOSEX,TDA_W,G0W,GW0,linGW,regGW double precision :: eta_GW + integer :: maxSCF_GT,n_diis_GT + double precision :: thresh_GT + logical :: DIIS_GT,TDA_T,linGT,regGT + double precision :: eta_GT + logical :: BSE,dBSE,dTDA,evDyn integer :: nMC,nEq,nWalk,nPrint,iSeed @@ -176,9 +181,10 @@ program QuAcK call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, & maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & TDA,singlet,triplet,spin_conserved,spin_flip, & - maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, & - maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW, & + maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF,regGF, & + maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW,regGW, & COHSEX,SOSEX,TDA_W,G0W,GW0, & + maxSCF_GT,thresh_GT,DIIS_GT,n_diis_GT,linGT,eta_GT,regGT,TDA_T, & doACFDT,exchange_kernel,doXBS, & BSE,dBSE,dTDA,evDyn, & nMC,nEq,nWalk,dt,nPrint,iSeed,doDrift) @@ -868,13 +874,14 @@ program QuAcK if(unrestricted) then - call UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb,eHF) + call UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linGF,eta_GF,regGF, & + nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & + dipole_int_aa,dipole_int_bb,eHF) else - call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF, & - eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF) + call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF,eta_GF,regGF, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF) end if @@ -897,13 +904,13 @@ program QuAcK if(unrestricted) then call evUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & - eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & + eta_GF,regGF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & dipole_int_aa,dipole_int_bb,cHF,eHF) else call evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF_GF,thresh_GF,n_diis_GF, & - singlet,triplet,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & + singlet,triplet,linGF,eta_GF,regGF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & ERI_MO,dipole_int_MO,eHF) end if @@ -926,13 +933,13 @@ program QuAcK if(unrestricted) then - call qsUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GF, & + call qsUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GF,regGF, & nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, & ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF) else - call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,nNuc,ZNuc,rNuc,ENuc, & + call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,regGF,nNuc,ZNuc,rNuc,ENuc, & nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) end if @@ -989,7 +996,7 @@ program QuAcK if(unrestricted) then call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & - linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & + linGW,eta_GW,regGW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eG0W0) else @@ -997,10 +1004,10 @@ program QuAcK if(SOSEX) then call G0W0_SOSEX(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) + eta_GW,regGW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) + linGW,eta_GW,regGW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) end if end if @@ -1023,14 +1030,14 @@ program QuAcK if(unrestricted) then call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,regGW,nBas,nC,nO,nV,nR,nS,ENuc, & EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb, & PHF,cHF,eHF,Vxc,eG0W0) else call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX, & - BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & + BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW,regGW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) end if call cpu_time(end_evGW) @@ -1052,14 +1059,14 @@ program QuAcK if(unrestricted) then call qsUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,regGW,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO, & nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_AO, & dipole_int_aa,dipole_int_bb,PHF,cHF,eHF) else call qsGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX, & - BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW,nNuc,ZNuc,rNuc,ENuc, & + BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW,regGW,nNuc,ZNuc,rNuc,ENuc, & nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) end if @@ -1079,7 +1086,7 @@ program QuAcK if(doufG0W0) then call cpu_time(start_ufGW) - call ufG0W0(eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call ufG0W0(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_ufGW) t_ufGW = end_ufGW - start_ufGW @@ -1095,14 +1102,14 @@ program QuAcK if(doufGW) then call cpu_time(start_ufGW) - call ufGW(eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call ufGW(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_ufGW) t_ufGW = end_ufGW - start_ufGW write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ufGW = ',t_ufGW,' seconds' write(*,*) -! call ufBSE(eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0W0) +! call ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0W0) end if @@ -1115,8 +1122,8 @@ program QuAcK if(doG0T0) then call cpu_time(start_G0T0) - call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & + call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + linGT,eta_GT,regGT,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & PHF,cHF,eHF,Vxc,eG0T0) call cpu_time(end_G0T0) @@ -1133,8 +1140,8 @@ program QuAcK if(doevGT) then call cpu_time(start_evGT) - call evGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & + call evGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & + BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & PHF,cHF,eHF,Vxc,eG0T0) call cpu_time(end_evGT) @@ -1153,9 +1160,10 @@ program QuAcK call cpu_time(start_qsGT) - call qsGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW,nNuc,ZNuc,rNuc,ENuc, & - nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + call qsGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & + BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & + nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, & + ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) call cpu_time(end_qsGT) diff --git a/src/QuAcK/read_options.f90 b/src/QuAcK/read_options.f90 index 2d7aa4f..382ec95 100644 --- a/src/QuAcK/read_options.f90 +++ b/src/QuAcK/read_options.f90 @@ -1,9 +1,10 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, & maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & TDA,singlet,triplet,spin_conserved,spin_flip, & - maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, & - maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW, & + maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF,regGF, & + maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW,regGW, & COHSEX,SOSEX,TDA_W,G0W,GW0, & + maxSCF_GT,thresh_GT,DIIS_GT,n_diis_GT,linGT,eta_GT,regGT,TDA_T, & doACFDT,exchange_kernel,doXBS, & BSE,dBSE,dTDA,evDyn, & nMC,nEq,nWalk,dt,nPrint,iSeed,doDrift) @@ -41,6 +42,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t logical,intent(out) :: linGF integer,intent(out) :: renormGF double precision,intent(out) :: eta_GF + logical,intent(out) :: regGF integer,intent(out) :: maxSCF_GW double precision,intent(out) :: thresh_GW @@ -53,6 +55,16 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t logical,intent(out) :: GW0 logical,intent(out) :: linGW double precision,intent(out) :: eta_GW + logical,intent(out) :: regGW + + integer,intent(out) :: maxSCF_GT + double precision,intent(out) :: thresh_GT + logical,intent(out) :: DIIS_GT + integer,intent(out) :: n_diis_GT + logical,intent(out) :: TDA_T + logical,intent(out) :: linGT + double precision,intent(out) :: eta_GT + logical,intent(out) :: regGT logical,intent(out) :: doACFDT logical,intent(out) :: exchange_kernel @@ -73,7 +85,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t ! Local variables - character(len=1) :: answer1,answer2,answer3,answer4,answer5,answer6,answer7 + character(len=1) :: answer1,answer2,answer3,answer4,answer5,answer6,answer7,answer8 ! Open file with method specification @@ -135,7 +147,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t if(answer4 == 'T') spin_conserved = .true. if(answer5 == 'T') spin_flip = .true. -! Read Green function options +! Read GF options maxSCF_GF = 64 thresh_GF = 1d-5 @@ -144,12 +156,14 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t linGF = .false. eta_GF = 0d0 renormGF = 0 + regGF = .false. read(1,*) - read(1,*) maxSCF_GF,thresh_GF,answer1,n_diis_GF,answer2,eta_GF,renormGF + read(1,*) maxSCF_GF,thresh_GF,answer1,n_diis_GF,answer2,eta_GF,renormGF,answer3 if(answer1 == 'T') DIIS_GF = .true. if(answer2 == 'T') linGF = .true. + if(answer3 == 'T') regGF = .true. if(.not.DIIS_GF) n_diis_GF = 1 ! Read GW options @@ -160,6 +174,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t n_diis_GW = 5 linGW = .false. eta_GW = 0d0 + regGW = .false. COHSEX = .false. SOSEX = .false. TDA_W = .false. @@ -168,7 +183,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t read(1,*) read(1,*) maxSCF_GW,thresh_GW,answer1,n_diis_GW,answer2,eta_GW, & - answer3,answer4,answer5,answer6,answer7 + answer3,answer4,answer5,answer6,answer7,answer8 if(answer1 == 'T') DIIS_GW = .true. if(answer2 == 'T') linGW = .true. @@ -177,8 +192,30 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t if(answer5 == 'T') TDA_W = .true. if(answer6 == 'T') G0W = .true. if(answer7 == 'T') GW0 = .true. + if(answer8 == 'T') regGW = .true. if(.not.DIIS_GW) n_diis_GW = 1 +! Read GF options + + maxSCF_GF = 64 + thresh_GF = 1d-5 + DIIS_GF = .false. + n_diis_GF = 5 + linGF = .false. + eta_GF = 0d0 + regGF = .false. + TDA_T = .false. + + read(1,*) + read(1,*) maxSCF_GT,thresh_GT,answer1,n_diis_GT,answer2,eta_GT, & + answer3,answer4 + + if(answer1 == 'T') DIIS_GT = .true. + if(answer2 == 'T') linGT = .true. + if(answer3 == 'T') TDA_T = .true. + if(answer4 == 'T') regGT = .true. + if(.not.DIIS_GT) n_diis_GT = 1 + ! Options for adiabatic connection doACFDT = .false. From 02f7a03385f99ed7b2f3816b5e2d493783f200fb Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 17 Dec 2021 13:36:26 +0100 Subject: [PATCH 02/12] regularized GF2 --- include/parameters.h | 1 - input/methods | 2 +- src/GF/G0F2.f90 | 10 +- src/GF/UG0F2.f90 | 10 +- src/GF/evGF2.f90 | 10 +- src/GF/evUGF2.f90 | 10 +- src/GF/qsGF2.f90 | 10 +- src/GF/qsUGF2.f90 | 10 +- src/GF/regularized_self_energy_GF2.f90 | 92 +++++++ src/GF/regularized_self_energy_GF2_diag.f90 | 88 +++++++ ...restricted_regularized_self_energy_GF2.f90 | 236 ++++++++++++++++++ ...icted_regularized_self_energy_GF2_diag.f90 | 231 +++++++++++++++++ 12 files changed, 702 insertions(+), 8 deletions(-) create mode 100644 src/GF/regularized_self_energy_GF2.f90 create mode 100644 src/GF/regularized_self_energy_GF2_diag.f90 create mode 100644 src/GF/unrestricted_regularized_self_energy_GF2.f90 create mode 100644 src/GF/unrestricted_regularized_self_energy_GF2_diag.f90 diff --git a/include/parameters.h b/include/parameters.h index 2644d6a..dbf9364 100644 --- a/include/parameters.h +++ b/include/parameters.h @@ -20,4 +20,3 @@ double precision,parameter :: CxLDA = - (3d0/4d0)*(3d0/pi)**(1d0/3d0) double precision,parameter :: CxLSDA = - (3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - diff --git a/input/methods b/input/methods index df2ad59..196855c 100644 --- a/input/methods +++ b/input/methods @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - F T F F F + T F F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/src/GF/G0F2.f90 b/src/GF/G0F2.f90 index 2e98066..391ed99 100644 --- a/src/GF/G0F2.f90 +++ b/src/GF/G0F2.f90 @@ -59,7 +59,15 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,regularize ! Frequency-dependent second-order contribution - call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) + if(regularize) then + + call regularized_self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) + + else + + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) + + end if if(linearize) then diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 index be7d4c1..8c81da8 100644 --- a/src/GF/UG0F2.f90 +++ b/src/GF/UG0F2.f90 @@ -80,7 +80,15 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta, ! Compute self-energy ! !---------------------! - call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eHF,SigC,Z) + if(regularize) then + + call unrestricted_regularized_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eHF,SigC,Z) + + else + + call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eHF,SigC,Z) + + end if !-----------------------------------! ! Solve the quasi-particle equation ! diff --git a/src/GF/evGF2.f90 b/src/GF/evGF2.f90 index f55ae32..9466f53 100644 --- a/src/GF/evGF2.f90 +++ b/src/GF/evGF2.f90 @@ -79,7 +79,15 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Frequency-dependent second-order contribution - call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + if(regularize) then + + call regularized_self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + + else + + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + + end if if(linearize) then diff --git a/src/GF/evUGF2.f90 b/src/GF/evUGF2.f90 index 07749af..3d7c844 100644 --- a/src/GF/evUGF2.f90 +++ b/src/GF/evUGF2.f90 @@ -113,7 +113,15 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Compute self-energy and renormalization factor ! !------------------------------------------------! - call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + if(regularize) then + + call unrestricted_regularized_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + else + + call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + end if !-----------------------------------! ! Solve the quasi-particle equation ! diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index 3019091..6a5a395 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -145,7 +145,15 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Compute self-energy and renormalization factor - call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) + if(regularize) then + + call regularized_self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) + + else + + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) + + end if ! Make correlation self-energy Hermitian and transform it back to AO basis diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 71d3c97..e94a344 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -179,7 +179,15 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Compute self-energy and renormalization factor ! !------------------------------------------------! - call unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + if(regularize) then + + call unrestricted_regularized_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + else + + call unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + end if ! Make correlation self-energy Hermitian and transform it back to AO basis diff --git a/src/GF/regularized_self_energy_GF2.f90 b/src/GF/regularized_self_energy_GF2.f90 new file mode 100644 index 0000000..e4b0475 --- /dev/null +++ b/src/GF/regularized_self_energy_GF2.f90 @@ -0,0 +1,92 @@ +subroutine regularized_self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + +! Compute GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGF2(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: i,j,a,b + integer :: p,q + double precision :: eps + double precision :: num + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: SigC(nBas,nBas) + double precision,intent(out) :: Z(nBas) + +! Initialize + + SigC(:,:) = 0d0 + Z(:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!----------------------------------------------------! +! Compute GF2 self-energy and renormalization factor ! +!----------------------------------------------------! + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR + + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q) = SigC(p,q) + num*fk + if(p == q) Z(p) = Z(p) - num*dfk + + end do + end do + end do + end do + end do + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q) = SigC(p,q) + num*fk + if(p == q) Z(p) = Z(p) - num*dfk + + end do + end do + end do + end do + end do + + Z(:) = 1d0/(1d0 - Z(:)) + +end subroutine regularized_self_energy_GF2 diff --git a/src/GF/regularized_self_energy_GF2_diag.f90 b/src/GF/regularized_self_energy_GF2_diag.f90 new file mode 100644 index 0000000..80693e8 --- /dev/null +++ b/src/GF/regularized_self_energy_GF2_diag.f90 @@ -0,0 +1,88 @@ +subroutine regularized_self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + +! Compute diagonal part of the GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGF2(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: i,j,a,b + integer :: p + double precision :: eps + double precision :: num + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: SigC(nBas) + double precision,intent(out) :: Z(nBas) + +! Initialize + + SigC(:) = 0d0 + Z(:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!----------------------------------------------------! +! Compute GF2 self-energy and renormalization factor ! +!----------------------------------------------------! + + do p=nC+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR + + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p) = SigC(p) + num*fk + Z(p) = Z(p) - num*dfk + + end do + end do + end do + end do + + do p=nC+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p) = SigC(p) + num*fk + Z(p) = Z(p) - num*dfk + + end do + end do + end do + end do + + Z(:) = 1d0/(1d0 - Z(:)) + +end subroutine regularized_self_energy_GF2_diag diff --git a/src/GF/unrestricted_regularized_self_energy_GF2.f90 b/src/GF/unrestricted_regularized_self_energy_GF2.f90 new file mode 100644 index 0000000..dcae0e4 --- /dev/null +++ b/src/GF/unrestricted_regularized_self_energy_GF2.f90 @@ -0,0 +1,236 @@ +subroutine unrestricted_regularized_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z) + +! Perform unrestricted GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + double precision,intent(in) :: eta + double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + +! Local variables + + integer :: p,q + integer :: i,j,a,b + double precision :: eps,num + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: SigC(nBas,nBas,nspin) + double precision,intent(out) :: Z(nBas,nspin) + +!---------------------! +! Compute self-energy | +!---------------------! + + SigC(:,:,:) = 0d0 + Z(:,:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + + !----------------! + ! Spin-up sector + !----------------! + + do p=nC(1)+1,nBas-nR(1) + do q=nC(1)+1,nBas-nR(1) + + ! Addition part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1) + num = ERI_aa(i,q,a,b)*ERI_aa(a,b,i,p) & + - ERI_aa(i,q,a,b)*ERI_aa(a,b,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,1) = SigC(p,q,1) + num*fk + if(p == q) Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1) + num = ERI_ab(q,i,b,a)*ERI_ab(b,a,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,1) = SigC(p,q,1) + num*fk + if(p == q) Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Removal part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1) + num = ERI_aa(a,q,i,j)*ERI_aa(i,j,a,p) & + - ERI_aa(a,q,i,j)*ERI_aa(i,j,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,1) = SigC(p,q,1) + num*fk + if(p == q) Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1) + num = ERI_ab(q,a,j,i)*ERI_ab(j,i,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,1) = SigC(p,q,1) + num*fk + if(p == q) Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + enddo + enddo + + !------------------! + ! Spin-down sector ! + !------------------! + + do p=nC(2)+1,nBas-nR(2) + do q=nC(2)+1,nBas-nR(2) + + ! Addition part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2) + num = ERI_bb(i,q,a,b)*ERI_bb(a,b,i,p) & + - ERI_bb(i,q,a,b)*ERI_bb(a,b,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2) + num = ERI_ab(i,q,a,b)*ERI_ab(a,b,i,p) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,2) = SigC(p,q,2) + num*fk + if(p == q) Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + ! Removal part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2) + num = ERI_bb(a,q,i,j)*ERI_bb(i,j,a,p) & + - ERI_bb(a,q,i,j)*ERI_bb(i,j,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,2) = SigC(p,q,2) + num*fk + if(p == q) Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2) + num = ERI_ab(a,q,i,j)*ERI_ab(i,j,a,p) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,q,2) = SigC(p,q,2) + num*fk + if(p == q) Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + enddo + enddo + + Z(:,:) = 1d0/(1d0 - Z(:,:)) + +end subroutine unrestricted_regularized_self_energy_GF2 diff --git a/src/GF/unrestricted_regularized_self_energy_GF2_diag.f90 b/src/GF/unrestricted_regularized_self_energy_GF2_diag.f90 new file mode 100644 index 0000000..6818d0e --- /dev/null +++ b/src/GF/unrestricted_regularized_self_energy_GF2_diag.f90 @@ -0,0 +1,231 @@ +subroutine unrestricted_regularized_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z) + +! Perform unrestricted GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + double precision,intent(in) :: eta + double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + +! Local variables + + integer :: p + integer :: i,j,a,b + double precision :: eps,num + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: SigC(nBas,nspin) + double precision,intent(out) :: Z(nBas,nspin) + +!---------------------! +! Compute self-energy | +!---------------------! + + SigC(:,:) = 0d0 + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + + !----------------! + ! Spin-up sector + !----------------! + + do p=nC(1)+1,nBas-nR(1) + + ! Addition part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1) + num = ERI_aa(i,p,a,b)*ERI_aa(a,b,i,p) & + - ERI_aa(i,p,a,b)*ERI_aa(a,b,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,1) = SigC(p,1) + num*fk + Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1) + num = ERI_ab(p,i,b,a)*ERI_ab(b,a,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,1) = SigC(p,1) + num*fk + Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Removal part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1) + num = ERI_aa(a,p,i,j)*ERI_aa(i,j,a,p) & + - ERI_aa(a,p,i,j)*ERI_aa(i,j,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,1) = SigC(p,1) + num*fk + Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1) + num = ERI_ab(p,a,j,i)*ERI_ab(j,i,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,1) = SigC(p,1) + num*fk + Z(p,1) = Z(p,1) - num*dfk + + enddo + enddo + enddo + + enddo + + !------------------! + ! Spin-down sector ! + !------------------! + + do p=nC(2)+1,nBas-nR(2) + + ! Addition part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2) + num = ERI_bb(i,p,a,b)*ERI_bb(a,b,i,p) & + - ERI_bb(i,p,a,b)*ERI_bb(a,b,p,i) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,2) = SigC(p,2) + num*fk + Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2) + num = ERI_ab(i,p,a,b)*ERI_ab(a,b,i,p) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,2) = SigC(p,2) + num*fk + Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + ! Removal part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2) + num = ERI_bb(a,p,i,j)*ERI_bb(i,j,a,p) & + - ERI_bb(a,p,i,j)*ERI_bb(i,j,p,a) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,2) = SigC(p,2) + num*fk + Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2) + num = ERI_ab(a,p,i,j)*ERI_ab(i,j,a,p) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + SigC(p,2) = SigC(p,2) + num*fk + Z(p,2) = Z(p,2) - num*dfk + + enddo + enddo + enddo + + enddo + + Z(:,:) = 1d0/(1d0 - Z(:,:)) + +end subroutine unrestricted_regularized_self_energy_GF2_diag From cdf714860644650e3a619cf0743c3b10a5ea4010 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 17 Dec 2021 13:51:12 +0100 Subject: [PATCH 03/12] renormalized GT --- ...larized_renormalization_factor_Tmatrix.f90 | 74 +++++++++++++++++ src/GT/regularized_self_energy_Tmatrix.f90 | 80 +++++++++++++++++++ .../regularized_self_energy_Tmatrix_diag.f90 | 76 ++++++++++++++++++ src/GT/renormalization_factor_Tmatrix.f90 | 2 +- src/GT/self_energy_Tmatrix.f90 | 2 +- src/GT/self_energy_Tmatrix_diag.f90 | 2 +- 6 files changed, 233 insertions(+), 3 deletions(-) create mode 100644 src/GT/regularized_renormalization_factor_Tmatrix.f90 create mode 100644 src/GT/regularized_self_energy_Tmatrix.f90 create mode 100644 src/GT/regularized_self_energy_Tmatrix_diag.f90 diff --git a/src/GT/regularized_renormalization_factor_Tmatrix.f90 b/src/GT/regularized_renormalization_factor_Tmatrix.f90 new file mode 100644 index 0000000..457b93d --- /dev/null +++ b/src/GT/regularized_renormalization_factor_Tmatrix.f90 @@ -0,0 +1,74 @@ +subroutine regularized_renormalization_factor_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2,rho2,Z) + +! Compute renormalization factor of the T-matrix self-energy + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas,nC,nO,nV,nR + integer,intent(in) :: nOO + integer,intent(in) :: nVV + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: Omega1(nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) + double precision,intent(in) :: Omega2(nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) + +! Local variables + + integer :: i,a,p,cd,kl + double precision :: eps + + double precision :: kappa + double precision :: fk,dfk + +! Output variables + + double precision,intent(out) :: Z(nBas) + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +! Occupied part of the T-matrix self-energy + + do p=nC+1,nBas-nR + do i=nC+1,nO + do cd=1,nVV + + eps = e(p) + e(i) - Omega1(cd) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + Z(p) = Z(p) - rho1(p,i,cd)**2*dfk + + enddo + enddo + enddo + +! Virtual part of the T-matrix self-energy + + do p=nC+1,nBas-nR + do a=1,nV-nR + do kl=1,nOO + + eps = e(p) + e(nO+a) - Omega2(kl) + + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) + dfk = dfk*fk + + Z(p) = Z(p) - rho2(p,nO+a,kl)**2*dfk + + enddo + enddo + enddo + +end subroutine regularized_renormalization_factor_Tmatrix diff --git a/src/GT/regularized_self_energy_Tmatrix.f90 b/src/GT/regularized_self_energy_Tmatrix.f90 new file mode 100644 index 0000000..b9f3cd0 --- /dev/null +++ b/src/GT/regularized_self_energy_Tmatrix.f90 @@ -0,0 +1,80 @@ +subroutine regularized_self_energy_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2,rho2,SigT) + +! Compute the correlation part of the T-matrix self-energy + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nOO + integer,intent(in) :: nVV + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: Omega1(nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) + double precision,intent(in) :: Omega2(nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) + +! Local variables + + integer :: i,a,p,q,cd,kl + double precision :: eps + + double precision :: kappa + double precision :: fk + +! Output variables + + double precision,intent(inout) :: SigT(nBas,nBas) + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!---------------------------------------------- +! Occupied part of the T-matrix self-energy +!---------------------------------------------- + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do cd=1,nVV + + eps = e(p) + e(i) - Omega1(cd) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + + SigT(p,q) = SigT(p,q) + rho1(p,i,cd)*rho1(q,i,cd)*eps/(eps**2 + eta**2) + + enddo + enddo + enddo + enddo + +!---------------------------------------------- + ! Virtual part of the T-matrix self-energy +!---------------------------------------------- + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do a=nO+1,nBas-nR + do kl=1,nOO + + eps = e(p) + e(a) - Omega2(kl) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + + SigT(p,q) = SigT(p,q) + rho2(p,a,kl)*rho2(q,a,kl)*eps/(eps**2 + eta**2) + + enddo + enddo + enddo + enddo + +end subroutine regularized_self_energy_Tmatrix diff --git a/src/GT/regularized_self_energy_Tmatrix_diag.f90 b/src/GT/regularized_self_energy_Tmatrix_diag.f90 new file mode 100644 index 0000000..90b5f89 --- /dev/null +++ b/src/GT/regularized_self_energy_Tmatrix_diag.f90 @@ -0,0 +1,76 @@ +subroutine regularized_self_energy_Tmatrix_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2,rho2,SigT) + +! Compute diagonal of the correlation part of the T-matrix self-energy + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + integer,intent(in) :: nOO + integer,intent(in) :: nVV + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: Omega1(nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) + double precision,intent(in) :: Omega2(nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) + +! Local variables + + integer :: i,a,p,cd,kl + double precision :: eps + + double precision :: kappa + double precision :: fk + +! Output variables + + double precision,intent(inout) :: SigT(nBas) + +!-----------------------------------------! +! Parameters for regularized calculations ! +!-----------------------------------------! + + kappa = 1.1d0 + +!---------------------------------------------- +! Occupied part of the T-matrix self-energy +!---------------------------------------------- + + do p=nC+1,nBas-nR + do i=nC+1,nO + do cd=1,nVV + + eps = e(p) + e(i) - Omega1(cd) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + + SigT(p) = SigT(p) + rho1(p,i,cd)**2*fk + + enddo + enddo + enddo + +!---------------------------------------------- +! Virtual part of the T-matrix self-energy +!---------------------------------------------- + + do p=nC+1,nBas-nR + do a=nO+1,nBas-nR + do kl=1,nOO + + eps = e(p) + e(a) - Omega2(kl) + fk = (1d0 - exp(-kappa*abs(eps)))**2/eps + + SigT(p) = SigT(p) + rho2(p,a,kl)**2*fk + + enddo + enddo + enddo + +end subroutine regularized_self_energy_Tmatrix_diag diff --git a/src/GT/renormalization_factor_Tmatrix.f90 b/src/GT/renormalization_factor_Tmatrix.f90 index 59dbd7f..a05080d 100644 --- a/src/GT/renormalization_factor_Tmatrix.f90 +++ b/src/GT/renormalization_factor_Tmatrix.f90 @@ -19,7 +19,7 @@ subroutine renormalization_factor_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1, ! Local variables - integer :: i,j,k,l,a,b,c,d,p,cd,kl + integer :: i,a,p,cd,kl double precision :: eps ! Output variables diff --git a/src/GT/self_energy_Tmatrix.f90 b/src/GT/self_energy_Tmatrix.f90 index fc06791..1a3b437 100644 --- a/src/GT/self_energy_Tmatrix.f90 +++ b/src/GT/self_energy_Tmatrix.f90 @@ -23,7 +23,7 @@ subroutine self_energy_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2 ! Local variables - integer :: i,j,k,l,a,b,c,d,p,q,cd,kl + integer :: i,a,p,q,cd,kl double precision :: eps ! Output variables diff --git a/src/GT/self_energy_Tmatrix_diag.f90 b/src/GT/self_energy_Tmatrix_diag.f90 index f18ac6e..548c405 100644 --- a/src/GT/self_energy_Tmatrix_diag.f90 +++ b/src/GT/self_energy_Tmatrix_diag.f90 @@ -23,7 +23,7 @@ subroutine self_energy_Tmatrix_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,O ! Local variables - integer :: i,j,k,l,a,b,c,d,p,cd,kl + integer :: i,a,p,cd,kl double precision :: eps ! Output variables From de2c45ab708beded73ced2c01d32d39ad6d13d58 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 17 Dec 2021 15:42:16 +0100 Subject: [PATCH 04/12] fix bug --- input/options | 2 +- src/GW/regularized_renormalization_factor.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/input/options b/input/options index e8d2643..066d10c 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 T 5 1 1 T F + 1024 0.00001 T 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/src/GW/regularized_renormalization_factor.f90 b/src/GW/regularized_renormalization_factor.f90 index 98f3084..dea118f 100644 --- a/src/GW/regularized_renormalization_factor.f90 +++ b/src/GW/regularized_renormalization_factor.f90 @@ -73,7 +73,7 @@ subroutine regularized_renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,O fk = (1d0 - exp(-kappa*abs(eps)))**2/eps dfk = - 1d0/eps + 2d0*kappa*exp(-kappa*abs(eps))/(1d0 - exp(-kappa*abs(eps))) dfk = dfk*fk - Z(p) = Z(p) - 2d0*rho(p,a,jb)**2*(eps/(eps**2 + eta**2))**2 + Z(p) = Z(p) - 2d0*rho(p,a,jb)**2*dfk end do end do end do From 2a5d6892b860e9cddf983ef2c4d464c675b49c96 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 21 Dec 2021 13:49:41 +0100 Subject: [PATCH 05/12] BSE@GT potentially correct --- input/methods | 4 ++-- input/options | 4 ++-- mol/h2.xyz | 2 +- src/GT/Bethe_Salpeter_Tmatrix.f90 | 1 + src/GT/G0T0.f90 | 3 --- src/GT/dynamic_Tmatrix_A.f90 | 12 +++++++----- src/GT/static_Tmatrix_TA.f90 | 13 ++++++++----- src/GT/static_Tmatrix_TB.f90 | 9 ++++++--- src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 | 7 ++++--- src/LR/linear_response_pp.f90 | 6 +++--- 10 files changed, 34 insertions(+), 27 deletions(-) diff --git a/input/methods b/input/methods index 196855c..f51432f 100644 --- a/input/methods +++ b/input/methods @@ -11,11 +11,11 @@ # RPA* RPAx* crRPA ppRPA F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F F F F F + T F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW T F F F F # G0T0 evGT qsGT - F F F + T F F # MCMP2 F # * unrestricted version available diff --git a/input/options b/input/options index 066d10c..5b13b5b 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T + F T F T T # GF: maxSCF thresh DIIS n_diis lin eta renorm reg 256 0.00001 T 5 T 0.0 3 F # GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg @@ -15,6 +15,6 @@ # ACFDT: AC Kx XBS F F F # BSE: BSE dBSE dTDA evDyn - F F F F + T T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index d955cc4..3c8e04d 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0. 0. 0. -H 0. 0. 0.7 +H 0. 0. 1.5 diff --git a/src/GT/Bethe_Salpeter_Tmatrix.f90 b/src/GT/Bethe_Salpeter_Tmatrix.f90 index c0a79ff..dfb6c1b 100644 --- a/src/GT/Bethe_Salpeter_Tmatrix.f90 +++ b/src/GT/Bethe_Salpeter_Tmatrix.f90 @@ -119,6 +119,7 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, call linear_response_Tmatrix(ispin,.false.,TDA,eta,nBas,nC,nO,nV,nR,nS,1d0,eGT,ERI,TA,TB, & EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) + call print_excitation('BSE@GT ',ispin,nS,OmBSE(:,ispin)) call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) diff --git a/src/GT/G0T0.f90 b/src/GT/G0T0.f90 index 8d058e7..2bed967 100644 --- a/src/GT/G0T0.f90 +++ b/src/GT/G0T0.f90 @@ -199,9 +199,6 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing if(BSE) then -! eG0T0(1) = -0.5507952119d0 -! eG0T0(2) = +1.540259769d0 - call Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt, & Omega1s,X1s,Y1s,Omega2s,X2s,Y2s,rho1s,rho2s,Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,rho1t,rho2t, & ERI_MO,dipole_int,eHF,eG0T0,EcBSE) diff --git a/src/GT/dynamic_Tmatrix_A.f90 b/src/GT/dynamic_Tmatrix_A.f90 index 8472e0f..4cef4c2 100644 --- a/src/GT/dynamic_Tmatrix_A.f90 +++ b/src/GT/dynamic_Tmatrix_A.f90 @@ -58,14 +58,16 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O chi = 0d0 do cd=1,nVV - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*Omega1(cd)/(Omega1(cd)**2 + eta**2) + eps = + Omega1(cd) + chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) end do - do kl=1,nOO - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) + do kl=1,nOO + eps = - Omega2(kl) + chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) end do - A_dyn(ia,jb) = A_dyn(ia,jb) + 1d0*lambda*chi + A_dyn(ia,jb) = A_dyn(ia,jb) - 1d0*lambda*chi chi = 0d0 @@ -75,7 +77,7 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O end do do kl=1,nOO - eps = + OmBSE - Omega2(kl) - (eGT(a) + eGT(b)) + eps = + OmBSE + Omega2(kl) - (eGT(a) + eGT(b)) chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) end do diff --git a/src/GT/static_Tmatrix_TA.f90 b/src/GT/static_Tmatrix_TA.f90 index 9935919..e4b8771 100644 --- a/src/GT/static_Tmatrix_TA.f90 +++ b/src/GT/static_Tmatrix_TA.f90 @@ -26,6 +26,7 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r ! Local variables double precision :: chi + double precision :: eps integer :: i,j,a,b,ia,jb,kl,cd ! Output variables @@ -44,16 +45,18 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r chi = 0d0 do cd=1,nVV -! chi = chi + lambda*rho1(i,j,cd)*rho1(a,b,cd)*Omega1(cd)/(Omega1(cd)**2 + eta**2) - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*Omega1(cd)/(Omega1(cd)**2 + eta**2) + eps = + Omega1(cd) +! chi = chi + lambda*rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO -! chi = chi + lambda*rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) - chi = chi - rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/(Omega2(kl)**2 + eta**2) + eps = - Omega2(kl) +! chi = chi - lambda*rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) enddo - TA(ia,jb) = TA(ia,jb) - 1d0*lambda*chi + TA(ia,jb) = TA(ia,jb) + 1d0*lambda*chi enddo enddo diff --git a/src/GT/static_Tmatrix_TB.f90 b/src/GT/static_Tmatrix_TB.f90 index d4707c8..d05ac4d 100644 --- a/src/GT/static_Tmatrix_TB.f90 +++ b/src/GT/static_Tmatrix_TB.f90 @@ -26,6 +26,7 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r ! Local variables double precision :: chi + double precision :: eps integer :: i,j,a,b,ia,jb,kl,cd ! Output variables @@ -44,16 +45,18 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r chi = 0d0 do cd=1,nVV + eps = Omega1(cd) ! chi = chi + lambda*rho1(i,b,cd)*rho1(a,j,cd)*Omega1(cd)/Omega1(cd)**2 + eta**2 - chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*Omega1(cd)/Omega1(cd)**2 + eta**2 + chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO + eps = - Omega2(kl) ! chi = chi + lambda*rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 - chi = chi - rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 + chi = chi + rho2(i,b,kl)*rho2(a,j,kl)*eps/(eps**2 + eta**2) enddo - TB(ia,jb) = TB(ia,jb) - 1d0*lambda*chi + TB(ia,jb) = TB(ia,jb) + 1d0*lambda*chi enddo enddo diff --git a/src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 b/src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 index 9e0a2bf..89a616d 100644 --- a/src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 +++ b/src/GW/Bethe_Salpeter_A_matrix_dynamic.f90 @@ -48,15 +48,16 @@ subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,Om jb = jb + 1 chi = 0d0 + do kc=1,maxS - - chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) - + eps = OmRPA(kc) + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps/(eps**2 + eta**2) enddo A_dyn(ia,jb) = A_dyn(ia,jb) - 4d0*lambda*chi chi = 0d0 + do kc=1,maxS eps = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) diff --git a/src/LR/linear_response_pp.f90 b/src/LR/linear_response_pp.f90 index 894d111..c457ff8 100644 --- a/src/LR/linear_response_pp.f90 +++ b/src/LR/linear_response_pp.f90 @@ -47,8 +47,8 @@ subroutine linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nOO,nVV,lambda,e,ERI,Om ! Memory allocation allocate(B(nVV,nOO),C(nVV,nVV),D(nOO,nOO),M(nOO+nVV,nOO+nVV),Z(nOO+nVV,nOO+nVV),Omega(nOO+nVV)) -write(*,*) 'nOO', nOO -write(*,*) 'nVV', nVV +!write(*,*) 'nOO', nOO +!write(*,*) 'nVV', nVV !-------------------------------------------------! ! Solve the p-p eigenproblem ! !-------------------------------------------------! @@ -88,7 +88,7 @@ write(*,*) 'nVV', nVV M( 1:nVV ,nVV+1:nOO+nVV) = - B(1:nVV,1:nOO) M(nVV+1:nOO+nVV, 1:nVV) = + transpose(B(1:nVV,1:nOO)) -call matout(nOO+nVV,nOO+nVV,M) +!call matout(nOO+nVV,nOO+nVV,M) ! Diagonalize the p-h matrix if(nOO+nVV > 0) call diagonalize_general_matrix(nOO+nVV,M,Omega,Z) From d6ee3863da3f318faf89b63143c10e9ba4f6185e Mon Sep 17 00:00:00 2001 From: EnzoMonino Date: Fri, 31 Dec 2021 12:49:13 +0100 Subject: [PATCH 06/12] ppURPA --- input/methods | 10 +- input/options | 6 +- mol/h2.xyz | 2 +- src/LR/unrestricted_linear_response_B_pp.f90 | 102 +++++++++--------- src/LR/unrestricted_linear_response_C_pp.f90 | 104 +++++++++---------- src/LR/unrestricted_linear_response_D_pp.f90 | 61 +++++------ src/LR/unrestricted_linear_response_pp.f90 | 31 +++--- src/RPA/ppURPA.f90 | 72 +++++++------ 8 files changed, 196 insertions(+), 192 deletions(-) diff --git a/input/methods b/input/methods index f51432f..e2bef5b 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F T F F # MP2* MP3 MP2-F12 F F F # CCD pCCD DCD CCSD CCSD(T) @@ -9,13 +9,13 @@ # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* crRPA ppRPA - F F F F + F F F T # G0F2* evGF2* qsGF2* G0F3 evGF3 - T F F F F + F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - T F F F F + F F F F F # G0T0 evGT qsGT - T F F + F F F # MCMP2 F # * unrestricted version available diff --git a/input/options b/input/options index 5b13b5b..f9f075c 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 T 5 1 1 F F + 1024 0.00001 T 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis @@ -9,12 +9,12 @@ # GF: maxSCF thresh DIIS n_diis lin eta renorm reg 256 0.00001 T 5 T 0.0 3 F # GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg - 256 0.00001 T 5 T 0.0 F F F F F T + 256 0.00001 T 5 T 0.0 F F F F F F # GT: maxSCF thresh DIIS n_diis lin eta TDA_T reg 256 0.00001 T 5 T 0.0 F F # ACFDT: AC Kx XBS F F F # BSE: BSE dBSE dTDA evDyn - T T T F + F F F F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index 3c8e04d..bb00204 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0. 0. 0. -H 0. 0. 1.5 +H 0. 0. 1.0 diff --git a/src/LR/unrestricted_linear_response_B_pp.f90 b/src/LR/unrestricted_linear_response_B_pp.f90 index 8d163a5..6f5db5b 100644 --- a/src/LR/unrestricted_linear_response_B_pp.f90 +++ b/src/LR/unrestricted_linear_response_B_pp.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPt,nHaa, & - nHab,nHbb,nHt,lambda,e,ERI_aaaa,ERI_aabb,ERI_bbbb,B_pp) + nHab,nHbb,nHt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,B_pp) ! Compute linear response @@ -22,8 +22,7 @@ subroutine unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP integer,intent(in) :: nHab integer,intent(in) :: nHbb integer,intent(in) :: nHt - double precision,intent(in) :: lambda - double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: lambda double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) @@ -43,56 +42,10 @@ subroutine unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP eF = 0d0 !----------------------------------------------- -! Build B matrix for spin-conserving transitions +! Build B matrix for spin-conserved transitions !----------------------------------------------- - if(ispin == 1) then - - ! aaaa block - - ab = 0 - do a=nO(1)+1,nBas-nR(1) - do b=a,nBas-nR(1) - ab = ab + 1 - ij = 0 - do i=nC(1)+1,nO(1) - do j=i+1,nO(1) - ij = ij + 1 - - B_pp(ab,ij) = lambda*(ERI_aaaa(a,b,i,j) - ERI_aaaa(a,b,j,i)) - - end do - end do - end do - end do - - ! bbbb block - - ab = 0 - do a=nO(2)+1,nBas-nR(2) - do b=a+1,nBas-nR(2) - ab = ab + 1 - ij = 0 - do i=nC(2)+1,nO(2) - do j=i+1,nO(2) - ij = ij + 1 - - B_pp(nPaa+ab,nHaa+ij) = lambda*(ERI_bbbb(a,b,i,j) - ERI_bbbb(a,b,j,i)) - - end do - end do - end do - end do - - end if - -!----------------------------------------------- -! Build B matrix for spin-flip transitions -!----------------------------------------------- - - if(ispin == 2) then - - B_pp(:,:) = 0d0 + if(ispin == 1) then ! abab block @@ -107,6 +60,52 @@ subroutine unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP B_pp(ab,ij) = lambda*ERI_aabb(a,b,i,j) + end do + end do + end do + end do + + end if + +!----------------------------------------------- +! Build B matrix for spin-flip transitions +!----------------------------------------------- + + if(ispin == 2) then + + ! aaaa block + + ab = 0 + do a=nO(1)+1,nBas-nR(1) + do b=a+1,nBas-nR(1) + ab = ab + 1 + ij = 0 + do i=nC(1)+1,nO(1) + do j=i+1,nO(1) + ij = ij + 1 + + B_pp(ab,ij) = lambda*(ERI_aaaa(a,b,i,j) - ERI_aaaa(a,b,j,i)) + + end do + end do + end do + end do + end if + + if (ispin == 3) then + + ! bbbb block + + ab = 0 + do a=nO(2)+1,nBas-nR(2) + do b=a+1,nBas-nR(2) + ab = ab + 1 + ij = 0 + do i=nC(2)+1,nO(2) + do j=i+1,nO(2) + ij = ij + 1 + + B_pp(ab,ij) = lambda*(ERI_bbbb(a,b,i,j) - ERI_bbbb(a,b,j,i)) end do end do @@ -115,5 +114,4 @@ subroutine unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP end if - end subroutine unrestricted_linear_response_B_pp diff --git a/src/LR/unrestricted_linear_response_C_pp.f90 b/src/LR/unrestricted_linear_response_C_pp.f90 index 0de2351..45e8643 100644 --- a/src/LR/unrestricted_linear_response_C_pp.f90 +++ b/src/LR/unrestricted_linear_response_C_pp.f90 @@ -37,61 +37,12 @@ subroutine unrestricted_linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP eF = 0d0 - !----------------------------------------------- -! Build C matrix for spin-conserving transitions +! Build C matrix for spin-conserved transitions !----------------------------------------------- if(ispin == 1) then - ! aaaa block - - ab = 0 - do a=nO(1)+1,nBas-nR(1) - do b=a,nBas-nR(1) - ab = ab + 1 - cd = 0 - do c=nO(1)+1,nBas-nR(1) - do d=c,nBas-nR(1) - cd = cd + 1 - - C_pp(ab,cd) = (e(a,1) + e(b,1) - eF)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & - + lambda*(ERI_aaaa(a,b,c,d) - ERI_aaaa(a,b,d,c)) -!write(*,*) C_pp(ab,cd) - end do - end do - end do - end do - - ! bbbb block - - ab = 0 - do a=nO(2)+1,nBas-nR(2) - do b=a,nBas-nR(2) - ab = ab + 1 - cd = 0 - do c=nO(2)+1,nBas-nR(2) - do d=c,nBas-nR(2) - cd = cd + 1 - - C_pp(nPaa+ab,nPaa+cd) = (e(a,2) + e(b,2) - eF)*Kronecker_delta(a,c) & - *Kronecker_delta(b,d) + lambda*(ERI_bbbb(a,b,c,d) - ERI_bbbb(a,b,d,c)) -!write(*,*) 'nPaa+ab',nPaa+ab - end do - end do - end do - end do - - end if -! -!----------------------------------------------- -! Build C matrix for spin-flip transitions -!----------------------------------------------- - - if(ispin == 2) then - - C_pp(:,:) = 0d0 - ! abab block ab = 0 @@ -102,8 +53,8 @@ subroutine unrestricted_linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP do c=nO(1)+1,nBas-nR(1) do d=nO(2)+1,nBas-nR(2) cd = cd + 1 - C_pp(ab,cd) = (e(a,1) + e(b,2))*Kronecker_delta(a,c) & -*Kronecker_delta(b,c) + lambda*ERI_aabb(a,b,c,d) + C_pp(ab,cd) = (e(a,1) + e(b,2))*Kronecker_delta(a,c) & +*Kronecker_delta(b,d) + lambda*ERI_aabb(a,b,c,d) end do end do end do @@ -111,5 +62,54 @@ subroutine unrestricted_linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nP end if +!----------------------------------------------- +! Build C matrix for spin-flip transitions +!----------------------------------------------- + + if(ispin == 2) then + + ! aaaa block + + ab = 0 + do a=nO(1)+1,nBas-nR(1) + do b=a+1,nBas-nR(1) + ab = ab + 1 + cd = 0 + do c=nO(1)+1,nBas-nR(1) + do d=c+1,nBas-nR(1) + cd = cd + 1 + + C_pp(ab,cd) = (e(a,1) + e(b,1) - eF)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & + + lambda*(ERI_aaaa(a,b,c,d) - ERI_aaaa(a,b,d,c)) +!write(*,*) C_pp(ab,cd) + end do + end do + end do + end do + end if + + + if (ispin == 3) then + + ! bbbb block + + ab = 0 + do a=nO(2)+1,nBas-nR(2) + do b=a+1,nBas-nR(2) + ab = ab + 1 + cd = 0 + do c=nO(2)+1,nBas-nR(2) + do d=c+1,nBas-nR(2) + cd = cd + 1 + + C_pp(ab,cd) = (e(a,2) + e(b,2) - eF)*Kronecker_delta(a,c) & + *Kronecker_delta(b,d) + lambda*(ERI_bbbb(a,b,c,d) - ERI_bbbb(a,b,d,c)) + + end do + end do + end do + end do + + end if end subroutine unrestricted_linear_response_C_pp diff --git a/src/LR/unrestricted_linear_response_D_pp.f90 b/src/LR/unrestricted_linear_response_D_pp.f90 index 4ea7fd8..02ab1d0 100644 --- a/src/LR/unrestricted_linear_response_D_pp.f90 +++ b/src/LR/unrestricted_linear_response_D_pp.f90 @@ -39,11 +39,37 @@ subroutine unrestricted_linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nHaa,nHab,nH eF = 0d0 !----------------------------------------------- -! Build D matrix for spin-conserving transitions +! Build D matrix for spin-conserved transitions !----------------------------------------------- if(ispin == 1) then + ! abab block + + ij = 0 + do i=nC(1)+1,nO(1) + do j=nC(2)+1,nO(2) + ij = ij + 1 + kl = 0 + do k=nC(1)+1,nO(1) + do l=nC(2)+1,nO(2) + kl = kl + 1 + D_pp(ij,kl) = -(e(i,1) + e(j,2))*Kronecker_delta(i,k)& + *Kronecker_delta(j,l) +lambda*ERI_aabb(i,j,k,l) + end do + end do + end do + end do + + end if + + +!----------------------------------------------- +! Build D matrix for spin-flip transitions +!----------------------------------------------- + + if(ispin == 2) then + ! aaaa block ij = 0 @@ -62,6 +88,9 @@ subroutine unrestricted_linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nHaa,nHab,nH end do end do end do + end if + + if (ispin == 3) then ! bbbb block @@ -74,7 +103,7 @@ subroutine unrestricted_linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nHaa,nHab,nH do l=k+1,nO(2) kl = kl + 1 - D_pp(nHaa+ij,nHaa+kl) = -(e(i,2) + e(j,2) - eF)*Kronecker_delta(i,k) & + D_pp(ij,kl) = -(e(i,2) + e(j,2) - eF)*Kronecker_delta(i,k) & *Kronecker_delta(j,l) + lambda*(ERI_bbbb(i,j,k,l) - ERI_bbbb(i,j,l,k)) end do @@ -84,32 +113,4 @@ subroutine unrestricted_linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nHaa,nHab,nH end if -!----------------------------------------------- -! Build D matrix for spin-flip transitions -!----------------------------------------------- - - if(ispin == 2) then - - D_pp(:,:) = 0d0 - - ! abab block - - ij = 0 - do i=nC(1)+1,nO(1) - do j=nC(2)+1,nO(2) - ij = ij + 1 - kl = 0 - do k=nC(1)+1,nO(1) - do l=nC(2)+1,nO(2) - kl = kl + 1 - D_pp(ij,kl) = -(e(i,1) + e(j,2))*Kronecker_delta(i,k)& - *Kronecker_delta(j,l) +lambda*ERI_aabb(i,j,k,l) - end do - end do - end do - end do - - end if - - end subroutine unrestricted_linear_response_D_pp diff --git a/src/LR/unrestricted_linear_response_pp.f90 b/src/LR/unrestricted_linear_response_pp.f90 index 6c9019a..3111e89 100644 --- a/src/LR/unrestricted_linear_response_pp.f90 +++ b/src/LR/unrestricted_linear_response_pp.f90 @@ -55,25 +55,22 @@ EcRPA) ! Memory allocation - allocate(C(nPt,nPt),B(nPt,nHt),D(nHt,nHt),M(nPt+nHt,nPt+nHt),Z(nPt+nHt,nPt+nHt),& -Omega(nPt+nHt)) -!write(*,*) 'ispin', ispin -!write(*,*) 'nPt', nPt -!write(*,*) 'nHt', nHt + + allocate(C(nPt,nPt),B(nPt,nHt),D(nHt,nHt),M(nPt+nHt,nPt+nHt),Z(nPt+nHt,nPt+nHt)& +,Omega(nPt+nHt)) +!write(*,*) 'Hello' ! Build C, B and D matrices for the pp channel call unrestricted_linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPt,lambda,& e,ERI_aaaa,ERI_aabb,ERI_bbbb,C) -!call matout(nPt,nPt,C) -!write(*,*) 'Hello' call unrestricted_linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPt,nHaa,& nHab,nHbb,nHt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,B) !call matout(nPt,nHt,B) !write(*,*) 'Hello' call unrestricted_linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nHaa,nHab,nHbb,nHt,lambda,& -ERI_aaaa,ERI_aabb,ERI_bbbb,D) +e,ERI_aaaa,ERI_aabb,ERI_bbbb,D) !call matout(nHt,nHt,D) !write(*,*) 'Hello' @@ -91,22 +88,20 @@ ERI_aaaa,ERI_aabb,ERI_bbbb,D) ! Diagonalize the p-h matrix -! if(nHt+nPt > 0) call diagonalize_general_matrix(nHt+nPt,M,Omega,Z) + if(nHt+nPt > 0) call diagonalize_general_matrix(nHt+nPt,M,Omega,Z) ! Split the various quantities in p-p and h-h parts -! call sort_ppRPA(nHt,nPt,Omega(:),Z(:,:),Omega1(:),X1(:,:),Y1(:,:),Omega2(:),X2(:,:),& -!Y2(:,:)) - -! end if Pourquoi ne faut-il pas de end if ici ? + call sort_ppRPA(nHt,nPt,Omega(:),Z(:,:),Omega1(:),X1(:,:),Y1(:,:),Omega2(:),X2(:,:),& +Y2(:,:)) ! Compute the RPA correlation energy -! EcRPA = 0.5d0*( sum(Omega1(:)) - sum(Omega2(:)) - trace_matrix(nPt,C(:,:)) - trace_matrix(nHt,D(:,:)) ) -! EcRPA1 = +sum(Omega1(:)) - trace_matrix(nPt,C(:,:)) -! EcRPA2 = -sum(Omega2(:)) - trace_matrix(nHt,D(:,:)) -! if(abs(EcRPA - EcRPA1) > 1d-6 .or. abs(EcRPA - EcRPA2) > 1d-6) & -! print*,'!!! Issue in pp-RPA linear reponse calculation RPA1 != RPA2 !!!' + EcRPA = 0.5d0*( sum(Omega1(:)) - sum(Omega2(:)) - trace_matrix(nPt,C(:,:)) - trace_matrix(nHt,D(:,:)) ) + EcRPA1 = +sum(Omega1(:)) - trace_matrix(nPt,C(:,:)) + EcRPA2 = -sum(Omega2(:)) - trace_matrix(nHt,D(:,:)) + if(abs(EcRPA - EcRPA1) > 1d-6 .or. abs(EcRPA - EcRPA2) > 1d-6) & + print*,'!!! Issue in pp-RPA linear reponse calculation RPA1 != RPA2 !!!' diff --git a/src/RPA/ppURPA.f90 b/src/RPA/ppURPA.f90 index 59513a4..395e078 100644 --- a/src/RPA/ppURPA.f90 +++ b/src/RPA/ppURPA.f90 @@ -51,46 +51,29 @@ subroutine ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUH Ec_ppURPA(:) = 0d0 EcAC(:) = 0d0 -! Useful quantities - -!spin-conserved quantities - - nPaa = nV(1)*(nV(1)-1)/2 - nPbb = nV(2)*(nV(2)-1)/2 - - nP_sc = nPaa + nPbb - - nHaa = nO(1)*(nO(1)-1)/2 - nHbb = nO(2)*(nO(2)-1)/2 - - nH_sc = nHaa + nHbb - -!spin-flip quantities - - nPab = nV(1)*nV(2) - nHab = nO(1)*nO(2) - - nP_sf = nPab - nH_sf = nPab - - ! Memory allocation - - allocate(Omega1sc(nP_sc),X1sc(nP_sc,nP_sc),Y1sc(nH_sc,nP_sc), & - Omega2sc(nH_sc),X2sc(nP_sc,nH_sc),Y2sc(nH_sc,nH_sc)) - - allocate(Omega1sf(nP_sf),X1sf(nP_sf,nP_sf),Y1sf(nH_sf,nP_sf), & - Omega2sf(nH_sf),X2sf(nP_sf,nH_sf),Y2sf(nH_sf,nH_sf)) - ! Spin-conserved manifold if(spin_conserved) then ispin = 1 +!spin-conserved quantities + + nPab = nV(1)*nV(2) + nHab = nO(1)*nO(2) + + nP_sc = nPab + nH_sc = nHab + +! Memory allocation + + allocate(Omega1sc(nP_sc),X1sc(nP_sc,nP_sc),Y1sc(nH_sc,nP_sc), & + Omega2sc(nH_sc),X2sc(nP_sc,nH_sc),Y2sc(nH_sc,nH_sc)) + call unrestricted_linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nP_sc, & nHaa,nHab,nHbb,nH_sc,1d0,e,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega1sc,X1sc,Y1sc,Omega2sc,X2sc,Y2sc,& Ec_ppURPA(ispin)) -write(*,*) 'Hello!' + call print_excitation('pp-RPA (N+2)',5,nP_sc,Omega1sc) call print_excitation('pp-RPA (N-2)',5,nH_sc,Omega2sc) @@ -102,6 +85,33 @@ write(*,*) 'Hello!' ispin = 2 +!spin-flip quantities + + nPaa = nV(1)*(nV(1)-1)/2 + nPbb = nV(2)*(nV(2)-1)/2 + + nP_sf = nPaa + + nHaa = nO(1)*(nO(1)-1)/2 + nHbb = nO(2)*(nO(2)-1)/2 + + nH_sf = nHaa + +allocate(Omega1sf(nP_sf),X1sf(nP_sf,nP_sf),Y1sf(nH_sf,nP_sf), & + Omega2sf(nH_sf),X2sf(nP_sf,nH_sf),Y2sf(nH_sf,nH_sf)) + +call unrestricted_linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nP_sf, & +nHaa,nHab,nHbb,nH_sf,1d0,e,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega1sf,X1sf,Y1sf,Omega2sf,X2sf,Y2sf,& +Ec_ppURPA(ispin)) + + ispin = 3 + + nP_sf = nPbb + nH_sf = nHbb + +!allocate(Omega1sf(nP_sf),X1sf(nP_sf,nP_sf),Y1sf(nH_sf,nP_sf), & +! Omega2sf(nH_sf),X2sf(nP_sf,nH_sf),Y2sf(nH_sf,nH_sf)) + call unrestricted_linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nP_sf, & nHaa,nHab,nHbb,nH_sf,1d0,e,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega1sf,X1sf,Y1sf,Omega2sf,X2sf,Y2sf,& Ec_ppURPA(ispin)) From 97c274a4f1ab874096b961761c47c625666efd4a Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 2 Jan 2022 10:24:30 +0100 Subject: [PATCH 07/12] rename files in GT --- input/methods | 4 ++-- input/options | 4 ++-- mol/h2.xyz | 2 +- src/GT/Bethe_Salpeter_Tmatrix.f90 | 18 ++++++++++++++---- src/GT/G0T0.f90 | 1 + src/GT/self_energy_Tmatrix.f90 | 4 ++-- src/GT/self_energy_Tmatrix_diag.f90 | 4 ++-- ...tic_Tmatrix_TA.f90 => static_Tmatrix_A.f90} | 4 ++-- ...tic_Tmatrix_TB.f90 => static_Tmatrix_B.f90} | 6 +++--- src/LR/linear_response_Tmatrix.f90 | 10 ++++++++++ src/RPA/ACFDT_Tmatrix.f90 | 16 ++++++++-------- 11 files changed, 47 insertions(+), 26 deletions(-) rename src/GT/{static_Tmatrix_TA.f90 => static_Tmatrix_A.f90} (92%) rename src/GT/{static_Tmatrix_TB.f90 => static_Tmatrix_B.f90} (91%) diff --git a/input/methods b/input/methods index f51432f..0efb48f 100644 --- a/input/methods +++ b/input/methods @@ -11,9 +11,9 @@ # RPA* RPAx* crRPA ppRPA F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - T F F F F + F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - T F F F F + F F F F F # G0T0 evGT qsGT T F F # MCMP2 diff --git a/input/options b/input/options index 5b13b5b..7fb79c3 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T F T T + F T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm reg 256 0.00001 T 5 T 0.0 3 F # GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg @@ -15,6 +15,6 @@ # ACFDT: AC Kx XBS F F F # BSE: BSE dBSE dTDA evDyn - T T T F + T F T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index 3c8e04d..a4e936a 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0. 0. 0. -H 0. 0. 1.5 +H 0. 0. 2.000000 diff --git a/src/GT/Bethe_Salpeter_Tmatrix.f90 b/src/GT/Bethe_Salpeter_Tmatrix.f90 index dfb6c1b..30e76e1 100644 --- a/src/GT/Bethe_Salpeter_Tmatrix.f90 +++ b/src/GT/Bethe_Salpeter_Tmatrix.f90 @@ -88,8 +88,13 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, ! call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) + + print*,'aa block of TA' + call matout(nS,nS,TA) + print*,'aa block of TB' + call matout(nS,nS,TB) !---------------------------------------------- ! Compute T-matrix for alpha-alpha block @@ -103,8 +108,13 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, ! call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) + + print*,'aa+ab block of TA' + call matout(nS,nS,TA) + print*,'aa+ab block of TB' + call matout(nS,nS,TB) !------------------- ! Singlet manifold diff --git a/src/GT/G0T0.f90 b/src/GT/G0T0.f90 index 2bed967..94f886c 100644 --- a/src/GT/G0T0.f90 +++ b/src/GT/G0T0.f90 @@ -190,6 +190,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing iblock = 4 call linear_response_pp(iblock,TDA_T,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,eG0T0,ERI_MO, & Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,EcRPA(ispin)) + EcRPA(1) = EcRPA(1) - EcRPA(2) EcRPA(2) = 3d0*EcRPA(2) diff --git a/src/GT/self_energy_Tmatrix.f90 b/src/GT/self_energy_Tmatrix.f90 index 1a3b437..3a6c515 100644 --- a/src/GT/self_energy_Tmatrix.f90 +++ b/src/GT/self_energy_Tmatrix.f90 @@ -38,7 +38,7 @@ subroutine self_energy_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2 do q=nC+1,nBas-nR do i=nC+1,nO do cd=1,nVV - eps = e(p) + e(i) - Omega1(cd) + eps = e(p) + e(i) - Omega1(cd) SigT(p,q) = SigT(p,q) + rho1(p,i,cd)*rho1(q,i,cd)*eps/(eps**2 + eta**2) enddo enddo @@ -53,7 +53,7 @@ subroutine self_energy_Tmatrix(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2 do q=nC+1,nBas-nR do a=nO+1,nBas-nR do kl=1,nOO - eps = e(p) + e(a) - Omega2(kl) + eps = e(p) + e(a) - Omega2(kl) SigT(p,q) = SigT(p,q) + rho2(p,a,kl)*rho2(q,a,kl)*eps/(eps**2 + eta**2) enddo enddo diff --git a/src/GT/self_energy_Tmatrix_diag.f90 b/src/GT/self_energy_Tmatrix_diag.f90 index 548c405..76884d0 100644 --- a/src/GT/self_energy_Tmatrix_diag.f90 +++ b/src/GT/self_energy_Tmatrix_diag.f90 @@ -37,7 +37,7 @@ subroutine self_energy_Tmatrix_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,O do p=nC+1,nBas-nR do i=nC+1,nO do cd=1,nVV - eps = e(p) + e(i) - Omega1(cd) + eps = e(p) + e(i) - Omega1(cd) SigT(p) = SigT(p) + rho1(p,i,cd)**2*eps/(eps**2 + eta**2) enddo enddo @@ -50,7 +50,7 @@ subroutine self_energy_Tmatrix_diag(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,O do p=nC+1,nBas-nR do a=nO+1,nBas-nR do kl=1,nOO - eps = e(p) + e(a) - Omega2(kl) + eps = e(p) + e(a) - Omega2(kl) SigT(p) = SigT(p) + rho2(p,a,kl)**2*eps/(eps**2 + eta**2) enddo enddo diff --git a/src/GT/static_Tmatrix_TA.f90 b/src/GT/static_Tmatrix_A.f90 similarity index 92% rename from src/GT/static_Tmatrix_TA.f90 rename to src/GT/static_Tmatrix_A.f90 index e4b8771..f6a4817 100644 --- a/src/GT/static_Tmatrix_TA.f90 +++ b/src/GT/static_Tmatrix_A.f90 @@ -1,4 +1,4 @@ -subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TA) +subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TA) ! Compute the OOVV block of the static T-matrix for the resonant block @@ -63,4 +63,4 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r enddo enddo -end subroutine static_Tmatrix_TA +end subroutine static_Tmatrix_A diff --git a/src/GT/static_Tmatrix_TB.f90 b/src/GT/static_Tmatrix_B.f90 similarity index 91% rename from src/GT/static_Tmatrix_TB.f90 rename to src/GT/static_Tmatrix_B.f90 index d05ac4d..4103ecc 100644 --- a/src/GT/static_Tmatrix_TB.f90 +++ b/src/GT/static_Tmatrix_B.f90 @@ -1,4 +1,4 @@ -subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TB) +subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TB) ! Compute the OVVO block of the static T-matrix for the coupling block @@ -45,7 +45,7 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r chi = 0d0 do cd=1,nVV - eps = Omega1(cd) + eps = + Omega1(cd) ! chi = chi + lambda*rho1(i,b,cd)*rho1(a,j,cd)*Omega1(cd)/Omega1(cd)**2 + eta**2 chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*eps/(eps**2 + eta**2) enddo @@ -63,4 +63,4 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r enddo enddo -end subroutine static_Tmatrix_TB +end subroutine static_Tmatrix_B diff --git a/src/LR/linear_response_Tmatrix.f90 b/src/LR/linear_response_Tmatrix.f90 index bdb20ff..ec087dd 100644 --- a/src/LR/linear_response_Tmatrix.f90 +++ b/src/LR/linear_response_Tmatrix.f90 @@ -44,6 +44,11 @@ subroutine linear_response_Tmatrix(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda A(:,:) = A(:,:) + A_BSE(:,:) + print*,'A' + call matout(nS,nS,A) + print*,'TA' + call matout(nS,nS,A_BSE) + ! Tamm-Dancoff approximation if(TDA) then @@ -60,6 +65,11 @@ subroutine linear_response_Tmatrix(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda B(:,:) = B(:,:) + B_BSE(:,:) + print*,'B' + call matout(nS,nS,B) + print*,'TB' + call matout(nS,nS,B_BSE) + ! Build A + B and A - B matrices ApB = A + B diff --git a/src/RPA/ACFDT_Tmatrix.f90 b/src/RPA/ACFDT_Tmatrix.f90 index b667c15..9b25e29 100644 --- a/src/RPA/ACFDT_Tmatrix.f90 +++ b/src/RPA/ACFDT_Tmatrix.f90 @@ -128,8 +128,8 @@ subroutine ACFDT_Tmatrix(exchange_kernel,doXBS,dRPA,TDA_T,TDA,BSE,singlet,triple call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) isp_T = 2 iblock = 4 @@ -139,8 +139,8 @@ subroutine ACFDT_Tmatrix(exchange_kernel,doXBS,dRPA,TDA_T,TDA,BSE,singlet,triple call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) end if @@ -198,8 +198,8 @@ subroutine ACFDT_Tmatrix(exchange_kernel,doXBS,dRPA,TDA_T,TDA,BSE,singlet,triple call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,lambda,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) isp_T = 2 iblock = 4 @@ -209,8 +209,8 @@ subroutine ACFDT_Tmatrix(exchange_kernel,doXBS,dRPA,TDA_T,TDA,BSE,singlet,triple call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t) - call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) - if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) + call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) + if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,lambda,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) end if From 3cf1159cf04347ab200ec214424b843708027859 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 2 Jan 2022 17:14:10 +0100 Subject: [PATCH 08/12] unrestricted boolean in QuAcK --- input/methods | 6 ++-- src/QuAcK/QuAcK.f90 | 78 +++++++++++++++++++++++++++++++++++++-------- 2 files changed, 68 insertions(+), 16 deletions(-) diff --git a/input/methods b/input/methods index e2bef5b..259d3f4 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F T F F + T F F F # MP2* MP3 MP2-F12 F F F # CCD pCCD DCD CCSD CCSD(T) @@ -9,13 +9,13 @@ # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* crRPA ppRPA - F F F T + F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW F F F F F # G0T0 evGT qsGT - F F F + T F F # MCMP2 F # * unrestricted version available diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 4adadbd..ee41859 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -707,6 +707,7 @@ program QuAcK if(doCIS) then call cpu_time(start_CIS) + if(unrestricted) then call UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_MO_aaaa,ERI_MO_aabb, & @@ -717,6 +718,7 @@ program QuAcK call CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eHF) end if + call cpu_time(end_CIS) t_CIS = end_CIS - start_CIS @@ -830,6 +832,7 @@ program QuAcK if(doppRPA) then call cpu_time(start_RPA) + if(unrestricted) then call ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUHF,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,eHF) @@ -839,6 +842,7 @@ program QuAcK call ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,eHF) end if + call cpu_time(end_RPA) t_RPA = end_RPA - start_RPA @@ -959,7 +963,17 @@ program QuAcK if(doG0F3) then call cpu_time(start_GF3) - call G0F3(renormGF,nBas,nC,nO,nV,nR,ERI_MO,eHF) + + if(unrestricted) then + + print*,'!!! G0F3 NYI at the unrestricted level !!!' + + else + + call G0F3(renormGF,nBas,nC,nO,nV,nR,ERI_MO,eHF) + + end if + call cpu_time(end_GF3) t_GF3 = end_GF3 - start_GF3 @@ -975,7 +989,17 @@ program QuAcK if(doevGF3) then call cpu_time(start_GF3) - call evGF3(maxSCF_GF,thresh_GF,n_diis_GF,renormGF,nBas,nC,nO,nV,nR,ERI_MO,eHF) + + if(unrestricted) then + + print*,'!!! evGF3 NYI at the unrestricted level !!!' + + else + + call evGF3(maxSCF_GF,thresh_GF,n_diis_GF,renormGF,nBas,nC,nO,nV,nR,ERI_MO,eHF) + + end if + call cpu_time(end_GF3) t_GF3 = end_GF3 - start_GF3 @@ -1122,9 +1146,19 @@ program QuAcK if(doG0T0) then call cpu_time(start_G0T0) - call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - linGT,eta_GT,regGT,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & - PHF,cHF,eHF,Vxc,eG0T0) + + if(unrestricted) then + + print*,'!!! G0T0 NYI at the unrestricted level !!!' + + else + + call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + linGT,eta_GT,regGT,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & + PHF,cHF,eHF,Vxc,eG0T0) + + end if + call cpu_time(end_G0T0) t_G0T0 = end_G0T0 - start_G0T0 @@ -1140,10 +1174,20 @@ program QuAcK if(doevGT) then call cpu_time(start_evGT) - call evGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & - PHF,cHF,eHF,Vxc,eG0T0) + + if(unrestricted) then + + print*,'!!! evGT NYI at the unrestricted level !!!' + + else + + call evGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & + BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & + PHF,cHF,eHF,Vxc,eG0T0) + + end if + call cpu_time(end_evGT) t_evGT = end_evGT - start_evGT @@ -1160,10 +1204,18 @@ program QuAcK call cpu_time(start_qsGT) - call qsGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & - nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, & - ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + if(unrestricted) then + + print*,'!!! qsGT NYI at the unrestricted level !!!' + + else + + call qsGT(maxSCF_GT,thresh_GT,n_diis_GT,doACFDT,exchange_kernel,doXBS, & + BSE,TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GT,regGT, & + nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, & + ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + + end if call cpu_time(end_qsGT) From f6270a0ba5dccf09897efd607c17b1d98529205e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 4 Jan 2022 11:39:33 +0100 Subject: [PATCH 09/12] CID and CISD --- input/methods | 4 +- input/options | 2 +- mol/h2.xyz | 2 +- src/CI/CID.f90 | 218 ++++++++++++++++++ src/CI/CISD.f90 | 342 +++++++++++++++++++---------- src/GT/dynamic_Tmatrix_A.f90 | 12 +- src/GT/static_Tmatrix_A.f90 | 4 +- src/GT/static_Tmatrix_B.f90 | 4 +- src/HF/RHF.f90 | 6 +- src/QuAcK/QuAcK.f90 | 14 +- src/utils/spatial_to_spin_fock.f90 | 29 +++ 11 files changed, 497 insertions(+), 140 deletions(-) create mode 100644 src/CI/CID.f90 create mode 100644 src/utils/spatial_to_spin_fock.f90 diff --git a/input/methods b/input/methods index 259d3f4..9f505d6 100644 --- a/input/methods +++ b/input/methods @@ -7,7 +7,7 @@ # drCCD rCCD crCCD lCCD F F F F # CIS* CIS(D) CID CISD FCI - F F F F F + F F T T F # RPA* RPAx* crRPA ppRPA F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 @@ -15,7 +15,7 @@ # G0W0* evGW* qsGW* ufG0W0 ufGW F F F F F # G0T0 evGT qsGT - T F F + F F F # MCMP2 F # * unrestricted version available diff --git a/input/options b/input/options index e8b50b8..d6417cb 100644 --- a/input/options +++ b/input/options @@ -15,6 +15,6 @@ # ACFDT: AC Kx XBS F F F # BSE: BSE dBSE dTDA evDyn - T F T F + T T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index bb00204..a4e936a 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0. 0. 0. -H 0. 0. 1.0 +H 0. 0. 2.000000 diff --git a/src/CI/CID.f90 b/src/CI/CID.f90 new file mode 100644 index 0000000..ca6a78d --- /dev/null +++ b/src/CI/CID.f90 @@ -0,0 +1,218 @@ +subroutine CID(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERIin,Fin,E0) + +! Perform configuration interaction with doubles + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: singlet_manifold + logical,intent(in) :: triplet_manifold + integer,intent(in) :: nBasin + integer,intent(in) :: nCin + integer,intent(in) :: nOin + integer,intent(in) :: nVin + integer,intent(in) :: nRin + double precision,intent(in) :: Fin(nBasin,nBasin) + double precision,intent(in) :: ERIin(nBasin,nBasin,nBasin,nBasin) + double precision,intent(in) :: E0 + +! Local variables + + integer :: nBas + integer :: nC + integer :: nO + integer :: nV + integer :: nR + + double precision,allocatable :: F(:,:) + double precision,allocatable :: sERI(:,:,:,:) + double precision,allocatable :: ERI(:,:,:,:) + + logical :: dump_trans = .false. + integer :: i,j,k,l + integer :: a,b,c,d + integer :: ia,kc,iajb,kcld + integer :: ishift,jshift + integer :: ispin + integer :: nD + integer :: nH + integer :: maxH + double precision,external :: Kronecker_delta + double precision,allocatable :: H(:,:) + double precision,allocatable :: ECID(:) + + double precision :: tmp + +! Hello world + + write(*,*) + write(*,*)'******************************************************' + write(*,*)'| Configuration Interaction with Singles and Doubles |' + write(*,*)'******************************************************' + write(*,*) + +! Spatial to spin orbitals + + nBas = 2*nBasin + nC = 2*nCin + nO = 2*nOin + nV = 2*nVin + nR = 2*nRin + + allocate(F(nBas,nBas),sERI(nBas,nBas,nBas,nBas)) + + call spatial_to_spin_fock(nBasin,Fin,nBas,F) + call spatial_to_spin_ERI(nBasin,ERIin,nBas,sERI) + +! Antysymmetrize ERIs + + allocate(ERI(nBas,nBas,nBas,nBas)) + + call antisymmetrize_ERI(2,nBas,sERI,ERI) + + deallocate(sERI) + +! Compute CID matrix + + nD = (nO - nC)*(nO - nC - 1)/2*(nV - nR)*(nV - nR - 1)/2 + nH = 1 + nD + + write(*,*) 'nD = ',nD + write(*,*) 'nH = ',nH + write(*,*) + + maxH = min(nH,21) + + ! Memory allocation + + allocate(H(nH,nH),ECID(nH)) + + ! 00 block + + ishift = 0 + jshift = 0 + + H(ishift+1,jshift+1) = E0 + + print*,'00 block done...' + + ! 0D blocks + + ishift = 0 + jshift = 1 + + iajb = 0 + do i=nC+1,nO + do a=1,nV-nR + do j=i+1,nO + do b=a+1,nV-nR + + iajb = iajb + 1 + tmp = ERI(i,j,nO+a,nO+b) + + H(ishift+1,jshift+iajb) = tmp + H(jshift+iajb,ishift+1) = tmp + + end do + end do + end do + end do + + print*,'0D blocks done...' + + ! DD block + + ishift = 1 + jshift = 1 + + iajb = 0 + do i=nC+1,nO + do a=1,nV-nR + do j=i+1,nO + do b=a+1,nV-nR + + iajb = iajb + 1 + + kcld = 0 + do k=nC+1,nO + do c=1,nV-nR + do l=k+1,nO + do d=c+1,nV-nR + + kcld = kcld + 1 + tmp = & + E0*Kronecker_delta(i,k)*Kronecker_delta(j,l)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & + + F(l,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(i,k) & + - F(l,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(i,k) & + - F(k,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(i,l) & + + F(k,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(i,l) & + - F(l,i)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(j,k) & + + F(l,i)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(j,k) & + + F(k,i)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(j,l) & + - F(k,i)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(j,l) & + + F(nO+a,nO+d)*Kronecker_delta(b,c)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + - F(nO+a,nO+c)*Kronecker_delta(b,d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + - F(nO+a,nO+d)*Kronecker_delta(b,c)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + + F(nO+a,nO+c)*Kronecker_delta(b,d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - F(nO+b,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + F(nO+b,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + F(nO+b,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - F(nO+b,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - ERI(k,l,i,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c) & + + ERI(k,l,i,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & + + ERI(nO+a,l,nO+d,j)*Kronecker_delta(b,c)*Kronecker_delta(i,k) & + - ERI(nO+a,l,nO+c,j)*Kronecker_delta(b,d)*Kronecker_delta(i,k) & + - ERI(nO+a,k,nO+d,j)*Kronecker_delta(b,c)*Kronecker_delta(i,l) & + + ERI(nO+a,k,nO+c,j)*Kronecker_delta(b,d)*Kronecker_delta(i,l) & + - ERI(nO+a,l,nO+d,i)*Kronecker_delta(b,c)*Kronecker_delta(j,k) & + + ERI(nO+a,l,nO+c,i)*Kronecker_delta(b,d)*Kronecker_delta(j,k) & + + ERI(nO+a,k,nO+d,i)*Kronecker_delta(b,c)*Kronecker_delta(j,l) & + - ERI(nO+a,k,nO+c,i)*Kronecker_delta(b,d)*Kronecker_delta(j,l) & + - ERI(nO+b,l,nO+d,j)*Kronecker_delta(a,c)*Kronecker_delta(i,k) & + + ERI(nO+b,l,nO+c,j)*Kronecker_delta(a,d)*Kronecker_delta(i,k) & + + ERI(nO+b,k,nO+d,j)*Kronecker_delta(a,c)*Kronecker_delta(i,l) & + - ERI(nO+b,k,nO+c,j)*Kronecker_delta(a,d)*Kronecker_delta(i,l) & + + ERI(nO+b,l,nO+d,i)*Kronecker_delta(a,c)*Kronecker_delta(j,k) & + - ERI(nO+b,l,nO+c,i)*Kronecker_delta(a,d)*Kronecker_delta(j,k) & + - ERI(nO+b,k,nO+d,i)*Kronecker_delta(a,c)*Kronecker_delta(j,l) & + + ERI(nO+b,k,nO+c,i)*Kronecker_delta(a,d)*Kronecker_delta(j,l) & + - ERI(nO+a,nO+b,nO+c,nO+d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + ERI(nO+a,nO+b,nO+c,nO+d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) + + H(ishift+iajb,jshift+kcld) = tmp + + end do + end do + end do + end do + + end do + end do + end do + end do + + print*,'DD block done...' + + write(*,*) + write(*,*) 'Diagonalizing CID matrix...' + write(*,*) + + call diagonalize_matrix(nH,H,ECID) + + print*,'CID energies (au)' + call matout(maxH,1,ECID) + write(*,*) + + print*,'CID excitation energies (eV)' + call matout(maxH-1,1,(ECID(2:maxH)-ECID(1))*HaToeV) + write(*,*) + + if(dump_trans) then + print*,'Singlet CID transition vectors' + call matout(nH,nH,H) + write(*,*) + endif + +end subroutine CID diff --git a/src/CI/CISD.f90 b/src/CI/CISD.f90 index 611d940..1037d11 100644 --- a/src/CI/CISD.f90 +++ b/src/CI/CISD.f90 @@ -1,4 +1,4 @@ -subroutine CISD(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,ERI,eHF) +subroutine CISD(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERIin,Fin,E0) ! Perform configuration interaction with singles and doubles @@ -9,23 +9,42 @@ subroutine CISD(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,ERI,eHF) logical,intent(in) :: singlet_manifold logical,intent(in) :: triplet_manifold - integer,intent(in) :: nBas,nC,nO,nV,nR - double precision,intent(in) :: eHF(nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + integer,intent(in) :: nBasin + integer,intent(in) :: nCin + integer,intent(in) :: nOin + integer,intent(in) :: nVin + integer,intent(in) :: nRin + double precision,intent(in) :: Fin(nBasin,nBasin) + double precision,intent(in) :: ERIin(nBasin,nBasin,nBasin,nBasin) + double precision,intent(in) :: E0 ! Local variables + integer :: nBas + integer :: nC + integer :: nO + integer :: nV + integer :: nR + + double precision,allocatable :: F(:,:) + double precision,allocatable :: sERI(:,:,:,:) + double precision,allocatable :: ERI(:,:,:,:) + logical :: dump_trans = .false. integer :: i,j,k,l integer :: a,b,c,d - integer :: ia,jb,iajb,kcld + integer :: ia,kc,iajb,kcld integer :: ishift,jshift integer :: ispin integer :: nS integer :: nD - integer :: nSD + integer :: nH + integer :: maxH double precision,external :: Kronecker_delta - double precision,allocatable :: H(:,:),Omega(:) + double precision,allocatable :: H(:,:) + double precision,allocatable :: ECISD(:) + + double precision :: tmp ! Hello world @@ -35,170 +54,257 @@ subroutine CISD(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,ERI,eHF) write(*,*)'******************************************************' write(*,*) -! Compute CIS matrix +! Spatial to spin orbitals - if(singlet_manifold) then + nBas = 2*nBasin + nC = 2*nCin + nO = 2*nOin + nV = 2*nVin + nR = 2*nRin - ispin = 1 + allocate(F(nBas,nBas),sERI(nBas,nBas,nBas,nBas)) - ! Dimensions + call spatial_to_spin_fock(nBasin,Fin,nBas,F) + call spatial_to_spin_ERI(nBasin,ERIin,nBas,sERI) - nS = (nO - nC)*(nV - nR) - nD = (nO - nC)*(nO - nC + 1)/2*(nV - nR)*(nV - nR + 1)/2 - nSD = 1 + nS + nD +! Antysymmetrize ERIs - print*,'nS = ',nS - print*,'nD = ',nD - print*,'nSD = ',nSD + allocate(ERI(nBas,nBas,nBas,nBas)) - ! Memory allocation + call antisymmetrize_ERI(2,nBas,sERI,ERI) - allocate(H(nSD,nSD),Omega(nSD)) - - ! 0D block + deallocate(sERI) - ishift = 0 - jshift = 1 + nS +! Compute CISD matrix - iajb = 0 + nS = (nO - nC)*(nV - nR) + nD = (nO - nC)*(nO - nC - 1)/2*(nV - nR)*(nV - nR - 1)/2 + nH = 1 + nS + nD - do i=nC+1,nO - do a=1,nV-nR - do j=i,nO - do b=a,nV-nR + write(*,*) 'nS = ',nS + write(*,*) 'nD = ',nD + write(*,*) 'nH = ',nH + write(*,*) - iajb = iajb + 1 - H(ishift+1,jshift+iajb) = ERI(i,j,nO+a,nO+b) + maxH = min(nH,21) + + ! Memory allocation + + allocate(H(nH,nH),ECISD(nH)) + + ! 00 block + + ishift = 0 + jshift = 0 + + H(ishift+1,jshift+1) = E0 + + print*,'00 block done...' + + ! 0S blocks + + ishift = 0 + jshift = 1 + + ia = 0 + do i=nC+1,nO + do a=1,nV-nR + + ia = ia + 1 + tmp = F(i,nO+a) + H(ishift+1,jshift+ia) = tmp + H(jshift+ia,ishift+1) = tmp + + end do + end do + + print*,'0S blocks done...' + + ! 0D blocks + + ishift = 0 + jshift = 1 + nS + + iajb = 0 + do i=nC+1,nO + do a=1,nV-nR + do j=i+1,nO + do b=a+1,nV-nR + + iajb = iajb + 1 + tmp = ERI(i,j,nO+a,nO+b) + + H(ishift+1,jshift+iajb) = tmp + H(jshift+iajb,ishift+1) = tmp - end do end do end do end do - - ! SS block + end do + + print*,'0D blocks done...' - ishift = 1 - jshift = 1 + ! SS block - ia = 0 - jb = 0 + ishift = 1 + jshift = 1 - do i=nC+1,nO - do a=1,nV-nR + ia = 0 + do i=nC+1,nO + do a=1,nV-nR - ia = ia + 1 + ia = ia + 1 + kc = 0 + do k=nC+1,nO + do c=1,nV-nR - do j=nC+1,nO - do b=1,nV-nR + kc = kc + 1 + tmp = E0*Kronecker_delta(i,k)*Kronecker_delta(a,c) & + - F(i,k)*Kronecker_delta(a,c) & + + F(nO+a,nO+c)*Kronecker_delta(i,k) & + - ERI(nO+a,k,nO+c,i) - jb = jb + 1 + H(ishift+ia,jshift+kc) = tmp - H(ishift+ia,jshift+jb) & - = Kronecker_delta(i,j)*Kronecker_delta(a,b)*(eHF(nO+a) - eHF(i)) & - + ERI(nO+a,j,i,nO+b) - ERI(nO+a,j,nO+b,i) - - end do end do - end do + end do - - ! SD block + end do - ishift = 1 - jshift = 1 + nS + print*,'SS block done...' - ia = 0 - kcld = 0 + ! SD blocks - do i=nC+1,nO - do a=1,nV-nR + ishift = 1 + jshift = 1 + nS - ia = ia + 1 + ia = 0 + do i=nC+1,nO + do a=1,nV-nR - do k=nC+1,nO - do c=1,nV-nR - do l=k,nO - do d=c,nV-nR + ia = ia + 1 + kcld = 0 - kcld = kcld + 1 + do k=nC+1,nO + do c=1,nV-nR + do l=k+1,nO + do d=c+1,nV-nR - H(ishift+ia,jshift+kcld) & - = Kronecker_delta(i,k)*(ERI(nO+a,l,nO+c,nO+d) - ERI(nO+a,l,nO+d,nO+c)) & - - Kronecker_delta(i,l)*(ERI(nO+a,k,nO+c,nO+d) - ERI(nO+a,k,nO+d,nO+c)) & - - Kronecker_delta(a,c)*(ERI(k,l,i,nO+d) - ERI(k,l,nO+d,i)) & - + Kronecker_delta(a,d)*(ERI(k,l,i,nO+c) - ERI(k,l,nO+c,i)) + kcld = kcld + 1 + tmp = - F(l,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,k) & + + F(l,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,k) & + - F(k,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,l) & + + F(k,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,l) & + - ERI(k,l,nO+d,i)*Kronecker_delta(a,c) & + + ERI(k,l,nO+c,i)*Kronecker_delta(a,d) & + - ERI(nO+a,l,nO+c,nO+d)*Kronecker_delta(i,k) & + + ERI(nO+a,k,nO+c,nO+d)*Kronecker_delta(i,l) + + H(ishift+ia,jshift+kcld) = tmp + H(jshift+kcld,ishift+ia) = tmp - end do end do end do end do - end do + end do + end do - ! DD block + print*,'SD blocks done...' - ishift = 1 + nS - jshift = 1 + nS + ! DD block - iajb = 0 - kcld = 0 + ishift = 1 + nS + jshift = 1 + nS - do i=nC+1,nO - do a=1,nV-nR - do j=i,nO - do b=a,nV-nR + iajb = 0 + do i=nC+1,nO + do a=1,nV-nR + do j=i+1,nO + do b=a+1,nV-nR - iajb = iajb + 1 + iajb = iajb + 1 - do k=nC+1,nO - do c=1,nV-nR - do l=k,nO - do d=c,nV-nR - - kcld = kcld + 1 - -! H(ishift+iajb,jshift+kcld) & -! = Kronecker_delta(i,k)*(ERI(a,l,c,d) - ERI(a,l,d,c)) & -! - Kronecker_delta(i,l)*(ERI(a,k,c,d) - ERI(a,k,d,c)) & -! - Kronecker_delta(a,c)*(ERI(k,l,i,d) - ERI(k,l,d,i)) & -! + Kronecker_delta(a,d)*(ERI(k,l,i,c) - ERI(k,l,c,i)) - - end do + kcld = 0 + do k=nC+1,nO + do c=1,nV-nR + do l=k+1,nO + do d=c+1,nV-nR + + kcld = kcld + 1 + tmp = & + E0*Kronecker_delta(i,k)*Kronecker_delta(j,l)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & + + F(l,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(i,k) & + - F(l,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(i,k) & + - F(k,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(i,l) & + + F(k,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(i,l) & + - F(l,i)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(j,k) & + + F(l,i)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(j,k) & + + F(k,i)*Kronecker_delta(a,d)*Kronecker_delta(b,c)*Kronecker_delta(j,l) & + - F(k,i)*Kronecker_delta(a,c)*Kronecker_delta(b,d)*Kronecker_delta(j,l) & + + F(nO+a,nO+d)*Kronecker_delta(b,c)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + - F(nO+a,nO+c)*Kronecker_delta(b,d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + - F(nO+a,nO+d)*Kronecker_delta(b,c)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + + F(nO+a,nO+c)*Kronecker_delta(b,d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - F(nO+b,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + F(nO+b,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + F(nO+b,nO+d)*Kronecker_delta(a,c)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - F(nO+b,nO+c)*Kronecker_delta(a,d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) & + - ERI(k,l,i,j)*Kronecker_delta(a,d)*Kronecker_delta(b,c) & + + ERI(k,l,i,j)*Kronecker_delta(a,c)*Kronecker_delta(b,d) & + + ERI(nO+a,l,nO+d,j)*Kronecker_delta(b,c)*Kronecker_delta(i,k) & + - ERI(nO+a,l,nO+c,j)*Kronecker_delta(b,d)*Kronecker_delta(i,k) & + - ERI(nO+a,k,nO+d,j)*Kronecker_delta(b,c)*Kronecker_delta(i,l) & + + ERI(nO+a,k,nO+c,j)*Kronecker_delta(b,d)*Kronecker_delta(i,l) & + - ERI(nO+a,l,nO+d,i)*Kronecker_delta(b,c)*Kronecker_delta(j,k) & + + ERI(nO+a,l,nO+c,i)*Kronecker_delta(b,d)*Kronecker_delta(j,k) & + + ERI(nO+a,k,nO+d,i)*Kronecker_delta(b,c)*Kronecker_delta(j,l) & + - ERI(nO+a,k,nO+c,i)*Kronecker_delta(b,d)*Kronecker_delta(j,l) & + - ERI(nO+b,l,nO+d,j)*Kronecker_delta(a,c)*Kronecker_delta(i,k) & + + ERI(nO+b,l,nO+c,j)*Kronecker_delta(a,d)*Kronecker_delta(i,k) & + + ERI(nO+b,k,nO+d,j)*Kronecker_delta(a,c)*Kronecker_delta(i,l) & + - ERI(nO+b,k,nO+c,j)*Kronecker_delta(a,d)*Kronecker_delta(i,l) & + + ERI(nO+b,l,nO+d,i)*Kronecker_delta(a,c)*Kronecker_delta(j,k) & + - ERI(nO+b,l,nO+c,i)*Kronecker_delta(a,d)*Kronecker_delta(j,k) & + - ERI(nO+b,k,nO+d,i)*Kronecker_delta(a,c)*Kronecker_delta(j,l) & + + ERI(nO+b,k,nO+c,i)*Kronecker_delta(a,d)*Kronecker_delta(j,l) & + - ERI(nO+a,nO+b,nO+c,nO+d)*Kronecker_delta(i,l)*Kronecker_delta(j,k) & + + ERI(nO+a,nO+b,nO+c,nO+d)*Kronecker_delta(i,k)*Kronecker_delta(j,l) + + H(ishift+iajb,jshift+kcld) = tmp + end do end do end do - end do + end do end do end do + end do - call diagonalize_matrix(nSD,H,Omega) - call print_excitation('CISD ',ispin,nS,Omega) - - if(dump_trans) then - print*,'Singlet CISD transition vectors' - call matout(nSD,nSD,H) - write(*,*) - endif + print*,'DD block done...' + write(*,*) + write(*,*) 'Diagonalizing CISD matrix...' + write(*,*) + + call diagonalize_matrix(nH,H,ECISD) + + print*,'CISD energies (au)' + call matout(maxH,1,ECISD) + write(*,*) + + print*,'CISD excitation energies (eV)' + call matout(maxH-1,1,(ECISD(2:maxH)-ECISD(1))*HaToeV) + write(*,*) + + if(dump_trans) then + print*,'Singlet CISD transition vectors' + call matout(nH,nH,H) + write(*,*) endif -! if(triplet_manifold) then - -! ispin = 2 -! -! call diagonalize_matrix(nSD,H,Omega) -! call print_excitation('CISD ',ispin,nSD,Omega) - -! if(dump_trans) then -! print*,'Triplet CIS transition vectors' -! call matout(nSD,nSD,H) -! write(*,*) -! endif - -! endif - end subroutine CISD diff --git a/src/GT/dynamic_Tmatrix_A.f90 b/src/GT/dynamic_Tmatrix_A.f90 index 4cef4c2..9adef18 100644 --- a/src/GT/dynamic_Tmatrix_A.f90 +++ b/src/GT/dynamic_Tmatrix_A.f90 @@ -59,12 +59,12 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O do cd=1,nVV eps = + Omega1(cd) - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) end do do kl=1,nOO eps = - Omega2(kl) - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) end do A_dyn(ia,jb) = A_dyn(ia,jb) - 1d0*lambda*chi @@ -73,12 +73,12 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O do cd=1,nVV eps = + OmBSE - Omega1(cd) + (eGT(i) + eGT(j)) - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) end do do kl=1,nOO eps = + OmBSE + Omega2(kl) - (eGT(a) + eGT(b)) - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) end do A_dyn(ia,jb) = A_dyn(ia,jb) - 1d0*lambda*chi @@ -87,12 +87,12 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O do cd=1,nVV eps = + OmBSE - Omega1(cd) + (eGT(i) + eGT(j)) - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do do kl=1,nOO eps = + OmBSE + Omega2(kl) - (eGT(a) + eGT(b)) - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do ZA_dyn(ia,jb) = ZA_dyn(ia,jb) + 1d0*lambda*chi diff --git a/src/GT/static_Tmatrix_A.f90 b/src/GT/static_Tmatrix_A.f90 index f6a4817..0710ca2 100644 --- a/src/GT/static_Tmatrix_A.f90 +++ b/src/GT/static_Tmatrix_A.f90 @@ -47,13 +47,13 @@ subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh do cd=1,nVV eps = + Omega1(cd) ! chi = chi + lambda*rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) - chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO eps = - Omega2(kl) ! chi = chi - lambda*rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) - chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) enddo TA(ia,jb) = TA(ia,jb) + 1d0*lambda*chi diff --git a/src/GT/static_Tmatrix_B.f90 b/src/GT/static_Tmatrix_B.f90 index 4103ecc..53561be 100644 --- a/src/GT/static_Tmatrix_B.f90 +++ b/src/GT/static_Tmatrix_B.f90 @@ -47,13 +47,13 @@ subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh do cd=1,nVV eps = + Omega1(cd) ! chi = chi + lambda*rho1(i,b,cd)*rho1(a,j,cd)*Omega1(cd)/Omega1(cd)**2 + eta**2 - chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO eps = - Omega2(kl) ! chi = chi + lambda*rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 - chi = chi + rho2(i,b,kl)*rho2(a,j,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) enddo TB(ia,jb) = TB(ia,jb) + 1d0*lambda*chi diff --git a/src/HF/RHF.f90 b/src/HF/RHF.f90 index 05499a5..a4bf5fe 100644 --- a/src/HF/RHF.f90 +++ b/src/HF/RHF.f90 @@ -1,4 +1,4 @@ -subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P,Vx) +subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,F,ERI,dipole_int,X,ERHF,e,c,P,Vx) ! Perform restricted Hartree-Fock calculation @@ -45,7 +45,6 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T double precision,allocatable :: J(:,:) double precision,allocatable :: K(:,:) double precision,allocatable :: cp(:,:) - double precision,allocatable :: F(:,:) double precision,allocatable :: Fp(:,:) double precision,allocatable :: ON(:) @@ -56,6 +55,7 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T double precision,intent(out) :: c(nBas,nBas) double precision,intent(out) :: P(nBas,nBas) double precision,intent(out) :: Vx(nBas) + double precision,intent(out) :: F(nBas,nBas) ! Hello world @@ -72,7 +72,7 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T ! Memory allocation allocate(J(nBas,nBas),K(nBas,nBas),error(nBas,nBas), & - cp(nBas,nBas),Fp(nBas,nBas),F(nBas,nBas),ON(nBas), & + cp(nBas,nBas),Fp(nBas,nBas),ON(nBas), & error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) ! Guess coefficients and eigenvalues diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index ee41859..48f2189 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -64,6 +64,8 @@ program QuAcK double precision,allocatable :: dipole_int_MO(:,:,:) double precision,allocatable :: dipole_int_aa(:,:,:) double precision,allocatable :: dipole_int_bb(:,:,:) + double precision,allocatable :: F_AO(:,:) + double precision,allocatable :: F_MO(:,:) double precision,allocatable :: ERI_AO(:,:,:,:) double precision,allocatable :: ERI_MO(:,:,:,:) integer :: ixyz @@ -247,7 +249,7 @@ program QuAcK allocate(cHF(nBas,nBas,nspin),eHF(nBas,nspin),eG0W0(nBas,nspin),eG0T0(nBas,nspin),PHF(nBas,nBas,nspin), & S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas), & - dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nspin)) + dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nspin),F_AO(nBas,nBas)) ! Read integrals @@ -291,7 +293,7 @@ program QuAcK call cpu_time(start_HF) call RHF(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc, & - nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc) + nBas,nO,S,T,V,Hc,F_AO,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc) call cpu_time(end_HF) t_HF = end_HF - start_HF @@ -433,6 +435,7 @@ program QuAcK ! Memory allocation allocate(ERI_MO(nBas,nBas,nBas,nBas)) + allocate(F_MO(nBas,nBas)) ! Read and transform dipole-related integrals @@ -448,7 +451,8 @@ program QuAcK ket1 = 1 ket2 = 1 call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO) -! call AOtoMO_transform(nBas,cHF,T+V) + F_MO(:,:) = F_AO(:,:) + call AOtoMO_transform(nBas,cHF,F_MO) end if end if @@ -734,7 +738,7 @@ program QuAcK if(doCID) then call cpu_time(start_CID) -! call CID(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) + call CID(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,F_MO,ERHF) call cpu_time(end_CID) t_CID = end_CID - start_CID @@ -750,7 +754,7 @@ program QuAcK if(doCISD) then call cpu_time(start_CISD) -! call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) + call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,F_MO,ERHF) call cpu_time(end_CISD) t_CISD = end_CISD - start_CISD diff --git a/src/utils/spatial_to_spin_fock.f90 b/src/utils/spatial_to_spin_fock.f90 new file mode 100644 index 0000000..614c693 --- /dev/null +++ b/src/utils/spatial_to_spin_fock.f90 @@ -0,0 +1,29 @@ +subroutine spatial_to_spin_fock(nBas,F,nBas2,sF) + +! Convert Fock matrix from spatial to spin orbitals + + implicit none + +! Input variables + + integer,intent(in) :: nBas,nBas2 + double precision,intent(in) :: F(nBas,nBas) + +! Local variables + + integer :: p,q + double precision,external :: Kronecker_delta + +! Output variables + + double precision,intent(out) :: sF(nBas2,nBas2) + + do p=1,nBas2 + do q=1,nBas2 + + sF(p,q) = Kronecker_delta(mod(p,2),mod(q,2))*F((p+1)/2,(q+1)/2) + + enddo + enddo + +end subroutine spatial_to_spin_fock From 3ecf94bbc9dd888d39bc7acee021baa69daa8d15 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 5 Jan 2022 12:46:59 +0100 Subject: [PATCH 10/12] debugging BSE@GT --- input/methods | 8 ++++---- input/options | 2 +- src/CC/CCSD_Ec_nc.f90 | 2 +- src/GT/Bethe_Salpeter_Tmatrix.f90 | 24 ++++++++++++------------ src/GT/dynamic_Tmatrix_A.f90 | 22 +++++++++++----------- src/GT/static_Tmatrix_A.f90 | 15 ++++++++------- src/GT/static_Tmatrix_B.f90 | 11 ++++++----- src/LR/linear_response_Tmatrix.f90 | 22 ++++++++++++---------- src/RPA/ppURPA.f90 | 9 ++++----- 9 files changed, 59 insertions(+), 56 deletions(-) diff --git a/input/methods b/input/methods index 9f505d6..dcb210a 100644 --- a/input/methods +++ b/input/methods @@ -7,15 +7,15 @@ # drCCD rCCD crCCD lCCD F F F F # CIS* CIS(D) CID CISD FCI - F F T T F + F F F F F # RPA* RPAx* crRPA ppRPA F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F F F F F + T F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - F F F F F + T F F F F # G0T0 evGT qsGT - F F F + T F F # MCMP2 F # * unrestricted version available diff --git a/input/options b/input/options index d6417cb..2d0e99d 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T + F T F T T # GF: maxSCF thresh DIIS n_diis lin eta renorm reg 256 0.00001 T 5 T 0.0 3 F # GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg diff --git a/src/CC/CCSD_Ec_nc.f90 b/src/CC/CCSD_Ec_nc.f90 index 033ae32..d6214b0 100644 --- a/src/CC/CCSD_Ec_nc.f90 +++ b/src/CC/CCSD_Ec_nc.f90 @@ -1,6 +1,6 @@ subroutine CCSD_Ec_nc(nO,nV,t1,t2,Fov,OOVV,EcCCSD) -! Compute the CCSD correlatio energy in non-conanical form +! Compute the CCSD correlatio energy in non-canonical form implicit none diff --git a/src/GT/Bethe_Salpeter_Tmatrix.f90 b/src/GT/Bethe_Salpeter_Tmatrix.f90 index 30e76e1..05e019e 100644 --- a/src/GT/Bethe_Salpeter_Tmatrix.f90 +++ b/src/GT/Bethe_Salpeter_Tmatrix.f90 @@ -88,13 +88,13 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, ! call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s) - call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) - if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) + call static_Tmatrix_A(ispin,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) + if(.not.TDA) call static_Tmatrix_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) - print*,'aa block of TA' - call matout(nS,nS,TA) - print*,'aa block of TB' - call matout(nS,nS,TB) +! print*,'aa block of TA' +! call matout(nS,nS,TA) +! print*,'aa block of TB' +! call matout(nS,nS,TB) !---------------------------------------------- ! Compute T-matrix for alpha-alpha block @@ -108,13 +108,13 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, ! call excitation_density_Tmatrix(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t) - call static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) - if(.not.TDA) call static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) + call static_Tmatrix_A(ispin,eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) + if(.not.TDA) call static_Tmatrix_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) - print*,'aa+ab block of TA' - call matout(nS,nS,TA) - print*,'aa+ab block of TB' - call matout(nS,nS,TB) +! print*,'aa+ab block of TA' +! call matout(nS,nS,TA) +! print*,'aa+ab block of TB' +! call matout(nS,nS,TB) !------------------- ! Singlet manifold diff --git a/src/GT/dynamic_Tmatrix_A.f90 b/src/GT/dynamic_Tmatrix_A.f90 index 9adef18..e6770a0 100644 --- a/src/GT/dynamic_Tmatrix_A.f90 +++ b/src/GT/dynamic_Tmatrix_A.f90 @@ -58,44 +58,44 @@ subroutine dynamic_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,eGT,Omega1,O chi = 0d0 do cd=1,nVV - eps = + Omega1(cd) - chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) + eps = - Omega1(cd) + chi = chi + rho1(i,b,cd)*rho1(j,a,cd)*eps/(eps**2 + eta**2) end do do kl=1,nOO - eps = - Omega2(kl) - chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) + eps = + Omega2(kl) + chi = chi + rho2(i,b,kl)*rho2(j,a,kl)*eps/(eps**2 + eta**2) end do - A_dyn(ia,jb) = A_dyn(ia,jb) - 1d0*lambda*chi + A_dyn(ia,jb) = A_dyn(ia,jb) - lambda*chi chi = 0d0 do cd=1,nVV eps = + OmBSE - Omega1(cd) + (eGT(i) + eGT(j)) - chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,b,cd)*rho1(j,a,cd)*eps/(eps**2 + eta**2) end do do kl=1,nOO eps = + OmBSE + Omega2(kl) - (eGT(a) + eGT(b)) - chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,b,kl)*rho2(j,a,kl)*eps/(eps**2 + eta**2) end do - A_dyn(ia,jb) = A_dyn(ia,jb) - 1d0*lambda*chi + A_dyn(ia,jb) = A_dyn(ia,jb) + 1d0*lambda*chi chi = 0d0 do cd=1,nVV eps = + OmBSE - Omega1(cd) + (eGT(i) + eGT(j)) - chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho1(i,b,cd)*rho1(j,a,cd)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do do kl=1,nOO eps = + OmBSE + Omega2(kl) - (eGT(a) + eGT(b)) - chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho2(i,b,kl)*rho2(j,a,kl)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do - ZA_dyn(ia,jb) = ZA_dyn(ia,jb) + 1d0*lambda*chi + ZA_dyn(ia,jb) = ZA_dyn(ia,jb) - 1d0*lambda*chi end do end do diff --git a/src/GT/static_Tmatrix_A.f90 b/src/GT/static_Tmatrix_A.f90 index 0710ca2..9e3505e 100644 --- a/src/GT/static_Tmatrix_A.f90 +++ b/src/GT/static_Tmatrix_A.f90 @@ -1,4 +1,4 @@ -subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TA) +subroutine static_Tmatrix_A(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TA) ! Compute the OOVV block of the static T-matrix for the resonant block @@ -7,6 +7,8 @@ subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh ! Input variables + integer,intent(in) :: ispin + double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO @@ -15,7 +17,6 @@ subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh integer,intent(in) :: nS integer,intent(in) :: nOO integer,intent(in) :: nVV - double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega1(nVV) @@ -45,18 +46,18 @@ subroutine static_Tmatrix_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh chi = 0d0 do cd=1,nVV - eps = + Omega1(cd) + eps = - Omega1(cd) ! chi = chi + lambda*rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) - chi = chi + rho1(i,a,cd)*rho1(j,b,cd)*eps/(eps**2 + eta**2) + chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO - eps = - Omega2(kl) + eps = + Omega2(kl) ! chi = chi - lambda*rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) - chi = chi + rho2(i,a,kl)*rho2(j,b,kl)*eps/(eps**2 + eta**2) + chi = chi + rho2(i,b,kl)*rho2(a,j,kl)*eps/(eps**2 + eta**2) enddo - TA(ia,jb) = TA(ia,jb) + 1d0*lambda*chi + TA(ia,jb) = TA(ia,jb) + lambda*chi enddo enddo diff --git a/src/GT/static_Tmatrix_B.f90 b/src/GT/static_Tmatrix_B.f90 index 53561be..7cf9bb0 100644 --- a/src/GT/static_Tmatrix_B.f90 +++ b/src/GT/static_Tmatrix_B.f90 @@ -1,4 +1,4 @@ -subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TB) +subroutine static_Tmatrix_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rho1,Omega2,rho2,TB) ! Compute the OVVO block of the static T-matrix for the coupling block @@ -7,6 +7,8 @@ subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh ! Input variables + integer,intent(in) :: ispin + double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO @@ -15,7 +17,6 @@ subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh integer,intent(in) :: nS integer,intent(in) :: nOO integer,intent(in) :: nVV - double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega1(nVV) @@ -45,18 +46,18 @@ subroutine static_Tmatrix_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,rh chi = 0d0 do cd=1,nVV - eps = + Omega1(cd) + eps = - Omega1(cd) ! chi = chi + lambda*rho1(i,b,cd)*rho1(a,j,cd)*Omega1(cd)/Omega1(cd)**2 + eta**2 chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2) enddo do kl=1,nOO - eps = - Omega2(kl) + eps = + Omega2(kl) ! chi = chi + lambda*rho2(i,b,kl)*rho2(a,j,kl)*Omega2(kl)/Omega2(kl)**2 + eta**2 chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2) enddo - TB(ia,jb) = TB(ia,jb) + 1d0*lambda*chi + TB(ia,jb) = TB(ia,jb) + lambda*chi enddo enddo diff --git a/src/LR/linear_response_Tmatrix.f90 b/src/LR/linear_response_Tmatrix.f90 index ec087dd..c0a4acf 100644 --- a/src/LR/linear_response_Tmatrix.f90 +++ b/src/LR/linear_response_Tmatrix.f90 @@ -42,12 +42,13 @@ subroutine linear_response_Tmatrix(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda call linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,A) - A(:,:) = A(:,:) + A_BSE(:,:) + if(ispin == 1) A(:,:) = A(:,:) + A_BSE(:,:) + if(ispin == 2) A(:,:) = A(:,:) - A_BSE(:,:) - print*,'A' - call matout(nS,nS,A) - print*,'TA' - call matout(nS,nS,A_BSE) +! print*,'A' +! call matout(nS,nS,A) +! print*,'TA' +! call matout(nS,nS,A_BSE) ! Tamm-Dancoff approximation @@ -63,12 +64,13 @@ subroutine linear_response_Tmatrix(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda call linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,B) - B(:,:) = B(:,:) + B_BSE(:,:) + if(ispin == 1) B(:,:) = B(:,:) + B_BSE(:,:) + if(ispin == 2) B(:,:) = B(:,:) - B_BSE(:,:) - print*,'B' - call matout(nS,nS,B) - print*,'TB' - call matout(nS,nS,B_BSE) +! print*,'B' +! call matout(nS,nS,B) +! print*,'TB' +! call matout(nS,nS,B_BSE) ! Build A + B and A - B matrices diff --git a/src/RPA/ppURPA.f90 b/src/RPA/ppURPA.f90 index 395e078..73f960f 100644 --- a/src/RPA/ppURPA.f90 +++ b/src/RPA/ppURPA.f90 @@ -67,12 +67,11 @@ subroutine ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUH ! Memory allocation - allocate(Omega1sc(nP_sc),X1sc(nP_sc,nP_sc),Y1sc(nH_sc,nP_sc), & - Omega2sc(nH_sc),X2sc(nP_sc,nH_sc),Y2sc(nH_sc,nH_sc)) + allocate(Omega1sc(nP_sc),X1sc(nP_sc,nP_sc),Y1sc(nH_sc,nP_sc), & + Omega2sc(nH_sc),X2sc(nP_sc,nH_sc),Y2sc(nH_sc,nH_sc)) -call unrestricted_linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nP_sc, & -nHaa,nHab,nHbb,nH_sc,1d0,e,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega1sc,X1sc,Y1sc,Omega2sc,X2sc,Y2sc,& -Ec_ppURPA(ispin)) + call unrestricted_linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nP_sc,nHaa,nHab,nHbb,nH_sc,1d0, & + e,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega1sc,X1sc,Y1sc,Omega2sc,X2sc,Y2sc,Ec_ppURPA(ispin)) call print_excitation('pp-RPA (N+2)',5,nP_sc,Omega1sc) call print_excitation('pp-RPA (N-2)',5,nH_sc,Omega2sc) From 310f4ab132c55b5be343a73c198e13039d17faa1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 6 Jan 2022 10:23:48 +0100 Subject: [PATCH 11/12] problem print HOMO/LUMO --- input/methods | 8 ++--- src/eDFT/eDFT_UKS.f90 | 2 +- src/eDFT/print_UKS.f90 | 75 +++++++++++++++++++++++++----------------- 3 files changed, 50 insertions(+), 35 deletions(-) diff --git a/input/methods b/input/methods index dcb210a..8124aba 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD pCCD DCD CCSD CCSD(T) @@ -11,11 +11,11 @@ # RPA* RPAx* crRPA ppRPA F F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - T F F F F + F F F F F # G0W0* evGW* qsGW* ufG0W0 ufGW - T F F F F + F F F F F # G0T0 evGT qsGT - T F F + F F F # MCMP2 F # * unrestricted version available diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index 154c3c0..f4a20e8 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -367,7 +367,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max ! Compute final KS energy call dipole_moment(nBas,Pw(:,:,1)+Pw(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole) - call print_UKS(nBas,nEns,nO,S,wEns,eKS,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) + call print_UKS(nBas,nEns,occnum,S,wEns,eKS,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) ! Compute Vxc for post-HF calculations diff --git a/src/eDFT/print_UKS.f90 b/src/eDFT/print_UKS.f90 index 2615291..76b68ff 100644 --- a/src/eDFT/print_UKS.f90 +++ b/src/eDFT/print_UKS.f90 @@ -1,4 +1,4 @@ -subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) +subroutine print_UKS(nBas,nEns,occnum,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) ! Print one- and two-electron energies and other stuff for KS calculation @@ -7,39 +7,54 @@ subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) ! Input variables - integer,intent(in) :: nBas - integer,intent(in) :: nEns - integer,intent(in) :: nO(nspin) - double precision,intent(in) :: Ov(nBas,nBas) - double precision,intent(in) :: wEns(nEns) - double precision,intent(in) :: eps(nBas,nspin) - double precision,intent(in) :: c(nBas,nBas,nspin) - double precision,intent(in) :: ENuc - double precision,intent(in) :: ET(nspin) - double precision,intent(in) :: EV(nspin) - double precision,intent(in) :: EH(nsp) - double precision,intent(in) :: Ex(nspin) - double precision,intent(in) :: Ec(nsp) - double precision,intent(in) :: Ew - double precision,intent(in) :: dipole(ncart) + integer,intent(in) :: nBas + integer,intent(in) :: nEns + double precision,intent(in) :: occnum(nBas,nspin,nEns) + double precision,intent(in) :: Ov(nBas,nBas) + double precision,intent(in) :: wEns(nEns) + double precision,intent(in) :: eps(nBas,nspin) + double precision,intent(in) :: c(nBas,nBas,nspin) + double precision,intent(in) :: ENuc + double precision,intent(in) :: ET(nspin) + double precision,intent(in) :: EV(nspin) + double precision,intent(in) :: EH(nsp) + double precision,intent(in) :: Ex(nspin) + double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: Ew + double precision,intent(in) :: dipole(ncart) ! Local variables - integer :: ixyz - integer :: ispin - integer :: iEns - integer :: iBas - integer :: HOMO(nspin) - integer :: LUMO(nspin) - double precision :: Gap(nspin) - double precision :: S_exact,S2_exact - double precision :: S,S2 + integer :: ixyz + integer :: ispin + integer :: iEns + integer :: iBas + integer :: HOMO(nspin) + integer :: LUMO(nspin) + double precision :: Gap(nspin) + double precision :: S_exact,S2_exact + double precision :: S,S2 + + double precision :: nO(nspin) + +! Compute the number of spin-up and spin-down electrons + + nO(:) = 0d0 + do ispin=1,nspin + do iEns=1,nEns + do iBas=1,nBas + nO(ispin) = nO(ispin) + wEns(iEns)*occnum(iBas,ispin,iEns) + end do + end do + end do + + print*,'nO = ',nO ! HOMO and LUMO do ispin=1,nspin - HOMO(ispin) = nO(ispin) + HOMO(ispin) = ceiling(nO(ispin)) LUMO(ispin) = HOMO(ispin) + 1 Gap(ispin) = eps(LUMO(ispin),ispin) - eps(HOMO(ispin),ispin) @@ -47,11 +62,11 @@ subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole) ! Spin comtamination - S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0) - S2 = S2_exact + nO(2) - sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2) +! S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0) +! S2 = S2_exact + nO(2) - sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2) - S_exact = 0.5d0*dble(nO(1) - nO(2)) - S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2) +! S_exact = 0.5d0*dble(nO(1) - nO(2)) +! S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2) ! Dump results From 94a4a2937c19defede04371a642c6787b82110d5 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 6 Jan 2022 11:18:34 +0100 Subject: [PATCH 12/12] fix probleme HOMO/LUMO --- input/dft | 10 +++---- src/eDFT/print_UKS.f90 | 65 +++++++++++++++++++++++++++--------------- 2 files changed, 47 insertions(+), 28 deletions(-) diff --git a/input/dft b/input/dft index 346489d..bf9a080 100644 --- a/input/dft +++ b/input/dft @@ -13,16 +13,16 @@ # GGA = 2: LYP,PBE # MGGA = 3: # Hybrid = 4: HF,B3LYP,PBE -1 VWN5 +0 H # quadrature grid SG-n 1 # Number of states in ensemble (nEns) 2 # occupation numbers -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 @@ -31,9 +31,9 @@ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.55 0.0 0.0 + 1.0 0.0 0.0 # Ncentered ? -T +F # Parameters for CC weight-dependent exchange functional 4 0.642674 -0.07818 -0.0280307 0.00144198 diff --git a/src/eDFT/print_UKS.f90 b/src/eDFT/print_UKS.f90 index 76b68ff..cb56dda 100644 --- a/src/eDFT/print_UKS.f90 +++ b/src/eDFT/print_UKS.f90 @@ -29,11 +29,13 @@ subroutine print_UKS(nBas,nEns,occnum,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipol integer :: ispin integer :: iEns integer :: iBas - integer :: HOMO(nspin) - integer :: LUMO(nspin) - double precision :: Gap(nspin) - double precision :: S_exact,S2_exact - double precision :: S,S2 + integer :: iHOMOa,iHOMOb + integer :: iLUMOa,iLUMOb + double precision :: HOMOa,HOMOb,HOMO + double precision :: LUMOa,LUMOb,LUMO + double precision :: Gapa,Gapb,Gap +! double precision :: S_exact,S2_exact +! double precision :: S,S2 double precision :: nO(nspin) @@ -48,21 +50,34 @@ subroutine print_UKS(nBas,nEns,occnum,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipol end do end do - print*,'nO = ',nO - ! HOMO and LUMO - do ispin=1,nspin + iHOMOa = ceiling(nO(1)) + iLUMOa = iHOMOa + 1 - HOMO(ispin) = ceiling(nO(ispin)) - LUMO(ispin) = HOMO(ispin) + 1 - Gap(ispin) = eps(LUMO(ispin),ispin) - eps(HOMO(ispin),ispin) + iHOMOb = ceiling(nO(2)) + iLUMOb = iHOMOb + 1 - end do + HOMOa = -huge(0d0) + if(iHOMOa > 0) HOMOa = eps(iHOMOa,1) + LUMOa = +huge(0d0) + if(iLUMOa <= nBas) LUMOa = eps(iLUMOa,1) + + HOMOb = -huge(0d0) + if(iHOMOb > 0) HOMOb = eps(iHOMOb,2) + LUMOb = +huge(0d0) + if(iLUMOb <= nBas) LUMOb = eps(iLUMOb,1) + + HOMO = max(HOMOa,HOMOb) + LUMO = min(LUMOa,LUMOb) + + Gapa = LUMOa - HOMOa + Gapb = LUMOb - HOMOb + Gap = LUMO - HOMO ! Spin comtamination -! S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0) +! S2_exact = (nO(1) - nO(2))/2d0*(nO(1) - nO(2))/2d0 + 1d0 ! S2 = S2_exact + nO(2) - sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2) ! S_exact = 0.5d0*dble(nO(1) - nO(2)) @@ -104,19 +119,23 @@ subroutine print_UKS(nBas,nEns,occnum,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipol write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' write(*,'(A40,1X,F16.10,A3)') ' Kohn-Sham energy: ',Ew + ENuc,' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,F13.6,A3)') ' KS HOMO a energy:',eps(HOMO(1),1)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' KS LUMO a energy:',eps(LUMO(1),1)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' KS HOMOa-LUMOa gap:',Gap(1)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMO a energy:',HOMOa*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS LUMO a energy:',LUMOa*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMOa-LUMOa gap:',Gapa*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,F13.6,A3)') ' KS HOMO b energy:',eps(HOMO(2),2)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' KS LUMO b energy:',eps(LUMO(2),2)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' KS HOMOb-LUMOb gap :',Gap(2)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMO b energy:',HOMOb*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS LUMO b energy:',LUMOb*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMOb-LUMOb gap :',Gapb*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.6)') ' S (exact) :',2d0*S_exact + 1d0 - write(*,'(A40,1X,F16.6)') ' S :',2d0*S + 1d0 - write(*,'(A40,1X,F16.6)') ' (exact) :',S2_exact - write(*,'(A40,1X,F16.6)') ' :',S2 + write(*,'(A40,F13.6,A3)') ' KS HOMO energy:',HOMO*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS LUMO energy:',LUMO*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMO -LUMO gap :',Gap*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' +! write(*,'(A40,1X,F16.6)') ' S (exact) :',2d0*S_exact + 1d0 +! write(*,'(A40,1X,F16.6)') ' S :',2d0*S + 1d0 +! write(*,'(A40,1X,F16.6)') ' (exact) :',S2_exact +! write(*,'(A40,1X,F16.6)') ' :',S2 +! write(*,'(A60)') '-------------------------------------------------' write(*,'(A45)') ' Dipole moment (Debye) ' write(*,'(19X,4A10)') 'X','Y','Z','Tot.' write(*,'(19X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD